[pushed] Fix obvious bug in aggregate expression

[pushed] Fix obvious bug in aggregate expression

[Tom Tromey]

I found an obvious bug in Ada aggregate expression handling:

	  if (vvo != nullptr)
 	    error (_("Invalid record component association."));
 	  name = vvo->get_symbol ()->natural_name ();

Here the code errors when vvo is not null -- and then proceeds to use
vvo.

This hasn't caused a crash because, I believe, there's currently no
way to reach this code in the null case.  However, I'm not really
willing to assert this...

Fixing this shows another bug, which is that due to the way the parser
works, a field name in an aggregate expression might erroneously be
fully qualified if some global variable with the same base name
exists.

The included test case triggers both bugs.  Note that the test
includes a confounding case for array aggregates as well, but as these
are harder to fix, I've left it as kfail.

As this is Ada-specific, and has already been tested internally at
AdaCore, I am checking it in.
---
 gdb/ada-lang.c                       |  9 +++++-
 gdb/testsuite/gdb.ada/assoc.exp      | 43 ++++++++++++++++++++++++++++
 gdb/testsuite/gdb.ada/assoc/main.adb | 22 ++++++++++++++
 gdb/testsuite/gdb.ada/assoc/pck.ads  | 29 +++++++++++++++++++
 gdb/testsuite/gdb.ada/assoc/xtra.adb | 21 ++++++++++++++
 gdb/testsuite/gdb.ada/assoc/xtra.ads | 24 ++++++++++++++++
 6 files changed, 147 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/assoc.exp
 create mode 100644 gdb/testsuite/gdb.ada/assoc/main.adb
 create mode 100644 gdb/testsuite/gdb.ada/assoc/pck.ads
 create mode 100644 gdb/testsuite/gdb.ada/assoc/xtra.adb
 create mode 100644 gdb/testsuite/gdb.ada/assoc/xtra.ads

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 1261ee8fa05..4a9a6e0f38f 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9575,9 +9575,16 @@ ada_name_association::assign (struct value *container,
 	{
 	  ada_var_value_operation *vvo
 	    = dynamic_cast<ada_var_value_operation *> (m_val.get ());
-	  if (vvo != nullptr)
+	  if (vvo == nullptr)
 	    error (_("Invalid record component association."));
 	  name = vvo->get_symbol ()->natural_name ();
+	  /* In this scenario, the user wrote (name => expr), but
+	     write_name_assoc found some fully-qualified name and
+	     substituted it.  This happens because, at parse time, the
+	     meaning of the expression isn't known; but here we know
+	     that just the base name was supplied and it refers to the
+	     name of a field.  */
+	  name = ada_unqualified_name (name);
 	}
 
       index = 0;
diff --git a/gdb/testsuite/gdb.ada/assoc.exp b/gdb/testsuite/gdb.ada/assoc.exp
new file mode 100644
index 00000000000..9ed1a671816
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assoc.exp
@@ -0,0 +1,43 @@
+# Copyright 2023 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib "ada.exp"
+
+require allow_ada_tests
+
+standard_ada_testfile main
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != ""} {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "BREAK" ${testdir}/main.adb]
+runto "main.adb:$bp_location"
+
+gdb_test_multiple "print pck.value := (Left => 3, Center => 7, Pck.Right => 2)" \
+    "assign to value" {
+	-wrap -re " = \\(3, 7, 2\\)" {
+	    pass $gdb_test_name
+	}
+	-wrap -re " = \\(3, 2, 2\\)" {
+	    setup_kfail "aggregate expression bug" *-*-*
+	    fail $gdb_test_name
+	}
+    }
+
+gdb_test "print pck.svalue := (center => 99)" \
+    [string_to_regexp " = (center => 99)"]
diff --git a/gdb/testsuite/gdb.ada/assoc/main.adb b/gdb/testsuite/gdb.ada/assoc/main.adb
new file mode 100644
index 00000000000..3eda932f0c2
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assoc/main.adb
@@ -0,0 +1,22 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+With Pck;
+with Xtra;
+
+procedure Main is
+begin
+   Xtra.Do_Nothing (Pck.Value); --  BREAK
+end Main;
diff --git a/gdb/testsuite/gdb.ada/assoc/pck.ads b/gdb/testsuite/gdb.ada/assoc/pck.ads
new file mode 100644
index 00000000000..8140beac0b6
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assoc/pck.ads
@@ -0,0 +1,29 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Pck is
+   type Posn is (Left, Center, Right);
+   type My_Array is array (Posn) of Integer;
+
+   Value : My_Array := (Left => 1, Center => 2, Right => 3);
+
+   type Structured is
+     record
+       Center : Integer;
+     end record;
+
+   SValue : Structured := (Center => 23);
+
+end Pck;
diff --git a/gdb/testsuite/gdb.ada/assoc/xtra.adb b/gdb/testsuite/gdb.ada/assoc/xtra.adb
new file mode 100644
index 00000000000..e0a16c017d0
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assoc/xtra.adb
@@ -0,0 +1,21 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body Xtra is
+   procedure Do_Nothing (Buffer: in out Pck.My_Array) is
+   begin
+      null;
+   end Do_Nothing;
+end Xtra;
diff --git a/gdb/testsuite/gdb.ada/assoc/xtra.ads b/gdb/testsuite/gdb.ada/assoc/xtra.ads
new file mode 100644
index 00000000000..c42d1972c83
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assoc/xtra.ads
@@ -0,0 +1,24 @@
+--  Copyright 2023 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Pck;
+
+package Xtra is
+   -- Confounding.
+   Center : Pck.Posn := Pck.Right;
+   Right : Pck.Posn := Pck.Left;
+
+   procedure Do_Nothing (Buffer: in out Pck.My_Array);
+end Xtra;
-- 
2.40.1