Handle field with dynamic bit offset

I discovered that GCC emitted incorrect DWARF for the test case
included in this patch.  Eric wrote a fix for GCC, but then he found
that gdb crashed on the resulting file.

This test has a field that is at a non-constant bit offset from the
start of the type.  DWARF 5 does not allow for this situation (I've
sent a report to the DWARF list), but DWARF 3 did allow for this via a
combination of an expression for the byte offset and then the use of
DW_AT_bit_offset.  This looks like:

 <5><117a>: Abbrev Number: 17 (DW_TAG_member)
    <117b>   DW_AT_name        : (indirect string, offset: 0x1959): another_field
...
    <1188>   DW_AT_bit_offset  : 6
    <1189>   DW_AT_data_member_location: 6 byte block: 99 3d 1 0 0 22 	(DW_OP_call4: <0x1193>; DW_OP_plus)
...
 <3><1193>: Abbrev Number: 2 (DW_TAG_dwarf_procedure)
    <1194>   DW_AT_location    : 15 byte block: 97 94 1 37 1a 32 1e 23 7 38 1b 31 1c 23 3 	(DW_OP_push_object_address; DW_OP_deref_size: 1; DW_OP_lit7; DW_OP_and; DW_OP_lit2; DW_OP_mul; DW_OP_plus_uconst: 7; DW_OP_lit8; DW_OP_div; DW_OP_lit1; DW_OP_minus; DW_OP_plus_uconst: 3)

Now, that combination is not fully general, in that the bit offset
must be a constant -- only the byte offset may really vary.  However,
I couldn't come up with a situation where full generality is needed,
mainly because GNAT won't seem to pack fields into the padding of a
variable-length array.

Meanwhile, the reason for the gdb crash is that the code handling
DW_AT_bit_offset assumes that the byte offset is a constant.  This
causes an assertion failure.

This patch arranges for DW_AT_bit_offset to be applied during field
resolution, when needed.

gdb/dwarf2/loc.h

@@ -167,6 +167,9 @@ struct dwarf2_locexpr_baton
      directly.  */
   bool is_reference;
 
+  /* True if this object is actually a dwarf2_field_location_baton.  */
+  bool is_field_location;
+
   /* The objfile that was used when creating this.  */
   dwarf2_per_objfile *per_objfile;
 
@@ -175,6 +178,23 @@ struct dwarf2_locexpr_baton
   dwarf2_per_cu *per_cu;
 };
 
