Fix bug in dynamic type resolution
authorTom Tromey <tromey@adacore.com>
Fri, 24 Sep 2021 20:06:52 +0000 (14:06 -0600)
committerTom Tromey <tromey@adacore.com>
Tue, 19 Oct 2021 19:03:58 +0000 (13:03 -0600)
A customer-reported problem led us to a bug in dynamic type
resolution.  resolve_dynamic_struct will recursively call
resolve_dynamic_type_internal, passing it the sub-object for the
particular field being resolved.  While it offsets the address here,
it does not also offset the "valaddr" -- the array of bytes describing
the memory.

This patch fixes the bug, by offsetting both.  A test case is included
that can be used to reproduce the bug.

gdb/gdbtypes.c
gdb/testsuite/gdb.ada/array_of_variant.exp
gdb/testsuite/gdb.ada/array_of_variant/p.adb

index de73a2b5608d86187e65ace2202b9b69bfd7ff69..3110395b7cb25bb5e85a936897046387aede20d3 100644 (file)
@@ -2615,10 +2615,11 @@ resolve_dynamic_struct (struct type *type,
                 " (invalid location kind)"));
 
       pinfo.type = check_typedef (resolved_type->field (i).type ());
+      size_t offset = TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT;
       pinfo.valaddr = addr_stack->valaddr;
-      pinfo.addr
-       = (addr_stack->addr
-          + (TYPE_FIELD_BITPOS (resolved_type, i) / TARGET_CHAR_BIT));
+      if (!pinfo.valaddr.empty ())
+       pinfo.valaddr = pinfo.valaddr.slice (offset);
+      pinfo.addr = addr_stack->addr + offset;
       pinfo.next = addr_stack;
 
       resolved_type->field (i).set_type
index 6372e2cf35492e6960dea263bae7b481af072d35..f8f4d9c130b8b9507fc27c79b878c3dd64a49a1a 100644 (file)
@@ -97,4 +97,15 @@ foreach_with_prefix scenario {all minimal} {
            [string_to_regexp "$v2"] \
            "python print second array element"
     }
+
+    set av1 "(initial => 0, rest => (tag => unused, cval => 88 'X'))"
+    set av2 "(initial => 0, rest => (tag => object, ival => 88))"
+    set full "($av1, $av2)"
+
+    gdb_test "print another_array(1)" " = [string_to_regexp $av1]" \
+       "print first element of another_array"
+    gdb_test "print another_array(2)" " = [string_to_regexp $av2]" \
+       "print second element of another_array"
+    gdb_test "print another_array" " = [string_to_regexp $full]" \
+       "print another_array"
 }
index c475eb403f5d2c0fd6b0c8fd596bf682ba433b19..bf087af81b5003c7abc68c65bbf0e518a2d52b12 100644 (file)
@@ -33,7 +33,27 @@ procedure P is
 
    Objects : array (1 .. 2) of Payload_T;
 
+   type Another_Type (Tag : Tag_T := Unused) is
+      record
+         case Tag is
+           when Unused =>
+              CVal : Character;
+            when Object =>
+              IVal : Integer;
+        end case;
+      end record;
+
+   type Enclosing is record
+      Initial : Integer;
+      Rest : Another_Type;
+   end record;
+
+   Another_Array : array (1 .. 2) of Enclosing
+      := ((Initial => 0, Rest => (Tag => Unused, CVal => 'X')),
+          (Initial => 0, Rest => (Tag => Object, IVal => 88)));
+
 begin
    Objects (1) := (Tag => Object, Values => (others => 2));
    Do_Nothing (Objects'Address);  --  START
+   Do_Nothing (Another_Array'Address);
 end P;