Fix latent Ada bug when accessing field offsets

The "add accessors for field (and call site) location" patch caused a
gdb crash when running the internal AdaCore testsuite.  This turned
out to be a latent bug in ada-lang.c.

The immediate cause of the bug is that find_struct_field
unconditionally uses TYPE_FIELD_BITPOS.  This causes an assert for a
dynamic type.

This patch fixes the problem by doing two things.  First, it changes
find_struct_field to use a dummy value for the field offset in the
situation where the offset is not actually needed by the caller.  This
works because the offset isn't used in any other way -- only as a
result.

Second, this patch assures that calls to find_struct_field use a
resolved type when the offset is needed.  For
value_tag_from_contents_and_address, this is done by resolving the
type explicitly.  In ada_value_struct_elt, this is done by passing
nullptr for the out parameters when they are not needed (the second
call in this function already uses a resolved type).

Note that, while we believe the parent field probably can't occur at a
variable offset, the patch still updates this code path, just in case.

I've updated an existing test case to reproduce the crash.
I'm checking this in.

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 935358d02459b31d01af8422f2ab0084de56471a..8b9e94e25d847d42e7b40fb250577d57ede11b29 100644 (file)
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -4095,8 +4095,8 @@ ada_value_struct_elt (struct value *arg, const char *name, int no_err)
             If not found then let's look in the fixed type.  */
 
          if (!find_struct_field (name, t1, 0,
-                                 &field_type, &byte_offset, &bit_offset,
-                                 &bit_size, NULL))
+                                 nullptr, nullptr, nullptr,
+                                 nullptr, nullptr))
            check_tag = 1;
          else
            check_tag = 0;
