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.
This commit is contained in:
Tom Tromey
parent
ced10cb78d
commit
4d1795ac4d
3 changed files with 89 additions and 57 deletions
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
||||
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 "foo.adb:$bp_foo"
|
||||
|
||||
gdb_run_cmd
|
||||
|
||||
gdb_test "" \
|
||||
".*Breakpoint $decimal, pck.top.assign \\(.*\\).*" \
|
||||
"run to top assign breakpoint"
|
||||
|
||||
gdb_test "print obj.n" " = 1" "Print top component field"
|
||||
|
||||
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 "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 "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 "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 "continue" \
|
||||
".*Breakpoint $decimal, foo \\(.*\\).*" \
|
||||
"continue to foo breakpoint"
|
||||
|
||||
gdb_test "print dma.a" " = 48" \
|
||||
"print field in dynamic tagged type via access"
|
||||
}
|
||||
|
||||
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]
|
||||
|
||||
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_run_cmd
|
||||
|
||||
gdb_test "" \
|
||||
".*Breakpoint $decimal, pck.top.assign \\(.*\\).*" \
|
||||
"run to top assign breakpoint"
|
||||
|
||||
gdb_test "print obj.n" " = 1" "Print top component field"
|
||||
|
||||
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 "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 "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 "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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue