From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id 1725B3877023 for ; Tue, 17 Mar 2020 18:00:37 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 1725B3877023 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 B4AB856125; Tue, 17 Mar 2020 14:00:36 -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 Jtn8v+-hV4or; Tue, 17 Mar 2020 14:00:36 -0400 (EDT) Received: from murgatroyd.Home (97-118-117-21.hlrn.qwest.net [97.118.117.21]) (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 6F7F756124; Tue, 17 Mar 2020 14:00:36 -0400 (EDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH] Fix Ada val_print removal regression Date: Tue, 17 Mar 2020 12:00:34 -0600 Message-Id: <20200317180034.26934-1-tromey@adacore.com> X-Mailer: git-send-email 2.21.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-24.5 required=5.0 tests=GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_NONE, SPF_PASS 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: Tue, 17 Mar 2020 18:00:38 -0000 The removal of val_print caused a regression in the Ada code. In one scenario, a variant type would not be properly printed, because the address of a component was lost. This patch fixes the bug in the most straightforward way, by arranging to preserve the address. gdb/ChangeLog 2020-03-17 Tom Tromey * ada-valprint.c (print_variant_part): Add "address" parameter. (print_field_values): Likewise. (ada_val_print_struct_union): Update. gdb/testsuite/ChangeLog 2020-03-17 Tom Tromey * gdb.ada/sub_variant/subv.adb: New file. * gdb.ada/sub_variant.exp: New file. --- gdb/ChangeLog | 6 +++ gdb/ada-valprint.c | 19 +++++---- gdb/testsuite/ChangeLog | 5 +++ gdb/testsuite/gdb.ada/sub_variant.exp | 34 ++++++++++++++++ gdb/testsuite/gdb.ada/sub_variant/subv.adb | 45 ++++++++++++++++++++++ 5 files changed, 101 insertions(+), 8 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/sub_variant.exp create mode 100644 gdb/testsuite/gdb.ada/sub_variant/subv.adb diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index abf7ba4b959..46209a5be3d 100644 --- a/gdb/ada-valprint.c +++ b/gdb/ada-valprint.c @@ -31,7 +31,7 @@ #include "gdbarch.h" static int print_field_values (struct type *, const gdb_byte *, - int, + CORE_ADDR, int, struct ui_file *, int, struct value *, const struct value_print_options *, @@ -554,7 +554,7 @@ ada_printstr (struct ui_file *stream, struct type *type, static int print_variant_part (struct type *type, int field_num, - const gdb_byte *valaddr, int offset, + const gdb_byte *valaddr, CORE_ADDR address, int offset, struct ui_file *stream, int recurse, struct value *val, const struct value_print_options *options, @@ -571,7 +571,7 @@ print_variant_part (struct type *type, int field_num, else return print_field_values (TYPE_FIELD_TYPE (var_type, which), - valaddr, + valaddr, address, offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT, stream, recurse, val, options, @@ -595,6 +595,7 @@ print_variant_part (struct type *type, int field_num, static int print_field_values (struct type *type, const gdb_byte *valaddr, + CORE_ADDR address, int offset, struct ui_file *stream, int recurse, struct value *val, const struct value_print_options *options, @@ -615,7 +616,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr, { comma_needed = print_field_values (TYPE_FIELD_TYPE (type, i), - valaddr, + valaddr, address, (offset + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT), stream, recurse, val, options, @@ -625,7 +626,7 @@ print_field_values (struct type *type, const gdb_byte *valaddr, else if (ada_is_variant_part (type, i)) { comma_needed = - print_variant_part (type, i, valaddr, + print_variant_part (type, i, valaddr, address, offset, stream, recurse, val, options, comma_needed, outer_type, outer_offset, language); @@ -689,8 +690,10 @@ print_field_values (struct type *type, const gdb_byte *valaddr, LONGEST local_off = (offset + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT); - struct value *v = value_from_contents (TYPE_FIELD_TYPE (type, i), - valaddr + local_off); + struct value *v + = value_from_contents_and_address (TYPE_FIELD_TYPE (type, i), + valaddr + local_off, + address + local_off); common_val_print (v, stream, recurse + 1, &opts, language); } annotate_field_end (); @@ -941,7 +944,7 @@ ada_val_print_struct_union fprintf_filtered (stream, "("); - if (print_field_values (type, valaddr, offset_aligned, + if (print_field_values (type, valaddr, address, offset_aligned, stream, recurse, original_value, options, 0, type, offset_aligned, language_def (language_ada)) != 0 diff --git a/gdb/testsuite/gdb.ada/sub_variant.exp b/gdb/testsuite/gdb.ada/sub_variant.exp new file mode 100644 index 00000000000..381d138234d --- /dev/null +++ b/gdb/testsuite/gdb.ada/sub_variant.exp @@ -0,0 +1,34 @@ +# Copyright 2020 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" + +standard_ada_testfile subv + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/subv.adb] +runto "subv.adb:$bp_location" + +gdb_test "print q" \ + "\\(indicator => first, associated => \\(indicator => first, value => 42\\), value => 51\\)" +gdb_test "print r" \ + "\\(indicator => first, associated => \\(indicator => last\\), value => 51\\)" +gdb_test "print s" \ + "\\(indicator => last, associated => \\(indicator => first, value => 42\\)\\)" diff --git a/gdb/testsuite/gdb.ada/sub_variant/subv.adb b/gdb/testsuite/gdb.ada/sub_variant/subv.adb new file mode 100644 index 00000000000..632ec32087d --- /dev/null +++ b/gdb/testsuite/gdb.ada/sub_variant/subv.adb @@ -0,0 +1,45 @@ +-- Copyright 2020 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 . + +procedure Subv is + type Indicator_T is (First, Last); + + type T1 (Indicator : Indicator_T := First) is + record + case Indicator is + when First => + Value : Natural; + when Last => + null; + end case; + end record; + + type T2 (Indicator : Indicator_T := First) is + record + Associated : T1; + case Indicator is + when First => + Value : Natural; + when Last => + null; + end case; + end record; + + Q : T2 := ( First, (First, 42), 51 ); + R : T2 := ( First, (Indicator => Last), 51 ); + S : T2 := ( Last, (First, 42)); +begin + null; -- STOP +end; -- 2.21.1