Handle dynamic field properties

I found a situation where gdb could not properly decode an Ada type.
In this first scenario, the discriminant of a type is a bit-field.
PROP_ADDR_OFFSET does not handle this situation, because it only
allows an offset -- not a bit-size.

My original approach to this just added a bit size as well, but after
some discussion with Eric Botcazou, we found another failing case: a
tagged type can have a second discriminant that appears at a variable
offset.

So, this patch changes this code to accept a general 'struct field'
instead of trying to replicate the field-finding machinery by itself.

This is handled at property-evaluation time by simply using a 'field'
and resolving its dynamic properties.  Then the usual field-extraction
function is called to get the value.

Because the baton now just holds a field, I renamed PROP_ADDR_OFFSET
to PROP_FIELD.

The DWARF reader now defers filling in the property baton until the
fields have been attached to the type.

Finally, I noticed that if the discriminant field has a biased
representation, then unpack_field_as_long would not handle this
either.  This bug is also fixed here, and the test case checks this.

Regression tested on x86-64 Fedora 41.

gdb/dwarf2/cu.h

@@ -27,6 +27,8 @@
 #include "gdbsupport/unordered_set.h"
 #include "dwarf2/die.h"
 
+struct field_info;
+
 /* Type used for delaying computation of method physnames.
    See comments for compute_delayed_physnames.  */
 struct delayed_method_info
@@ -399,6 +401,15 @@ public:
      .debug_str_offsets section (8 or 4, depending on the address size).  */
   std::optional<ULONGEST> str_offsets_base;
 
+  /* We may encounter a DIE where a property refers to a field in some
+     outer type.  For example, in Ada, an array length may depend on a
+     field in some outer record.  In this case, we need to be able to
+     stash a pointer to the 'struct field' into the appropriate
+     dynamic property baton.  However, the fields aren't created until
+     the type has been fully processed, so we need a temporary
+     back-link to this object.  */
+  struct field_info *field_info = nullptr;
+
   /* Mark used when releasing cached dies.  */
   bool m_mark : 1;
 

gdb/dwarf2/loc.c

@@ -1732,11 +1732,10 @@ dwarf2_evaluate_property (const dynamic_prop *prop,
       *value = prop->const_val ();
       return true;
 
-    case PROP_ADDR_OFFSET:
+    case PROP_FIELD:
       {
 	const dwarf2_property_baton *baton = prop->baton ();
 	const struct property_addr_info *pinfo;
-	struct value *val;
 
 	for (pinfo = addr_stack; pinfo != NULL; pinfo = pinfo->next)
 	  {
@@ -1747,14 +1746,40 @@ dwarf2_evaluate_property (const dynamic_prop *prop,
 	  }
 	if (pinfo == NULL)
 	  error (_("cannot find reference address for offset property"));
-	if (pinfo->valaddr.data () != NULL)
+
-	  val = value_from_contents
+	struct field resolved_field = *baton->field;
-		  (baton->offset_info.type,
+	resolve_dynamic_field (resolved_field, pinfo, initial_frame);
-		   pinfo->valaddr.data () + baton->offset_info.offset);
+
-	else
+	/* Storage for memory if we need to read it.  */
-	  val = value_at (baton->offset_info.type,
+	gdb::byte_vector memory;
-			  pinfo->addr + baton->offset_info.offset);
+	const gdb_byte *bytes = pinfo->valaddr.data ();
-	*value = value_as_address (val);
+	if (bytes == nullptr)
+	  {
+	    int bitpos = resolved_field.loc_bitpos ();
+	    int bitsize = resolved_field.bitsize ();
+	    if (bitsize == 0)
+	      bitsize = check_typedef (resolved_field.type ())->length () * 8;
+
+	    /* Read just the minimum number of bytes needed to satisfy
+	       unpack_field_as_long.  So, update the resolved field's
+	       starting offset to remove any unnecessary leading
+	       bytes.  */
+	    int byte_offset = bitpos / 8;
+
+	    bitpos %= 8;
+	    resolved_field.set_loc_bitpos (bitpos);
+
+	    /* Make sure to include any remaining bit offset in the
+	       size computation, in case the value straddles a
+	       byte.  */
+	    int byte_length = align_up (bitsize + bitpos, 8) / 8;
+	    memory.resize (byte_length);
+
+	    read_memory (pinfo->addr + byte_offset, memory.data (),
+			 byte_length);
+	    bytes = memory.data ();
+	  }
+	*value = unpack_field_as_long (bytes, &resolved_field);
 	return true;
       }
 

gdb/dwarf2/loc.h

@@ -202,23 +202,6 @@ struct dwarf2_loclist_baton
   unsigned char dwarf_version;
 };
 
-/* The baton used when a dynamic property is an offset to a parent
-   type.  This can be used, for instance, then the bound of an array
-   inside a record is determined by the value of another field inside
-   that record.  */
-
-struct dwarf2_offset_baton
-{
-  /* The offset from the parent type where the value of the property
-     is stored.  In the example provided above, this would be the offset
-     of the field being used as the array bound.  */
-  LONGEST offset;
-
-  /* The type of the object whose property is dynamic.  In the example
-     provided above, this would the array's index type.  */
-  struct type *type;
-};
-
 /* A dynamic property is either expressed as a single location expression
    or a location list.  If the property is an indirection, pointing to
    another die, keep track of the targeted type in PROPERTY_TYPE.
@@ -241,8 +224,8 @@ struct dwarf2_property_baton
     /* Location list to be evaluated in the context of PROPERTY_TYPE.  */
     struct dwarf2_loclist_baton loclist;
 
-    /* The location is an offset to PROPERTY_TYPE.  */
+    /* The location is stored in a field of PROPERTY_TYPE.  */
-    struct dwarf2_offset_baton offset_info;
+    struct field *field;
   };
 };
 

