From 24aa1b028236fff1b1cf04e8cadcc2e7b4c72aab Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 4 Nov 2020 08:49:16 -0700 Subject: [PATCH] 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 * ada-lang.c (ada_value_struct_elt): Resolve dynamic type. gdb/testsuite/ChangeLog 2020-11-04 Tom Tromey * 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. --- gdb/ChangeLog | 4 +++ gdb/ada-lang.c | 4 +++ gdb/testsuite/ChangeLog | 11 ++++++ gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp | 35 ++++++++++++------- .../gdb.ada/set_pckd_arr_elt/foo.adb | 2 ++ .../gdb.ada/set_pckd_arr_elt/pck.adb | 7 ++++ .../gdb.ada/set_pckd_arr_elt/pck.ads | 14 ++++++++ 7 files changed, 64 insertions(+), 13 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 1b473d55867..79ee2b96c70 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,7 @@ +2020-11-04 Tom Tromey + + * ada-lang.c (ada_value_struct_elt): Resolve dynamic type. + 2020-11-04 Tom Tromey * ada-lang.c (ada_is_any_packed_array_type): New function. diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index bfb46a538b9..7613e190108 100644 --- 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 386b58e8020..874395af38d 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2020-11-04 Tom Tromey + + * 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 * 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 bf28b9113e4..adaee7d592d 100644 --- 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 da826a6e0ae..04b444ada95 100644 --- 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 0cebce3430b..d19ed2ed20a 100644 --- 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 . 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 fe8b6022702..d04809d9d0a 100644 --- 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; -- 2.30.2