diff options
| -rw-r--r-- | gdb/ChangeLog | 8 | ||||
| -rw-r--r-- | gdb/ada-lang.c | 14 | ||||
| -rw-r--r-- | gdb/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/same_component_name.exp | 10 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/same_component_name/foo.adb | 11 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/same_component_name/pck.adb | 15 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/same_component_name/pck.ads | 25 |
7 files changed, 81 insertions, 7 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 0c94ad4..392d77a 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,11 @@ +2018-09-10 Jerome Guitton <guitton@adacore.com> + + * ada-lang.c (ada_value_struct_elt): Call ada_to_fixed_type + with check_tag to 1 if and only if the type is tagged and the + component being searched cannot been found in the current + view. Otherwise, always call ada_to_fixed_type with + check_tag to 0. + 2018-09-10 Xavier Roirand <roirand@adacore.com> * ada-lang.c (ada_is_access_to_unconstrained_array): Remove static diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index d151dde..1462271 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -7554,6 +7554,7 @@ ada_value_struct_elt (struct value *arg, const char *name, int no_err) { struct type *t, *t1; struct value *v; + int check_tag; v = NULL; t1 = t = ada_check_typedef (value_type (arg)); @@ -7617,12 +7618,17 @@ ada_value_struct_elt (struct value *arg, const char *name, int no_err) if (!find_struct_field (name, t1, 0, &field_type, &byte_offset, &bit_offset, &bit_size, NULL)) - t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, - address, NULL, 1); + check_tag = 1; + else + check_tag = 0; } else - t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, - address, NULL, 1); + check_tag = 0; + + /* Convert to fixed type in all cases, so that we have proper + offsets to each field in unconstrained record types. */ + t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, + address, NULL, check_tag); if (find_struct_field (name, t1, 0, &field_type, &byte_offset, &bit_offset, diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index bad86cf..fc18b22 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-09-10 Jerome Guitton <guitton@adacore.com> + + * gdb.ada/same_component_name: Add test for case of tagged record + with variable-length fields. + 2018-09-10 Xavier Roirand <roirand@adacore.com> * gdb.ada/access_to_unbounded_array.exp: New testcase. diff --git a/gdb/testsuite/gdb.ada/same_component_name.exp b/gdb/testsuite/gdb.ada/same_component_name.exp index 9069c2d..34e29c1 100644 --- a/gdb/testsuite/gdb.ada/same_component_name.exp +++ b/gdb/testsuite/gdb.ada/same_component_name.exp @@ -26,10 +26,12 @@ 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 @@ -58,3 +60,11 @@ gdb_test "continue" \ 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" + diff --git a/gdb/testsuite/gdb.ada/same_component_name/foo.adb b/gdb/testsuite/gdb.ada/same_component_name/foo.adb index 84fe9f5..c7debe1 100644 --- a/gdb/testsuite/gdb.ada/same_component_name/foo.adb +++ b/gdb/testsuite/gdb.ada/same_component_name/foo.adb @@ -17,15 +17,20 @@ with Pck; use Pck; use Pck.Middle; use Pck.Top; +use Pck.Dyn_Middle; +use Pck.Dyn_Top; procedure Foo is - B : Bottom_T; - M : Middle_T; - + B : Bottom_T; + M : Middle_T; + DM : Dyn_Middle_T (24); begin Assign (Top_T (B), 12); Assign (B, 10.0); Assign (M, 'V'); Assign (B, 5.0); + + Assign (Dyn_Top_T (DM), 12); + Assign (DM, 'V'); end Foo; diff --git a/gdb/testsuite/gdb.ada/same_component_name/pck.adb b/gdb/testsuite/gdb.ada/same_component_name/pck.adb index fd638f7..a0d28b3 100644 --- a/gdb/testsuite/gdb.ada/same_component_name/pck.adb +++ b/gdb/testsuite/gdb.ada/same_component_name/pck.adb @@ -39,4 +39,19 @@ package body Pck is begin null; end Do_Nothing; + + package body Dyn_Top is + procedure Assign (Obj: in out Dyn_Top_T; TV : Integer) is + begin + Do_Nothing (Obj'Address); -- BREAK_DYN_TOP + end Assign; + end Dyn_Top; + + package body Dyn_Middle is + procedure Assign (Obj: in out Dyn_Middle_T; MV : Character) is + begin + Do_Nothing (Obj'Address); -- BREAK_DYN_MIDDLE + end Assign; + end Dyn_Middle; + end Pck; diff --git a/gdb/testsuite/gdb.ada/same_component_name/pck.ads b/gdb/testsuite/gdb.ada/same_component_name/pck.ads index 961aee7..db1554d 100644 --- a/gdb/testsuite/gdb.ada/same_component_name/pck.ads +++ b/gdb/testsuite/gdb.ada/same_component_name/pck.ads @@ -48,4 +48,29 @@ package Pck is procedure Do_Nothing (A : System.Address); + type Integer_Array is array (Natural range <>) of Integer; + + package Dyn_Top is + type Dyn_Top_T (Disc : Natural) is tagged private; + type Dyn_Top_A is access Dyn_Top_T'Class; + procedure Assign (Obj: in out Dyn_Top_T; TV : Integer); + private + type Dyn_Top_T (Disc : Natural) is tagged record + S : Integer_Array (1 .. Disc) := (others => Disc); + N : Integer := 1; + A : Integer := 48; + end record; + end Dyn_Top; + + package Dyn_Middle is + type Dyn_Middle_T is new Dyn_Top.Dyn_Top_T with private; + type Dyn_Middle_A is access Dyn_Middle_T'Class; + procedure Assign (Obj: in out Dyn_Middle_T; MV : Character); + private + type Dyn_Middle_T is new Dyn_Top.Dyn_Top_T with record + N : Character := 'a'; + U : Integer := 42; + end record; + end Dyn_Middle; + end Pck; |