gdb/dwarf2/read.c

@@ -698,6 +698,12 @@ struct field_info
      we're reading.  */
   std::vector<variant_part_builder> variant_parts;
 
+  /* All the field batons that must be updated.  This is only used
+     when a type's property depends on a field of this structure; for
+     example in Ada when an array's length may come from a field of an
+     enclosing record.  */
+  gdb::unordered_map<dwarf2_property_baton *, sect_offset> field_batons;
+
   /* Return the total number of fields (including baseclasses).  */
   int nfields () const
   {
@@ -9861,54 +9867,6 @@ dwarf2_access_attribute (struct die_info *die, struct dwarf2_cu *cu)
     }
 }
 
-/* Look for DW_AT_data_member_location or DW_AT_data_bit_offset.  Set
-   *OFFSET to the byte offset.  If the attribute was not found return
-   0, otherwise return 1.  If it was found but could not properly be
-   handled, set *OFFSET to 0.  */
-
-static int
-handle_member_location (struct die_info *die, struct dwarf2_cu *cu,
-			LONGEST *offset)
-{
-  struct attribute *attr;
-
-  attr = dwarf2_attr (die, DW_AT_data_member_location, cu);
-  if (attr != NULL)
-    {
-      *offset = 0;
-      CORE_ADDR temp;
-
-      /* Note that we do not check for a section offset first here.
-	 This is because DW_AT_data_member_location is new in DWARF 4,
-	 so if we see it, we can assume that a constant form is really
-	 a constant and not a section offset.  */
-      if (attr->form_is_constant ())
-	*offset = attr->unsigned_constant ().value_or (0);
-      else if (attr->form_is_section_offset ())
-	dwarf2_complex_location_expr_complaint ();
-      else if (attr->form_is_block ()
-	       && decode_locdesc (attr->as_block (), cu, &temp))
-	{
-	  *offset = temp;
-	}
-      else
-	dwarf2_complex_location_expr_complaint ();
-
-      return 1;
-    }
-  else
-    {
-      attr = dwarf2_attr (die, DW_AT_data_bit_offset, cu);
-      if (attr != nullptr)
-	{
-	  *offset = attr->unsigned_constant ().value_or (0);
-	  return 1;
-	}
-    }
-
-  return 0;
-}
-
 /* Look for DW_AT_data_member_location or DW_AT_data_bit_offset and
    store the results in FIELD.  */
 
@@ -11269,6 +11227,56 @@ handle_struct_member_die (struct die_info *child_die, struct type *type,
     handle_variant (child_die, type, fi, template_args, cu);
 }
 
