public inbox for gdb-cvs@sourceware.org
help / color / mirror / Atom feed
* [binutils-gdb] Decode "dynamic" interface types in Ada
@ 2022-03-30 15:05 Tom Tromey
0 siblings, 0 replies; only message in thread
From: Tom Tromey @ 2022-03-30 15:05 UTC (permalink / raw)
To: gdb-cvs
https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=d537777dfe634f3109125156484e33d421b03f1b
commit d537777dfe634f3109125156484e33d421b03f1b
Author: Tom Tromey <tromey@adacore.com>
Date: Thu Mar 17 07:59:43 2022 -0600
Decode "dynamic" interface types in Ada
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.
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_num)
should not be ignored either. */
if (name[0] == '_' && !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] == 'S' || name[0] == 'R' || name[0] == 'O')
+ {
+ /* Wrapper field. */
+ }
+ else if (isupper (name[0]))
+ return 1;
}
/* 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;
- ptr_type = language_lookup_primitive_type
- (language_def (language_ada), target_gdbarch(), "storage_offset");
- ptr_type = lookup_pointer_type (ptr_type);
+ struct type *offset_type
+ = language_lookup_primitive_type (language_def (language_ada),
+ target_gdbarch(), "storage_offset");
+ ptr_type = lookup_pointer_type (offset_type);
val = 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 == -1)
return obj;
- /* 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 = -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 = (((ULONGEST) 1) << (8 * TYPE_LENGTH (offset_type) - 1)) - 1;
+ if (offset_to_top == last)
+ {
+ struct value *tem = value_addr (tag);
+ tem = value_ptradd (tem, 1);
+ tem = value_cast (ptr_type, tem);
+ offset_to_top = 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 = -offset_to_top;
+ }
base_address = value_address (obj) + offset_to_top;
tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
diff --git a/gdb/testsuite/gdb.ada/dynamic-iface.exp b/gdb/testsuite/gdb.ada/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 <http://www.gnu.org/licenses/>.
+
+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 additional_flags=-gnat05}] != "" } {
+ 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 => 3, a => \"ABC\", value => 93)"] \
+ "print local as interface"
+
+gdb_continue_to_breakpoint STOP
+
+gdb_test "print obj" \
+ [string_to_regexp "(n => 5, a => \"DEFGH\", value => 107)"] \
+ "print local2 as interface"
diff --git a/gdb/testsuite/gdb.ada/dynamic-iface/concrete.adb b/gdb/testsuite/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 <http://www.gnu.org/licenses/>.
+
+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/testsuite/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 <http://www.gnu.org/licenses/>.
+
+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/gdb.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 <http://www.gnu.org/licenses/>.
+
+with Concrete; use Concrete;
+
+procedure Main is
+ Local : Object := (N => 3, A => "ABC", Value => 93);
+ Local2 : Object := (N => 5, A => "DEFGH", Value => 107);
+begin
+ Accept_Iface (Local);
+ Accept_Iface (Local2);
+end Main;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-03-30 15:05 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-03-30 15:05 [binutils-gdb] Decode "dynamic" interface types in Ada Tom Tromey
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).