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 (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 . + +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 . + +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 . + +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 . + +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 . + +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;