From patchwork Wed Apr 24 18:51:29 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom Tromey X-Patchwork-Id: 32404 Received: (qmail 2039 invoked by alias); 24 Apr 2019 18:51:35 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 2030 invoked by uid 89); 24 Apr 2019 18:51:35 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-22.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=R01, r01 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 24 Apr 2019 18:51:33 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 9FB691171B6; Wed, 24 Apr 2019 14:51:31 -0400 (EDT) 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 aWY3Iy6piNJt; Wed, 24 Apr 2019 14:51:31 -0400 (EDT) Received: from murgatroyd.Home (97-122-168-123.hlrn.qwest.net [97.122.168.123]) (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 4B85C1171B5; Wed, 24 Apr 2019 14:51:31 -0400 (EDT) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH] Fix VLA printing for Ada Date: Wed, 24 Apr 2019 12:51:29 -0600 Message-Id: <20190424185129.11059-1-tromey@adacore.com> MIME-Version: 1.0 While looking at a different Ada problem, I found that printing a record containing a VLA did not work properly. I tracked the problem down to dwarf2_evaluate_property trying, and failing, to compare two types that differed only in qualifiers. This patch changes dwarf2_evaluate_property to ignore qualifiers when comparing types. Tested on x86-64 Fedora 29. gdb/ChangeLog 2019-04-24 Tom Tromey * dwarf2loc.c (dwarf2_evaluate_property) : Compare main types. gdb/testsuite/ChangeLog 2019-04-24 Tom Tromey * gdb.ada/vla.exp: New file. * gdb.ada/vla/vla.adb: New file. --- gdb/ChangeLog | 5 +++ gdb/dwarf2loc.c | 8 +++-- gdb/testsuite/ChangeLog | 5 +++ gdb/testsuite/gdb.ada/vla.exp | 38 +++++++++++++++++++++ gdb/testsuite/gdb.ada/vla/vla.adb | 57 +++++++++++++++++++++++++++++++ 5 files changed, 111 insertions(+), 2 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/vla.exp create mode 100644 gdb/testsuite/gdb.ada/vla/vla.adb diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c index bd630ee0588..c5145af7c66 100644 --- a/gdb/dwarf2loc.c +++ b/gdb/dwarf2loc.c @@ -2493,8 +2493,12 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, struct value *val; for (pinfo = addr_stack; pinfo != NULL; pinfo = pinfo->next) - if (pinfo->type == baton->referenced_type) - break; + { + /* This approach lets us avoid checking the qualifiers. */ + if (TYPE_MAIN_TYPE (pinfo->type) + == TYPE_MAIN_TYPE (baton->referenced_type)) + break; + } if (pinfo == NULL) error (_("cannot find reference address for offset property")); if (pinfo->valaddr != NULL) diff --git a/gdb/testsuite/gdb.ada/vla.exp b/gdb/testsuite/gdb.ada/vla.exp new file mode 100644 index 00000000000..7e10e9b8223 --- /dev/null +++ b/gdb/testsuite/gdb.ada/vla.exp @@ -0,0 +1,38 @@ +# Copyright 2019 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" + +if { [skip_ada_tests] } { return -1 } + +standard_ada_testfile vla + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "Set breakpoint here" ${testdir}/vla.adb] +runto "vla.adb:$bp_location" + +gdb_test "print r00" \ + "= \\(l1 => 0, l2 => 0, i1 => 1, i2 => 2, i3 => 3, a1 => \\(\\), a2 => \\(\\)\\)" +gdb_test "print r01" \ + "= \\(l1 => 0, l2 => 1, i1 => 1, i2 => 2, i3 => 3, a1 => \\(\\), a2 => \\(20\\)\\)" +gdb_test "print r10" \ + "= \\(l1 => 1, l2 => 0, i1 => 1, i2 => 2, i3 => 3, a1 => \\(10\\), a2 => \\(\\)\\)" +gdb_test "print r22" \ + "= \\(l1 => 2, l2 => 2, i1 => 1, i2 => 2, i3 => 3, a1 => \\(10, 10\\), a2 => \\(20, 20\\)\\)" diff --git a/gdb/testsuite/gdb.ada/vla/vla.adb b/gdb/testsuite/gdb.ada/vla/vla.adb new file mode 100644 index 00000000000..2b6cc8a1114 --- /dev/null +++ b/gdb/testsuite/gdb.ada/vla/vla.adb @@ -0,0 +1,57 @@ +-- Copyright 2019 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 Vla is + type Array_Type is array (Natural range <>) of Integer; + type Record_Type (L1, L2 : Natural) is record + I1 : Integer; + A1 : Array_Type (1 .. L1); + I2 : Integer; + A2 : Array_Type (1 .. L2); + I3 : Integer; + end record; + + procedure Process (R : Record_Type) is + begin + null; + end Process; + + R00 : Record_Type := + (L1 => 0, L2 => 0, + I1 => 1, A1 => (others => 10), + I2 => 2, A2 => (others => 20), + I3 => 3); + R01 : Record_Type := + (L1 => 0, L2 => 1, + I1 => 1, A1 => (others => 10), + I2 => 2, A2 => (others => 20), + I3 => 3); + R10 : Record_Type := + (L1 => 1, L2 => 0, + I1 => 1, A1 => (others => 10), + I2 => 2, A2 => (others => 20), + I3 => 3); + R22 : Record_Type := + (L1 => 2, L2 => 2, + I1 => 1, A1 => (others => 10), + I2 => 2, A2 => (others => 20), + I3 => 3); + +begin + Process (R00); -- Set breakpoint here + Process (R01); + Process (R10); + Process (R22); +end Vla;