+/* Create a property baton for a field of the struct type currently
+   being processed.  OFFSET is the DIE offset of the field in the
+   structure.  If OFFSET is found among the fields that have already
+   been seen, then a new property baton is allocated on the objfile
+   obstack and returned.  The baton isn't fully filled in -- it will
+   be post-processed once the fields are finally created; see
+   update_field_batons.  If OFFSET is not found, NULL is returned.  */
+
+static dwarf2_property_baton *
+find_field_create_baton (dwarf2_cu *cu, sect_offset offset)
+{
+  field_info *fi = cu->field_info;
+  /* Defensive programming in case we see unusual DWARF.  */
+  if (fi == nullptr)
+    return nullptr;
+  for (const auto &fld : fi->fields)
+    if (fld.offset == offset)
+      {
+	dwarf2_property_baton *result
+	  = XOBNEW (&cu->per_objfile->objfile->objfile_obstack,
+		    struct dwarf2_property_baton);
+	fi->field_batons[result] = offset;
+	return result;
+      }
+  return nullptr;
+}
+
+/* Update all the stored field property batons.  FI is the field info
+   for the structure being created.  TYPE is the corresponding struct
+   type with its fields already filled in.  This fills in the correct
+   field for each baton that was stored while processing this
+   type.  */
+
+static void
+update_field_batons (field_info *fi, struct type *type)
+{
+  int n_bases = fi->baseclasses.size ();
+  for (auto &[baton, offset] : fi->field_batons)
+    {
+      for (int i = 0; i < fi->fields.size (); ++i)
+	{
+	  if (fi->fields[i].offset == offset)
+	    {
+	      baton->field = &type->field (n_bases + i);
+	      break;
+	    }
+	}
+    }
+}
+
 /* Finish creating a structure or union type, including filling in its
    members and creating a symbol for it. This function also handles Fortran
    namelist variables, their items or members and creating a symbol for
@@ -11290,6 +11298,9 @@ process_structure_scope (struct die_info *die, struct dwarf2_cu *cu)
       struct field_info fi;
       std::vector<struct symbol *> template_args;
 
+      scoped_restore save_field_info
+	= make_scoped_restore (&cu->field_info, &fi);
+
       for (die_info *child_die : die->children ())
 	handle_struct_member_die (child_die, type, &fi, &template_args, cu);
 
@@ -11311,7 +11322,11 @@ process_structure_scope (struct die_info *die, struct dwarf2_cu *cu)
 
       /* Attach fields and member functions to the type.  */
       if (fi.nfields () > 0)
+	{
 	  dwarf2_attach_fields_to_type (&fi, type, cu);
+	  update_field_batons (&fi, type);
+	}
+
       if (!fi.fnfieldlists.empty ())
 	{
 	  dwarf2_attach_fn_fields_to_type (&fi, type, cu);
@@ -13925,17 +13940,14 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
 	  case DW_AT_data_member_location:
 	  case DW_AT_data_bit_offset:
 	    {
-	      LONGEST offset;
+	      baton = find_field_create_baton (cu, target_die->sect_off);
-
+	      if (baton == nullptr)
-	      if (!handle_member_location (target_die, target_cu, &offset))
 		return 0;
 
-	      baton = XOBNEW (obstack, struct dwarf2_property_baton);
 	      baton->property_type = read_type_die (target_die->parent,
 						    target_cu);
-	      baton->offset_info.offset = offset;
+	      baton->field = nullptr;
-	      baton->offset_info.type = die_type (target_die, target_cu);
+	      prop->set_field (baton);
-	      prop->set_addr_offset (baton);
 	      break;
 	    }
 	}

gdb/gdbtypes.c

@@ -902,7 +902,7 @@ operator== (const dynamic_prop &l, const dynamic_prop &r)
       return true;
     case PROP_CONST:
       return l.const_val () == r.const_val ();
-    case PROP_ADDR_OFFSET:
+    case PROP_FIELD:
     case PROP_LOCEXPR:
     case PROP_LOCLIST:
       return l.baton () == r.baton ();

gdb/gdbtypes.h

