Handle inherited discriminants in Ada

Message ID 20260320130551.1320760-1-tromey@adacore.com
State New
Headers
Series Handle inherited discriminants in Ada |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gdb_build--master-aarch64 success Build passed
linaro-tcwg-bot/tcwg_gdb_build--master-arm success Build passed
linaro-tcwg-bot/tcwg_gdb_check--master-aarch64 success Test passed
linaro-tcwg-bot/tcwg_gdb_check--master-arm success Test passed

Commit Message

Tom Tromey March 20, 2026, 1:05 p.m. UTC
  In Ada, a discriminant might be inherited.  Consider this code:

   type Root_T (Root_Disc : Boolean) is tagged record
      null;
   end record;
   type Child_T (Child_Disc : Boolean) is new Root_T (Root_Disc => Child_Disc) with record
      case Child_Disc is
         when True =>
            Child_Flag : Boolean;
         when others => null;
      end case;
   end record;

Here, Child_Disc does not really exist -- it just an alias of
Root_Disc.

Now, DWARF doesn't recognize this possibility, so compilers have come
up with two different approaches to handle this.

gnat-llvm will emit an artificial copy of Root_Disc as a member of
Child_T.  See commit 48b5669c, where this was handled in gdb.

It wasn't convenient to follow this same approach in GCC (the two
compilers have very different DWARF generation approaches), and so GCC
emits the possibly-more-intuitive approach of simply having the
DW_AT_discr refer to the field DIE in Root_T.

This patch implements support for this approach in gdb.  The idea here
is that, rather than try to figure out how to handle cross-type
references, gdb will implement the "LLVM" approach internally; that
is, make an artificial duplicate field.
---
 gdb/dwarf2/read.c                             |  60 +++++--
 gdb/testsuite/gdb.dwarf2/inherited-variant.c  |  23 +++
 .../gdb.dwarf2/inherited-variant.exp          | 149 ++++++++++++++++++
 3 files changed, 222 insertions(+), 10 deletions(-)
 create mode 100644 gdb/testsuite/gdb.dwarf2/inherited-variant.c
 create mode 100644 gdb/testsuite/gdb.dwarf2/inherited-variant.exp


base-commit: e5425f2687d66034a8d3fe94264cf99b42c1cb1a
  

Comments

Tom Tromey April 6, 2026, 5:20 p.m. UTC | #1
>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes:

Tom> In Ada, a discriminant might be inherited.  Consider this code:
...

Tom> This patch implements support for this approach in gdb.  The idea here
Tom> is that, rather than try to figure out how to handle cross-type
Tom> references, gdb will implement the "LLVM" approach internally; that
Tom> is, make an artificial duplicate field.

I'm checking this in.

Tom
  

Patch

diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index 8b87d58dd9c..0ab5ad984ea 100644
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -636,6 +636,14 @@  struct fnfieldlist
    in an instance of a field_info structure, as defined below.  */
 struct field_info
 {
+  explicit field_info (die_info *base)
+    : base_die (base)
+  {
+  }
+
+  /* The DIE for the overall structure.  */
+  die_info *base_die;
+
   /* List of data member and baseclasses fields.  */
   std::vector<struct nextfield> fields;
   std::vector<struct nextfield> baseclasses;
@@ -811,9 +819,6 @@  static void get_scope_pc_bounds (struct die_info *,
 static void dwarf2_record_block_ranges (struct die_info *, struct block *,
 					struct dwarf2_cu *);
 
-static void dwarf2_add_field (struct field_info *, struct die_info *,
-			      struct dwarf2_cu *);
-
 static void dwarf2_attach_fields_to_type (struct field_info *,
 					  struct type *, struct dwarf2_cu *);
 
@@ -9485,7 +9490,7 @@  compute_field_location (dwarf2_cu *cu, die_info *die, field *fp)
 
 static void
 dwarf2_add_field (struct field_info *fip, struct die_info *die,
-		  struct dwarf2_cu *cu)
+		  struct dwarf2_cu *cu, bool force_artificial = false)
 {
   struct nextfield *new_field;
   struct attribute *attr;
@@ -9519,6 +9524,9 @@  dwarf2_add_field (struct field_info *fip, struct die_info *die,
 
   fp = &new_field->field;
 
+  if (force_artificial)
+    fp->set_is_artificial (true);
+
   if ((die->tag == DW_TAG_member || die->tag == DW_TAG_namelist_item)
       && !die_is_declaration (die, cu))
     {
@@ -10559,6 +10567,29 @@  read_structure_type (struct die_info *die, struct dwarf2_cu *cu)
   return type;
 }
 
+/* Return true if DIE appears to be nested in the structure being
+   defined by FI.  */
+
+static bool
+field_info_encloses_die (field_info *fi, die_info *die)
+{
+  for (; die != nullptr; die = die->parent)
+    {
+      if (die == fi->base_die)
+	return true;
+
+      /* If the current DIE is not a member, then maybe we found a DIE
+	 that is nested in some other object that is itself nested in
+	 the outermost structure.  We do allow nesting in variants
+	 (though it's unclear if this really makes sense).  */
+      if (die->tag != DW_TAG_member && die->tag != DW_TAG_variant
+	  && die->tag != DW_TAG_variant_part)
+	return false;
+    }
+
+  return false;
+}
+
 static void handle_struct_member_die
   (struct die_info *child_die,
    struct type *type,
@@ -10592,11 +10623,6 @@  handle_variant_part (struct die_info *die, struct type *type,
       new_part = &current.variant_parts.emplace_back ();
     }
 
-  /* When we recurse, we want callees to add to this new variant
-     part.  */
-  scoped_restore save_current_variant_part
-    = make_scoped_restore (&fi->current_variant_part, new_part);
-
   struct attribute *discr = dwarf2_attr (die, DW_AT_discr, cu);
   if (discr == NULL)
     {
@@ -10608,6 +10634,15 @@  handle_variant_part (struct die_info *die, struct type *type,
       struct die_info *target_die = follow_die_ref (die, discr, &target_cu);
 
       new_part->discriminant_offset = target_die->sect_off;
+
+      /* In Ada, a discriminant might be inherited from some
+	 superclass.  DWARF does not admit this possibility, so
+	 compilers have adapted in one of two ways: LLVM emits a local
+	 copy of the field (marking it as artificial); but GCC just
+	 references the field DIE in the parent type.  Here we handle
+	 the GCC case by creating an artificial copy of the field.  */
+      if (!field_info_encloses_die (fi, target_die))
+	dwarf2_add_field (fi, target_die, cu, true);
     }
   else
     {
@@ -10617,6 +10652,10 @@  handle_variant_part (struct die_info *die, struct type *type,
 		 objfile_name (cu->per_objfile->objfile));
     }
 
+  /* When we recurse, we want callees to add to this new variant
+     part.  */
+  scoped_restore save_current_variant_part
+    = make_scoped_restore (&fi->current_variant_part, new_part);
   for (die_info *child_die : die->children ())
     handle_struct_member_die (child_die, type, fi, template_args, cu);
 }
@@ -10763,7 +10802,8 @@  process_structure_scope (struct die_info *die, struct dwarf2_cu *cu)
   bool has_template_parameters = false;
   if (die->child != NULL && ! die_is_declaration (die, cu))
     {
-      struct field_info fi;
+      field_info fi (die);
+
       std::vector<struct symbol *> template_args;
 
       for (die_info *child_die : die->children ())
diff --git a/gdb/testsuite/gdb.dwarf2/inherited-variant.c b/gdb/testsuite/gdb.dwarf2/inherited-variant.c
new file mode 100644
index 00000000000..9d70b82553c
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/inherited-variant.c
@@ -0,0 +1,23 @@ 
+/* Copyright 2026 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/>.  */
+
+unsigned char bufy[2] = { 1, 1 };
+unsigned char bufn[2] = { 0, 0 };
+
+int
+main (void)
+{
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.dwarf2/inherited-variant.exp b/gdb/testsuite/gdb.dwarf2/inherited-variant.exp
new file mode 100644
index 00000000000..5874f0f3e6e
--- /dev/null
+++ b/gdb/testsuite/gdb.dwarf2/inherited-variant.exp
@@ -0,0 +1,149 @@ 
+# Copyright 2026 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/>.
+
+# Test an inherited discriminant.
+#
+# In Ada, you can have a type with variant parts where the
+# discriminant is inherited from a superclass.  For instance this can
+# look like:
+#
+#   type Root_T (Root_Disc : Boolean) is tagged record
+#      Name : String (1 .. 8);
+#      Flag_1 : Boolean;
+#      Flag_2 : Boolean;
+#   end record;
+#   type Child_T (Child_Disc : Boolean) is new Root_T (Root_Disc => Child_Disc) with record
+#      case Child_Disc is
+#         when True =>
+#            Child_Flag : Boolean;
+#         when others => null;
+#      end case;
+#   end record;
+#
+# Here, Child_Disc does not really exist -- it is just an alias for
+# Root_Disc.  So, the DW_TAG_variant_part in Child_T will have a
+# DW_AT_discr referring to... what?
+#
+# Note that DWARF does not consider this problem, so there is no
+# standard solution.  LLVM handles this by emitting a copy of the
+# Root_Disc field, but marked as artificial; this way gdb's Ada
+# code knows not to print it.  GCC takes a different approach,
+# namely having the DW_AT_discr refer to the original Root_Disc
+# DIE, that appears in the Root_T structure.
+#
+# This test checks the latter scenario.  The type is slightly
+# different than the above, just to make it simpler to write this
+# test.
+
+load_lib dwarf.exp
+
+# This test can only be run on targets which support DWARF-2 and use
+# gas.
+require dwarf2_support
+
+standard_testfile .c .S
+
+# Make some DWARF for the test.
+set asm_file [standard_output_file $srcfile2]
+Dwarf::assemble $asm_file {
+    upvar cu_lang cu_lang
+
+    declare_labels bool_label root_label root_disc child_label
+
+    cu { addr_size 4 } {
+	compile_unit {
+	    DW_AT_name user.adb
+	    DW_AT_language @DW_LANG_Ada95
+	} {
+	    bool_label: DW_TAG_base_type {
+		DW_AT_byte_size 1 DW_FORM_sdata
+		DW_AT_encoding	@DW_ATE_boolean
+		DW_AT_name bool
+	    }
+
+	    root_label: structure_type {
+		DW_AT_name root
+		DW_AT_byte_size 1 DW_FORM_sdata
+	    } {
+		root_disc: DW_TAG_member {
+		    DW_AT_name root_disc
+		    DW_AT_type :$bool_label
+		    DW_AT_data_member_location 0 data1
+		}
+	    }
+
+	    child_label: DW_TAG_structure_type {
+		DW_AT_name child
+		DW_AT_byte_size 2 DW_FORM_sdata
+	    } {
+		DW_TAG_member {
+		    DW_AT_name _parent
+		    DW_AT_type :$root_label
+		    DW_AT_data_member_location 0 DW_FORM_data1
+		}
+
+		DW_TAG_variant_part {
+		    DW_AT_discr :$root_disc DW_FORM_ref4
+		} {
+		    DW_TAG_variant {
+			DW_AT_discr_value 1 DW_FORM_udata
+		    } {
+			DW_TAG_member {
+			    DW_AT_name child_flag DW_FORM_strp
+			    DW_AT_type :$bool_label
+			    DW_AT_data_member_location 1 DW_FORM_data1
+			}
+		    }
+		}
+	    }
+
+	    DW_TAG_variable {
+		DW_AT_name "withchild"
+		DW_AT_type :$child_label
+		DW_AT_external 1 DW_FORM_flag
+		DW_AT_location {
+		    DW_OP_addr [gdb_target_symbol "bufy"]
+		} SPECIAL_expr
+	    }
+
+	    DW_TAG_variable {
+		DW_AT_name "withoutchild"
+		DW_AT_type :$child_label
+		DW_AT_external 1 DW_FORM_flag
+		DW_AT_location {
+		    DW_OP_addr [gdb_target_symbol "bufn"]
+		} SPECIAL_expr
+	    }
+	}
+    }
+}
+
+if {[prepare_for_testing "failed to prepare" ${testfile} \
+	 [list $srcfile $asm_file] debug]} {
+    return
+}
+
+if {![runto_main]} {
+    return
+}
+
+gdb_test "set language ada"
+
+gdb_test "print withchild" \
+    [quotemeta {$@DECIMAL = (root_disc => true, child_flag => true)}]
+gdb_test "print withchild.child_flag" \
+    [quotemeta {$@DECIMAL = true}]
+gdb_test "print withoutchild" \
+    [quotemeta {$@DECIMAL = (root_disc => false)}]