From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2126) id 6A7C6385801B; Wed, 30 Mar 2022 15:05:08 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6A7C6385801B Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: quoted-printable From: Tom Tromey To: gdb-cvs@sourceware.org Subject: [binutils-gdb] Decode "dynamic" interface types in Ada X-Act-Checkin: binutils-gdb X-Git-Author: Tom Tromey X-Git-Refname: refs/heads/master X-Git-Oldrev: 5321c31bc78379a33f07dc7bef9256d05b942ad7 X-Git-Newrev: d537777dfe634f3109125156484e33d421b03f1b Message-Id: <20220330150508.6A7C6385801B@sourceware.org> Date: Wed, 30 Mar 2022 15:05:08 +0000 (GMT) X-BeenThere: gdb-cvs@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 30 Mar 2022 15:05:08 -0000 https://sourceware.org/git/gitweb.cgi?p=3Dbinutils-gdb.git;h=3Dd537777dfe63= 4f3109125156484e33d421b03f1b commit d537777dfe634f3109125156484e33d421b03f1b Author: Tom Tromey Date: Thu Mar 17 07:59:43 2022 -0600 Decode "dynamic" interface types in Ada =20 In Ada, if a class implements an interface and has a dynamic superclass, then the "offset to top" -- the offset that says how to turn a pointer to the interface into a pointer to the whole object -- is stored in the object itself. This patch changes GDB to understand this. =20 Because this only touches Ada code, and because Joel already reviewed it internally, I am checking it in. Diff: --- gdb/ada-lang.c | 51 ++++++++++++++++++--= ---- gdb/testsuite/gdb.ada/dynamic-iface.exp | 44 ++++++++++++++++++++ gdb/testsuite/gdb.ada/dynamic-iface/concrete.adb | 23 +++++++++++ gdb/testsuite/gdb.ada/dynamic-iface/concrete.ads | 36 +++++++++++++++++ gdb/testsuite/gdb.ada/dynamic-iface/main.adb | 24 +++++++++++ 5 files changed, 165 insertions(+), 13 deletions(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 59cbb110116..a3a1a2bcec5 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -6287,6 +6287,18 @@ ada_is_ignored_field (struct type *type, int field_n= um) should not be ignored either. */ if (name[0] =3D=3D '_' && !startswith (name, "_parent")) return 1; + + /* The compiler doesn't document this, but sometimes it emits + a field whose name starts with a capital letter, like 'V148s'. + These aren't marked as artificial in any way, but we know they + should be ignored. However, wrapper fields should not be + ignored. */ + if (name[0] =3D=3D 'S' || name[0] =3D=3D 'R' || name[0] =3D=3D 'O') + { + /* Wrapper field. */ + } + else if (isupper (name[0])) + return 1; } =20 /* If this is the dispatch table of a tagged type or an interface tag, @@ -6422,9 +6434,10 @@ ada_tag_value_at_base_address (struct value *obj) if (is_ada95_tag (tag)) return obj; =20 - ptr_type =3D language_lookup_primitive_type - (language_def (language_ada), target_gdbarch(), "storage_offset"); - ptr_type =3D lookup_pointer_type (ptr_type); + struct type *offset_type + =3D language_lookup_primitive_type (language_def (language_ada), + target_gdbarch(), "storage_offset"); + ptr_type =3D lookup_pointer_type (offset_type); val =3D value_cast (ptr_type, tag); if (!val) return obj; @@ -6456,16 +6469,28 @@ ada_tag_value_at_base_address (struct value *obj) if (offset_to_top =3D=3D -1) return obj; =20 - /* OFFSET_TO_TOP used to be a positive value to be subtracted - from the base address. This was however incompatible with - C++ dispatch table: C++ uses a *negative* value to *add* - to the base address. Ada's convention has therefore been - changed in GNAT 19.0w 20171023: since then, C++ and Ada - use the same convention. Here, we support both cases by - checking the sign of OFFSET_TO_TOP. */ - - if (offset_to_top > 0) - offset_to_top =3D -offset_to_top; + /* Storage_Offset'Last is used to indicate that a dynamic offset to + top is used. In this situation the offset is stored just after + the tag, in the object itself. */ + ULONGEST last =3D (((ULONGEST) 1) << (8 * TYPE_LENGTH (offset_type) - 1)= ) - 1; + if (offset_to_top =3D=3D last) + { + struct value *tem =3D value_addr (tag); + tem =3D value_ptradd (tem, 1); + tem =3D value_cast (ptr_type, tem); + offset_to_top =3D value_as_long (value_ind (tem)); + } + else if (offset_to_top > 0) + { + /* OFFSET_TO_TOP used to be a positive value to be subtracted + from the base address. This was however incompatible with + C++ dispatch table: C++ uses a *negative* value to *add* + to the base address. Ada's convention has therefore been + changed in GNAT 19.0w 20171023: since then, C++ and Ada + use the same convention. Here, we support both cases by + checking the sign of OFFSET_TO_TOP. */ + offset_to_top =3D -offset_to_top; + } =20 base_address =3D value_address (obj) + offset_to_top; tag =3D value_tag_from_contents_and_address (obj_type, NULL, base_addres= s); diff --git a/gdb/testsuite/gdb.ada/dynamic-iface.exp b/gdb/testsuite/gdb.ad= a/dynamic-iface.exp new file mode 100644 index 00000000000..2942a437687 --- /dev/null +++ b/gdb/testsuite/gdb.ada/dynamic-iface.exp @@ -0,0 +1,44 @@ +# Copyright 2022 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 } + +if {![gnat_runtime_has_debug_info]} { + untested "GNAT runtime debuginfo required for this test" + return -1 +} + +standard_ada_testfile main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug additiona= l_flags=3D-gnat05}] !=3D "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/concrete.adb] +runto "concrete.adb:$bp_location" + +gdb_test "print obj" \ + [string_to_regexp "(n =3D> 3, a =3D> \"ABC\", value =3D> 93)"] \ + "print local as interface" + +gdb_continue_to_breakpoint STOP + +gdb_test "print obj" \ + [string_to_regexp "(n =3D> 5, a =3D> \"DEFGH\", value =3D> 107)"] \ + "print local2 as interface" diff --git a/gdb/testsuite/gdb.ada/dynamic-iface/concrete.adb b/gdb/testsui= te/gdb.ada/dynamic-iface/concrete.adb new file mode 100644 index 00000000000..66cbbbcf41d --- /dev/null +++ b/gdb/testsuite/gdb.ada/dynamic-iface/concrete.adb @@ -0,0 +1,23 @@ +-- Copyright 2022 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 . + +package body Concrete is + + procedure Accept_Iface (Obj: Iface'Class) is + begin + null; -- STOP + end Accept_Iface; + +end Concrete; diff --git a/gdb/testsuite/gdb.ada/dynamic-iface/concrete.ads b/gdb/testsui= te/gdb.ada/dynamic-iface/concrete.ads new file mode 100644 index 00000000000..3d44e42d4f3 --- /dev/null +++ b/gdb/testsuite/gdb.ada/dynamic-iface/concrete.ads @@ -0,0 +1,36 @@ +-- Copyright 2022 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 . + +package Concrete is + type Iface is interface; + + type Base (N : Integer) is tagged record + A : String (1 .. N); + end record; + + -- An empty extension of Base. The compiler sources claimed there + -- was a special case for this, and while that doesn't seem to be + -- true in practice, it's worth checking. + type Intermediate is new Base with record + null; + end record; + + type Object is new Intermediate and Iface with record + Value: Integer; + end record; + + procedure Accept_Iface (Obj: Iface'Class); + +end Concrete; diff --git a/gdb/testsuite/gdb.ada/dynamic-iface/main.adb b/gdb/testsuite/g= db.ada/dynamic-iface/main.adb new file mode 100644 index 00000000000..01e19f297b5 --- /dev/null +++ b/gdb/testsuite/gdb.ada/dynamic-iface/main.adb @@ -0,0 +1,24 @@ +-- Copyright 2022 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 . + +with Concrete; use Concrete; + +procedure Main is + Local : Object :=3D (N =3D> 3, A =3D> "ABC", Value =3D> 93); + Local2 : Object :=3D (N =3D> 5, A =3D> "DEFGH", Value =3D> 107); +begin + Accept_Iface (Local); + Accept_Iface (Local2); +end Main;