Resolve dynamic type in ada_value_struct_elt
An internal AdaCore test case showed that gdb mishandled a case of assigning to an array element in a packed array inside a variant record. This problem can only be seen with -fgnat-encodings=minimal, which isn't yet widely used. This patch fixes the bug, and also updates an existing test to check this case. gdb/ChangeLog 2020-11-04 Tom Tromey <tromey@adacore.com> * ada-lang.c (ada_value_struct_elt): Resolve dynamic type. gdb/testsuite/ChangeLog 2020-11-04 Tom Tromey <tromey@adacore.com> * gdb.ada/set_pckd_arr_elt.exp: Also test -fgnat-encodings=minimal. Add tests. * gdb.ada/set_pckd_arr_elt/foo.adb (Foo): Add VA variable. Call Update_Small a second time. * gdb.ada/set_pckd_arr_elt/pck.adb (New_Variant): New function. * gdb.ada/set_pckd_arr_elt/pck.ads (Buffer, Variant) (Variant_Access): New types. (New_Variant): Declare.
This commit is contained in:
parent
c9a28cbed6
commit
24aa1b0282
7 changed files with 64 additions and 13 deletions
|
@ -1,3 +1,7 @@
|
|||
2020-11-04 Tom Tromey <tromey@adacore.com>
|
||||
|
||||
* ada-lang.c (ada_value_struct_elt): Resolve dynamic type.
|
||||
|
||||
2020-11-04 Tom Tromey <tromey@adacore.com>
|
||||
|
||||
* ada-lang.c (ada_is_any_packed_array_type): New function.
|
||||
|
|
|
@ -4396,6 +4396,10 @@ ada_value_struct_elt (struct value *arg, const char *name, int no_err)
|
|||
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
|
||||
address, NULL, check_tag);
|
||||
|
||||
/* Resolve the dynamic type as well. */
|
||||
arg = value_from_contents_and_address (t1, nullptr, address);
|
||||
t1 = value_type (arg);
|
||||
|
||||
if (find_struct_field (name, t1, 0,
|
||||
&field_type, &byte_offset, &bit_offset,
|
||||
&bit_size, NULL))
|
||||
|
|
|
@ -1,3 +1,14 @@
|
|||
2020-11-04 Tom Tromey <tromey@adacore.com>
|
||||
|
||||
* gdb.ada/set_pckd_arr_elt.exp: Also test
|
||||
-fgnat-encodings=minimal. Add tests.
|
||||
* gdb.ada/set_pckd_arr_elt/foo.adb (Foo): Add VA variable.
|
||||
Call Update_Small a second time.
|
||||
* gdb.ada/set_pckd_arr_elt/pck.adb (New_Variant): New function.
|
||||
* gdb.ada/set_pckd_arr_elt/pck.ads (Buffer, Variant)
|
||||
(Variant_Access): New types.
|
||||
(New_Variant): Declare.
|
||||
|
||||
2020-11-04 Tom Tromey <tromey@adacore.com>
|
||||
|
||||
* gdb.ada/mod_from_name.exp: Test printing slice.
|
||||
|
|
|
@ -19,25 +19,34 @@ if { [skip_ada_tests] } { return -1 }
|
|||
|
||||
standard_ada_testfile foo
|
||||
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
|
||||
return -1
|
||||
}
|
||||
foreach_with_prefix scenario {all minimal} {
|
||||
set flags [list debug additional_flags=-fgnat-encodings=$scenario]
|
||||
|
||||
clean_restart ${testfile}
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
|
||||
return -1
|
||||
}
|
||||
|
||||
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
|
||||
runto "foo.adb:$bp_location"
|
||||
clean_restart ${testfile}
|
||||
|
||||
gdb_test "print sa(3) := 9" " = 9"
|
||||
set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
|
||||
runto "foo.adb:$bp_location"
|
||||
|
||||
# To verify that the assignment was made correctly, we use the fact
|
||||
# that the program passes this very same element as an argument to
|
||||
# one of the functions. So we insert a breakpoint on that function,
|
||||
# and verify that the argument value is correct.
|
||||
gdb_test "print sa(3) := 9" " = 9"
|
||||
gdb_test "print va.t(1) := 15" " = 15"
|
||||
|
||||
gdb_breakpoint "update_small"
|
||||
# To verify that the assignment was made correctly, we use the fact
|
||||
# that the program passes this very same element as an argument to
|
||||
# one of the functions. So we insert a breakpoint on that function,
|
||||
# and verify that the argument value is correct.
|
||||
|
||||
gdb_test "continue" \
|
||||
gdb_breakpoint "update_small"
|
||||
|
||||
gdb_test "continue" \
|
||||
"Breakpoint .*, pck\\.update_small \\(s=9\\) at .*pck.adb:.*" \
|
||||
"continue to update_small"
|
||||
|
||||
# And again for the second call.
|
||||
gdb_test "continue" \
|
||||
"Breakpoint .*, pck\\.update_small \\(s=15\\) at .*pck.adb:.*" \
|
||||
"continue to update_small for va.t"
|
||||
}
|
||||
|
|
|
@ -17,6 +17,8 @@ with Pck; use Pck;
|
|||
|
||||
procedure Foo is
|
||||
SA : Simple_Array := (1, 2, 3, 4);
|
||||
VA : Variant_Access := New_Variant (Size => 3);
|
||||
begin
|
||||
Update_Small (SA (3)); -- STOP
|
||||
Update_Small (VA.T (1));
|
||||
end Foo;
|
||||
|
|
|
@ -14,6 +14,13 @@
|
|||
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
package body Pck is
|
||||
function New_Variant (Size : Integer) return Variant_Access is
|
||||
Result : Variant (Size => Size) :=
|
||||
(Size => Size, A => 11, T => (others => 13));
|
||||
begin
|
||||
return new Variant'(Result);
|
||||
end New_Variant;
|
||||
|
||||
procedure Update_Small (S : in out Small) is
|
||||
begin
|
||||
null;
|
||||
|
|
|
@ -18,5 +18,19 @@ package Pck is
|
|||
type Simple_Array is array (1 .. 4) of Small;
|
||||
pragma Pack (Simple_Array);
|
||||
|
||||
type Buffer is array (Integer range <>) of Small;
|
||||
pragma Pack (Buffer);
|
||||
|
||||
type Variant (Size : Integer := 1) is
|
||||
record
|
||||
A : Small;
|
||||
T : Buffer (1 .. Size);
|
||||
end record;
|
||||
pragma Pack (Variant);
|
||||
|
||||
type Variant_Access is access all Variant;
|
||||
|
||||
function New_Variant (Size : Integer) return Variant_Access;
|
||||
|
||||
procedure Update_Small (S : in out Small);
|
||||
end Pck;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue