Fix obvious bug in aggregate expression

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.
This commit is contained in:
Tom Tromey 2023-08-15 11:04:17 -06:00
parent 100dbc6de5
commit 94c5098e4d
6 changed files with 147 additions and 1 deletions

View File

@ -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;

View File

@ -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)"]

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;