@@ -6041,7 +6041,11 @@ value_tag_from_contents_and_address (struct type *type,
   int tag_byte_offset;
   struct type *tag_type;
 
-  if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
+  gdb::array_view<const gdb_byte> contents;
+  if (valaddr != nullptr)
+    contents = gdb::make_array_view (valaddr, TYPE_LENGTH (type));
+  struct type *resolved_type = resolve_dynamic_type (type, contents, address);
+  if (find_struct_field ("_tag", resolved_type, 0, &tag_type, &tag_byte_offset,
                         NULL, NULL, NULL))
     {
       const gdb_byte *valaddr1 = ((valaddr == NULL)
@@ -6644,8 +6648,16 @@ find_struct_field (const char *name, struct type *type, int offset,
 
   for (i = 0; i < type->num_fields (); i += 1)
     {
-      int bit_pos = TYPE_FIELD_BITPOS (type, i);
-      int fld_offset = offset + bit_pos / 8;
+      /* These can't be computed using TYPE_FIELD_BITPOS for a dynamic
+        type.  However, we only need the values to be correct when
+        the caller asks for them.  */
+      int bit_pos = 0, fld_offset = 0;
+      if (byte_offset_p != nullptr || bit_offset_p != nullptr)
+       {
+         bit_pos = TYPE_FIELD_BITPOS (type, i);
+         fld_offset = offset + bit_pos / 8;
+       }
+
       const char *t_field_name = type->field (i).name ();
 
       if (t_field_name == NULL)
@@ -6713,8 +6725,13 @@ find_struct_field (const char *name, struct type *type, int offset,
 
   if (parent_offset != -1)
     {
-      int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
-      int fld_offset = offset + bit_pos / 8;
+      /* As above, only compute the offset when truly needed.  */
+      int fld_offset = offset;
+      if (byte_offset_p != nullptr || bit_offset_p != nullptr)
+       {
+         int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
+         fld_offset += bit_pos / 8;
+       }
 
       if (find_struct_field (name, type->field (parent_offset).type (),
                             fld_offset, field_type_p, byte_offset_p,

diff --git a/gdb/testsuite/gdb.ada/same_component_name.exp b/gdb/testsuite/gdb.ada/same_component_name.exp
index 7a0f27874941b9478d5d8c9502c47c41c8ee0471..f4e1801802b2b23e4248c9817876a05ccb9e85ad 100644 (file)
--- a/gdb/testsuite/gdb.ada/same_component_name.exp
+++ b/gdb/testsuite/gdb.ada/same_component_name.exp
@@ -19,54 +19,66 @@ if { [skip_ada_tests] } { return -1 }
 
 standard_ada_testfile foo
 
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } {
-  return -1
-}
+foreach_with_prefix scenario {all minimal} {
+    set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+    if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != "" } {
+       return -1
+    }
 
-clean_restart ${testfile}
+    clean_restart ${testfile}
 
-set bp_top_location [gdb_get_line_number "BREAK_TOP" ${testdir}/pck.adb]
-set bp_middle_location [gdb_get_line_number "BREAK_MIDDLE" ${testdir}/pck.adb]
-set bp_bottom_location [gdb_get_line_number "BREAK_BOTTOM" ${testdir}/pck.adb]
-set bp_dyn_middle_location [gdb_get_line_number "BREAK_DYN_MIDDLE" ${testdir}/pck.adb]
+    set bp_top_location [gdb_get_line_number "BREAK_TOP" ${testdir}/pck.adb]
+    set bp_middle_location [gdb_get_line_number "BREAK_MIDDLE" ${testdir}/pck.adb]
+    set bp_bottom_location [gdb_get_line_number "BREAK_BOTTOM" ${testdir}/pck.adb]
+    set bp_dyn_middle_location [gdb_get_line_number "BREAK_DYN_MIDDLE" ${testdir}/pck.adb]
+    set bp_foo [gdb_get_line_number "STOP" ${testdir}/foo.adb]
 
-gdb_breakpoint "pck.adb:$bp_top_location"
-gdb_breakpoint "pck.adb:$bp_middle_location"
-gdb_breakpoint "pck.adb:$bp_bottom_location"
-gdb_breakpoint "pck.adb:$bp_dyn_middle_location"
+    gdb_breakpoint "pck.adb:$bp_top_location"
+    gdb_breakpoint "pck.adb:$bp_middle_location"
+    gdb_breakpoint "pck.adb:$bp_bottom_location"
+    gdb_breakpoint "pck.adb:$bp_dyn_middle_location"
+    gdb_breakpoint "foo.adb:$bp_foo"
 
-gdb_run_cmd
+    gdb_run_cmd
 
-gdb_test "" \
-         ".*Breakpoint $decimal, pck.top.assign \\(.*\\).*" \
-         "run to top assign breakpoint"
+    gdb_test "" \
+       ".*Breakpoint $decimal, pck.top.assign \\(.*\\).*" \
+       "run to top assign breakpoint"
 
-gdb_test "print obj.n" " = 1" "Print top component field"
+    gdb_test "print obj.n" " = 1" "Print top component field"
 
-gdb_test "continue" \
-         ".*Breakpoint $decimal, pck.assign \\(.*\\).*" \
-         "continue to bottom assign breakpoint"
+    gdb_test "continue" \
+       ".*Breakpoint $decimal, pck.assign \\(.*\\).*" \
+       "continue to bottom assign breakpoint"
 
-gdb_test "print obj.n" " = 4\\.0" "Print bottom component field"
+    gdb_test "print obj.n" " = 4\\.0" "Print bottom component field"
 
-gdb_test "continue" \
-         ".*Breakpoint $decimal, pck.middle.assign \\(.*\\).*" \
-         "continue to middle assign breakpoint"
+    gdb_test "continue" \
+       ".*Breakpoint $decimal, pck.middle.assign \\(.*\\).*" \
+       "continue to middle assign breakpoint"
 
-gdb_test "print obj.a" " = 48" \
-         "Print top component field in middle assign function"
+    gdb_test "print obj.a" " = 48" \
+       "Print top component field in middle assign function"
 
-gdb_test "continue" \
-         ".*Breakpoint $decimal, pck.assign \\(.*\\).*" \
-         "continue to bottom assign breakpoint, 2nd time"
+    gdb_test "continue" \
+       ".*Breakpoint $decimal, pck.assign \\(.*\\).*" \
+       "continue to bottom assign breakpoint, 2nd time"
 
-gdb_test "print obj.x" " = 6" \
-         "Print field existing only in bottom component"
+    gdb_test "print obj.x" " = 6" \
+       "Print field existing only in bottom component"
 
-gdb_test "continue" \
-         ".*Breakpoint $decimal, pck.dyn_middle.assign \\(.*\\).*" \
-         "continue to dyn_middle assign breakpoint"
+    gdb_test "continue" \
+       ".*Breakpoint $decimal, pck.dyn_middle.assign \\(.*\\).*" \
+       "continue to dyn_middle assign breakpoint"
 
-gdb_test "print obj.u" " = 42" \
-         "Print field existing only in dyn_middle component"
+    gdb_test "print obj.u" " = 42" \
+       "Print field existing only in dyn_middle component"
 
+    gdb_test "continue" \
+       ".*Breakpoint $decimal, foo \\(.*\\).*" \
+       "continue to foo breakpoint"
+
+    gdb_test "print dma.a" " = 48" \
+       "print field in dynamic tagged type via access"
+}

diff --git a/gdb/testsuite/gdb.ada/same_component_name/foo.adb b/gdb/testsuite/gdb.ada/same_component_name/foo.adb
index 6461eb27f5b651946bdaa14af9a575bb31db07e5..5fd4d5d01f1e711c817b8db7eb1c338fec5c2305 100644 (file)
--- a/gdb/testsuite/gdb.ada/same_component_name/foo.adb
+++ b/gdb/testsuite/gdb.ada/same_component_name/foo.adb
@@ -24,6 +24,7 @@ procedure Foo is
    B  : Bottom_T;
    M  : Middle_T;
    DM : Dyn_Middle_T (24);
+   DMA : Dyn_Middle_A := new Dyn_Middle_T (24);
 begin
    Assign (Top_T (B), 12);
    Assign (B, 10.0);
@@ -33,4 +34,6 @@ begin
 
    Assign (Dyn_Top_T (DM), 12);
    Assign (DM, 'V');
+
+   Do_Nothing(DMA'Address); -- STOP
 end Foo;