From 94c5098e4d9d5b58a6db31064398fb4941ab5efb Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 15 Aug 2023 11:04:17 -0600 Subject: [PATCH] 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. --- 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 (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; -- 2.30.2