@@ -259,7 +259,7 @@ enum dynamic_prop_kind
 {
   PROP_UNDEFINED, /* Not defined.  */
   PROP_CONST,     /* Constant.  */
-  PROP_ADDR_OFFSET, /* Address offset.  */
+  PROP_FIELD,	  /* Field of a type.  */
   PROP_LOCEXPR,   /* Location expression.  */
   PROP_LOCLIST,    /* Location list.  */
   PROP_VARIANT_PARTS, /* Variant parts.  */
@@ -347,7 +347,7 @@ struct dynamic_prop
   {
     gdb_assert (m_kind == PROP_LOCEXPR
 		|| m_kind == PROP_LOCLIST
-		|| m_kind == PROP_ADDR_OFFSET);
+		|| m_kind == PROP_FIELD);
 
     return m_data.baton;
   }
@@ -364,9 +364,9 @@ struct dynamic_prop
     m_data.baton = baton;
   }
 
-  void set_addr_offset (const dwarf2_property_baton *baton)
+  void set_field (const dwarf2_property_baton *baton)
   {
-    m_kind = PROP_ADDR_OFFSET;
+    m_kind = PROP_FIELD;
     m_data.baton = baton;
   }
 

gdb/testsuite/gdb.ada/packed_record_2.exp

@@ -0,0 +1,61 @@
+# Copyright 2025 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"
+
+require allow_ada_tests
+
+standard_ada_testfile exam
+
+set flags {debug}
+if {[ada_minimal_encodings]} {
+    lappend flags additional_flags=-fgnat-encodings=minimal
+}
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/exam.adb]
+runto "exam.adb:$bp_location"
+
+set spr_contents "discr => 3, field => -4, array_field => \\(-5, -6, -7\\)"
+
+gdb_test "print spr" " = \\($spr_contents\\)"
+
+gdb_test "print spr.discr" " = 3"
+
+# See PR ada/32880 -- gdb should probably print array (1 .. 3) here,
+# but instead shows array (<>).  However as this isn't totally
+# relevant to this test, we just accept it.
+gdb_test "ptype spr" \
+    [multi_line \
+	 "type = tagged record" \
+	 "    discr: range 1 .. 8;" \
+	 "    field: range -7 .. -4;" \
+	 "    array_field: array \\(<>\\) of exam.small <packed: 2-bit elements>;" \
+	 "end record"]
+
+gdb_test_multiple "print sc" "" {
+    -re " \\($spr_contents, outer => 2, another_array => \\(-7, -6\\)\\)" {
+	pass $gdb_test_name
+    }
+    -re " \\($spr_contents, outer => $decimal, another_array => \\(.*\\)\\)" {
+	# Other output is a known GCC bug.
+	xfail $gdb_test_name
+    }
+}

gdb/testsuite/gdb.ada/packed_record_2/exam.adb

@@ -0,0 +1,51 @@
+--  Copyright 2025 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/>.
+
+procedure Exam is
+   type Small is range -7 .. -4;
+   for Small'Size use 2;
+
+   type Range_Int is range 1 .. 8;
+   for Range_Int'Size use 3;
+
+   type Packed_Array is array (Range_Int range <>) of Small;
+   pragma pack (Packed_Array);
+
+   type Some_Packed_Record (Discr : Range_Int) is tagged record
+      Field: Small;
+      Array_Field : Packed_Array (1 .. Discr);
+   end record;
+   pragma Pack (Some_Packed_Record);
+
+   type Sub_Class (Inner, Outer : Range_Int)
+   is new Some_Packed_Record (Inner) with
+      record
+         Another_Array : Packed_Array (1 .. Outer);
+      end record;
+   pragma Pack (Sub_Class);
+
+   SPR : Some_Packed_Record := (Discr => 3,
+                                Field => -4,
+                                Array_Field => (-5, -6, -7));
+
+   SC : Sub_Class := (Inner => 3,
+                      Outer => 2,
+                      Field => -4,
+                      Array_Field => (-5, -6, -7),
+                      Another_Array => (-7, -6));
+
+begin
+   null;                        --  STOP
+end Exam;

gdb/value.c

@@ -3266,6 +3266,9 @@ unpack_bits_as_long (struct type *field_type, const gdb_byte *valaddr,
 	}
     }
 
+  if (field_type->code () == TYPE_CODE_RANGE)
+    val += field_type->bounds ()->bias;
+
   return val;
 }