From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 6B1053857C50 for ; Wed, 30 Sep 2020 20:07:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 6B1053857C50 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=tromey@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id AD8241175C7; Wed, 30 Sep 2020 16:06:06 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id yJmIJxAnCP3I; Wed, 30 Sep 2020 16:06:06 -0400 (EDT) Received: from murgatroyd.Home (97-118-100-18.hlrn.qwest.net [97.118.100.18]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by rock.gnat.com (Postfix) with ESMTPSA id 6AB111175B8; Wed, 30 Sep 2020 16:06:06 -0400 (EDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH 5/9] Resolve dynamic type in ada_value_struct_elt Date: Wed, 30 Sep 2020 14:05:56 -0600 Message-Id: <20200930200600.1207702-6-tromey@adacore.com> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200930200600.1207702-1-tromey@adacore.com> References: <20200930200600.1207702-1-tromey@adacore.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 30 Sep 2020 20:07:08 -0000 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. 2020-09-30 Tom Tromey * ada-lang.c (ada_value_struct_elt): Resolve dynamic type. gdb/testsuite/ChangeLog 2020-09-30 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/ada-lang.c b/gdb/ada-lang.c index d851f57414b..e81a7877ccb 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -4414,6 +4414,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/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.26.2