Resolve dynamic type in ada_value_struct_elt

An internal AdaCore test case showed that gdb mishandled a case of
assigning to an array element in a packed array inside a variant
record.  This problem can only be seen with -fgnat-encodings=minimal,
which isn't yet widely used.  This patch fixes the bug, and also
updates an existing test to check this case.

gdb/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* ada-lang.c (ada_value_struct_elt): Resolve dynamic type.

gdb/testsuite/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/set_pckd_arr_elt.exp: Also test
	-fgnat-encodings=minimal.  Add tests.
	* gdb.ada/set_pckd_arr_elt/foo.adb (Foo): Add VA variable.
	Call Update_Small a second time.
	* gdb.ada/set_pckd_arr_elt/pck.adb (New_Variant): New function.
	* gdb.ada/set_pckd_arr_elt/pck.ads (Buffer, Variant)
	(Variant_Access): New types.
	(New_Variant): Declare.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 1b473d55867a0353d7fe09c66269d2bbbb563d36..79ee2b96c70508a7405a94d507df4022c2bd97ed 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,7 @@
+2020-11-04  Tom Tromey  <tromey@adacore.com>
+
+       * ada-lang.c (ada_value_struct_elt): Resolve dynamic type.
+
 2020-11-04  Tom Tromey  <tromey@adacore.com>
 
        * ada-lang.c (ada_is_any_packed_array_type): New function.

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index bfb46a538b96987187797eb5aee7175e9b06167c..7613e190108f1f9a38e5a7e4b56ea26cafdfaf1f 100644 (file)
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -4396,6 +4396,10 @@ ada_value_struct_elt (struct value *arg, const char *name, int no_err)
       t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
                              address, NULL, check_tag);
 
+      /* Resolve the dynamic type as well.  */
+      arg = value_from_contents_and_address (t1, nullptr, address);
+      t1 = value_type (arg);
+
       if (find_struct_field (name, t1, 0,
                             &field_type, &byte_offset, &bit_offset,
                             &bit_size, NULL))

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 386b58e802061f57a18dbbdceb015b4d0197f076..874395af38db24653b8483f3747852cb04cba514 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2020-11-04  Tom Tromey  <tromey@adacore.com>
+
+       * gdb.ada/set_pckd_arr_elt.exp: Also test
+       -fgnat-encodings=minimal.  Add tests.
+       * gdb.ada/set_pckd_arr_elt/foo.adb (Foo): Add VA variable.
+       Call Update_Small a second time.
+       * gdb.ada/set_pckd_arr_elt/pck.adb (New_Variant): New function.
+       * gdb.ada/set_pckd_arr_elt/pck.ads (Buffer, Variant)
+       (Variant_Access): New types.
+       (New_Variant): Declare.
+
 2020-11-04  Tom Tromey  <tromey@adacore.com>
 
        * gdb.ada/mod_from_name.exp: Test printing slice.

diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
index bf28b9113e46c9eb8552c50a483bbff2790eda11..adaee7d592d2186d0d8d017202a0069ec96f14e2 100644 (file)
--- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp
@@ -19,25 +19,34 @@ if { [skip_ada_tests] } { return -1 }
 
 standard_ada_testfile foo
 
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
-    return -1
-}
+foreach_with_prefix scenario {all minimal} {
+    set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+    if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+       return -1
+    }
 
-clean_restart ${testfile}
+    clean_restart ${testfile}
 
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
+    set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+    runto "foo.adb:$bp_location"
 
-gdb_test "print sa(3) := 9" " = 9"
+    gdb_test "print sa(3) := 9" " = 9"
+    gdb_test "print va.t(1) := 15" " = 15"
 
-# To verify that the assignment was made correctly, we use the fact
-# that the program passes this very same element as an argument to
-# one of the functions.  So we insert a breakpoint on that function,
-# and verify that the argument value is correct.
+    # To verify that the assignment was made correctly, we use the fact
+    # that the program passes this very same element as an argument to
+    # one of the functions.  So we insert a breakpoint on that function,
+    # and verify that the argument value is correct.
 
-gdb_breakpoint "update_small"
+    gdb_breakpoint "update_small"
 
-gdb_test "continue" \
+    gdb_test "continue" \
         "Breakpoint .*, pck\\.update_small \\(s=9\\) at .*pck.adb:.*" \
         "continue to update_small"
 
+    # And again for the second call.
+    gdb_test "continue" \
+        "Breakpoint .*, pck\\.update_small \\(s=15\\) at .*pck.adb:.*" \
+        "continue to update_small for va.t"
+}

diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
index da826a6e0ae1981f9afbde0f7dde4d7bfd0ff6a6..04b444ada9576c3a1f2761590c1865176c8bd1ca 100644 (file)
--- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb
@@ -17,6 +17,8 @@ with Pck; use Pck;
 
 procedure Foo is
    SA : Simple_Array := (1, 2, 3, 4);
+   VA : Variant_Access := New_Variant (Size => 3);
 begin
    Update_Small (SA (3));  -- STOP
+   Update_Small (VA.T (1));
 end Foo;

diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
index 0cebce3430bc9d868e65d5c737cc95f5983936b0..d19ed2ed20ad9c91344689f1941965f50f921945 100644 (file)
--- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb
@@ -14,6 +14,13 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 package body Pck is
+   function New_Variant (Size : Integer) return Variant_Access is
+      Result : Variant (Size => Size) :=
+        (Size => Size, A => 11, T => (others => 13));
+   begin
+      return new Variant'(Result);
+   end New_Variant;
+
    procedure Update_Small (S : in out Small) is
    begin
       null;

diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
index fe8b6022702d31c4e1052aa9548b28a6654c17d4..d04809d9d0a4d7cd71d412b2d138bf57c5ff073e 100644 (file)
--- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
+++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads
@@ -18,5 +18,19 @@ package Pck is
    type Simple_Array is array (1 .. 4) of Small;
    pragma Pack (Simple_Array);
 
+   type Buffer is array (Integer range <>) of Small;
+   pragma Pack (Buffer);
+
+   type Variant (Size : Integer := 1) is
+   record
+      A : Small;
+      T : Buffer (1 .. Size);
+   end record;
+   pragma Pack (Variant);
+
+   type Variant_Access is access all Variant;
+
+   function New_Variant (Size : Integer) return Variant_Access;
+
    procedure Update_Small (S : in out Small);
 end Pck;