+/* If the DWARF location for a field used DW_AT_bit_size, then an
+   object of this type is created to represent the field location.
+   This is then used to apply the bit offset after computing the
+   field's byte offset.  Objects of this type always set the
+   'is_field_location' member in dwarf2_locexpr_baton.  See also
+   apply_bit_offset_to_field.  */
+
+struct dwarf2_field_location_baton : public dwarf2_locexpr_baton
+{
+  /* The bit offset, coming from DW_AT_bit_offset.  */
+  LONGEST bit_offset;
+
+  /* The DW_AT_byte_size of the field.  If no explicit byte size was
+     specified, this is 0.  */
+  LONGEST explicit_byte_size;
+};
+
 struct dwarf2_loclist_baton
 {
   /* The initial base address for the location list, based on the compilation

gdb/dwarf2/read.c

@@ -9880,6 +9880,25 @@ handle_member_location (struct die_info *die, struct dwarf2_cu *cu,
   attr = dwarf2_attr (die, DW_AT_data_member_location, cu);
   if (attr != NULL)
     {
+      bool has_bit_offset = false;
+      LONGEST bit_offset = 0;
+      LONGEST anonymous_size = 0;
+
+      attribute *attr2 = dwarf2_attr (die, DW_AT_bit_offset, cu);
+      if (attr2 != nullptr && attr2->form_is_constant ())
+	{
+	  has_bit_offset = true;
+	  bit_offset = attr2->unsigned_constant ().value_or (0);
+	  attr2 = dwarf2_attr (die, DW_AT_byte_size, cu);
+	  if (attr2 != nullptr && attr2->form_is_constant ())
+	    {
+	      /* The size of the anonymous object containing
+		 the bit field is explicit, so use the
+		 indicated size (in bytes).  */
+	      anonymous_size = attr2->unsigned_constant ().value_or (0);
+	    }
+	}
+
       if (attr->form_is_constant ())
 	{
 	  LONGEST offset = attr->unsigned_constant ().value_or (0);
@@ -9897,6 +9916,8 @@ handle_member_location (struct die_info *die, struct dwarf2_cu *cu,
 	    }
 
 	  field->set_loc_bitpos (offset * bits_per_byte);
+	  if (has_bit_offset)
+	    apply_bit_offset_to_field (*field, bit_offset, anonymous_size);
 	}
       else if (attr->form_is_block ())
 	{
@@ -9907,9 +9928,20 @@ handle_member_location (struct die_info *die, struct dwarf2_cu *cu,
 	    {
 	      dwarf2_per_objfile *per_objfile = cu->per_objfile;
 	      struct objfile *objfile = per_objfile->objfile;
-	      struct dwarf2_locexpr_baton *dlbaton
-		= OBSTACK_ZALLOC (&objfile->objfile_obstack,
-				  struct dwarf2_locexpr_baton);
+	      struct dwarf2_locexpr_baton *dlbaton;
+	      if (has_bit_offset)
+		{
+		  dwarf2_field_location_baton *flbaton
+		    = OBSTACK_ZALLOC (&objfile->objfile_obstack,
+				      dwarf2_field_location_baton);
+		  flbaton->is_field_location = true;
+		  flbaton->bit_offset = bit_offset;
+		  flbaton->explicit_byte_size = anonymous_size;
+		  dlbaton = flbaton;
+		}
+	      else
+		dlbaton = OBSTACK_ZALLOC (&objfile->objfile_obstack,
+					  struct dwarf2_locexpr_baton);
 	      dlbaton->data = attr->as_block ()->data;
 	      dlbaton->size = attr->as_block ()->size;
 	      /* When using this baton, we want to compute the address
@@ -10003,23 +10035,6 @@ dwarf2_add_field (struct field_info *fip, struct die_info *die,
 
       /* Get bit offset of field.  */
       handle_member_location (die, cu, fp);
-      attr = dwarf2_attr (die, DW_AT_bit_offset, cu);
-      if (attr != nullptr && attr->form_is_constant ())
-	{
-	  LONGEST bit_offset = attr->unsigned_constant ().value_or (0);
-
-	  LONGEST anonymous_size = 0;
-	  attr = dwarf2_attr (die, DW_AT_byte_size, cu);
-	  if (attr != nullptr && attr->form_is_constant ())
-	    {
-	      /* The size of the anonymous object containing
-		 the bit field is explicit, so use the
-		 indicated size (in bytes).  */
-	      anonymous_size = attr->unsigned_constant ().value_or (0);
-	    }
-
-	  apply_bit_offset_to_field (*fp, bit_offset, anonymous_size);
-	}
 
       /* Get name of field.  */
       fieldname = dwarf2_name (die, cu);

gdb/gdbtypes.c

@@ -2725,9 +2725,12 @@ resolve_dynamic_field (struct field &field,
 
   if (field.loc_kind () == FIELD_LOC_KIND_DWARF_BLOCK)
     {
+      dwarf2_locexpr_baton *field_loc
+	= field.loc_dwarf_block ();
+
       struct dwarf2_property_baton baton;
       baton.property_type = lookup_pointer_type (field.type ());
-      baton.locexpr = *field.loc_dwarf_block ();
+      baton.locexpr = *field_loc;
 
       struct dynamic_prop prop;
       prop.set_locexpr (&baton);
@@ -2735,7 +2738,17 @@ resolve_dynamic_field (struct field &field,
       CORE_ADDR vals[1] = {addr_stack->addr};
       CORE_ADDR addr;
       if (dwarf2_evaluate_property (&prop, frame, addr_stack, &addr, vals))
-	field.set_loc_bitpos (TARGET_CHAR_BIT * (addr - addr_stack->addr));
+	{
+	  field.set_loc_bitpos (TARGET_CHAR_BIT * (addr - addr_stack->addr));
+
+	  if (field_loc->is_field_location)
+	    {
+	      dwarf2_field_location_baton *fl_baton
+		= static_cast<dwarf2_field_location_baton *> (field_loc);
+	      apply_bit_offset_to_field (field, fl_baton->bit_offset,
+					 fl_baton->explicit_byte_size);
+	    }
+	}
     }
 
   /* As we know this field is not a static field, the field's

gdb/testsuite/gdb.ada/dyn-bit-offset.exp

@@ -0,0 +1,46 @@
+# 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"
+
+gdb_test_multiple "print spr" "" {
+    -re -wrap " = \\(discr => 3, array_field => \\(-5, -6, -7\\), field => -4, another_field => -6\\)" {
+	pass $gdb_test_name
+    }
+    -re -wrap " = \\(discr => 3, array_field => \\(-5, -6, -7\\), field => -4, another_field => -4\\)" {
+	# A known GCC bug.
+	xfail $gdb_test_name
+    }
+}
+
+gdb_test "print spr.field" " = -4"

gdb/testsuite/gdb.ada/dyn-bit-offset/exam.adb

@@ -0,0 +1,45 @@
+--  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 Packed_Array is array (Integer range <>) of Small;
+   pragma pack (Packed_Array);
+
+   subtype Range_Int is Natural range 0 .. 7;
+
+   type Some_Packed_Record (Discr : Range_Int := 3) is record
+      Array_Field : Packed_Array (1 .. Discr);
+      Field: Small;
+      case Discr is
+         when 3 =>
+            Another_Field : Small;
+         when others =>
+            null;
+      end case;
+   end record;
+   pragma Pack (Some_Packed_Record);
+   pragma No_Component_Reordering (Some_Packed_Record);
+
+   SPR : Some_Packed_Record := (Discr => 3,
+                                Field => -4,
+                                Another_Field => -6,
+                                Array_Field => (-5, -6, -7));
+
+begin
+   null;                        --  STOP
+end Exam;