* [PATCH 0/9] Fix most -fgnat-encodings=minimal failures
@ 2020-09-30 20:05 Tom Tromey
2020-09-30 20:05 ` [PATCH 1/9] Avoid crash in ada-lang.c:to_fixed_array_type Tom Tromey
` (9 more replies)
0 siblings, 10 replies; 20+ messages in thread
From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw)
To: gdb-patches
GNAT has two debuginfo modes -- the default, which is to emit "GNAT
encodings", and -fgnat-encodings=minimal, which emits something closer
to pure DWARF.
Historically gdb has only handled GNAT encodings. This patch series
brings gdb most of the way to handling -fgnat-encodings=minimal. The
remaining issues are going to require some patches to GNAT and gdb; my
plan is to only land the gdb changes once the GNAT changes have gone
in.
Patches #2 - #9 were all reviewed internally by Joel. However, they
aren't all purely Ada-specific. (Patch #1 is new, written while I was
prepping this series -- see the comments there.)
For gdb itself, the benefit of these changes is that with
minimal-encodings, the Ada type system works more like the rest of
gdb. For users the main benefit is that the Python API works more
nicely.
Let me know what you think,
Tom
^ permalink raw reply [flat|nested] 20+ messages in thread* [PATCH 1/9] Avoid crash in ada-lang.c:to_fixed_array_type 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 2/9] Fix decoding of multi-dimensional constrained packed arrays Tom Tromey ` (8 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey When debugging Ada programs compiled by certain versions of GNAT with -fgnat-encodings=minimal, gdb can crash. These crashes occur when running the gdb test suite, once some of the later patches in this series have been applied. This patch works around the bug by throwing an exception in the failing case. I did not implement a full fix because GNAT has been changed to emit better DWARF, and so in the near future this will stop being a problem. (Currently, users don't generally use -fgnat-encodings=minimal, and the GNAT default will only be changed in a fully-patched compiler.) gdb/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * ada-lang.c (to_fixed_array_type): Error if decode_constrained_packed_array_type returns NULL. --- gdb/ChangeLog | 5 +++++ gdb/ada-lang.c | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 0df406bff48..b4b7e838114 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -8368,7 +8368,11 @@ to_fixed_array_type (struct type *type0, struct value *dval, constrained_packed_array_p = ada_is_constrained_packed_array_type (type0); if (constrained_packed_array_p) - type0 = decode_constrained_packed_array_type (type0); + { + type0 = decode_constrained_packed_array_type (type0); + if (type0 == nullptr) + error (_("could not decode constrained packed array type")); + } index_type_desc = ada_find_parallel_type (type0, xa_suffix); -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 2/9] Fix decoding of multi-dimensional constrained packed arrays 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 2020-09-30 20:05 ` [PATCH 1/9] Avoid crash in ada-lang.c:to_fixed_array_type Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal Tom Tromey ` (7 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey Printing a multi-dimensional constrained packed array in Ada would not show the correct values. The bug here is that, when decoding the type of such an array, only the innermost dimension's element bitsize would be correct. For outer dimensions, the bitsize must account for the size of each sub-array, but this was not done. This patch fixes the problem by arranging to compute these sizes after decoding the array type. I've included a bit more test case than is strictly necessary -- the current test here was derived from an internal test, and this patch brings the two into sync. 2020-09-30 Tom Tromey <tromey@adacore.com> * ada-lang.c (recursively_update_array_bitsize): New function. (decode_constrained_packed_array_type): Call it. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/enum_idx_packed.exp: Add tests. * gdb.ada/enum_idx_packed/foo.adb: Add variables. * gdb.ada/enum_idx_packed/pck.adb: Add functions. * gdb.ada/enum_idx_packed/pck.ads: Add types, function declarations. --- gdb/ChangeLog | 5 ++ gdb/ada-lang.c | 41 ++++++++++++++++ gdb/testsuite/ChangeLog | 8 ++++ gdb/testsuite/gdb.ada/enum_idx_packed.exp | 48 +++++++++++++++++++ gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb | 12 ++++- gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb | 40 ++++++++++++++++ gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads | 24 ++++++++++ 7 files changed, 176 insertions(+), 2 deletions(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index b4b7e838114..624e4ad702b 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -2157,6 +2157,35 @@ decode_constrained_packed_array_type (struct type *type) return constrained_packed_array_type (shadow_type, &bits); } +/* Helper function for decode_constrained_packed_array. Set the field + bitsize on a series of packed arrays. Returns the number of + elements in TYPE. */ + +static LONGEST +recursively_update_array_bitsize (struct type *type) +{ + gdb_assert (type->code () == TYPE_CODE_ARRAY); + + LONGEST low, high; + if (get_discrete_bounds (type->index_type (), &low, &high) < 0 + || low > high) + return 0; + LONGEST our_len = high - low + 1; + + struct type *elt_type = TYPE_TARGET_TYPE (type); + if (elt_type->code () == TYPE_CODE_ARRAY) + { + LONGEST elt_len = recursively_update_array_bitsize (elt_type); + LONGEST elt_bitsize = elt_len * TYPE_FIELD_BITSIZE (elt_type, 0); + TYPE_FIELD_BITSIZE (type, 0) = elt_bitsize; + + TYPE_LENGTH (type) = ((our_len * elt_bitsize + HOST_CHAR_BIT - 1) + / HOST_CHAR_BIT); + } + + return our_len; +} + /* Given that ARR is a struct value *indicating a GNAT constrained packed array, returns a simple array that denotes that array. Its type is a standard GDB array type except that the BITSIZEs of the array @@ -2186,6 +2215,18 @@ decode_constrained_packed_array (struct value *arr) return NULL; } + /* Decoding the packed array type could not correctly set the field + bitsizes for any dimension except the innermost, because the + bounds may be variable and were not passed to that function. So, + we further resolve the array bounds here and then update the + sizes. */ + const gdb_byte *valaddr = value_contents_for_printing (arr); + CORE_ADDR address = value_address (arr); + gdb::array_view<const gdb_byte> view + = gdb::make_array_view (valaddr, TYPE_LENGTH (type)); + type = resolve_dynamic_type (type, view, address); + recursively_update_array_bitsize (type); + if (type_byte_order (value_type (arr)) == BFD_ENDIAN_BIG && ada_is_modular_type (value_type (arr))) { diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed.exp b/gdb/testsuite/gdb.ada/enum_idx_packed.exp index bfa091ec9a6..480de71b7c4 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed.exp +++ b/gdb/testsuite/gdb.ada/enum_idx_packed.exp @@ -28,7 +28,55 @@ clean_restart ${testfile} set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] runto "foo.adb:$bp_location" +gdb_test "ptype full" \ + "type = array \\(black \\.\\. white\\) of boolean <packed: 1-bit elements>" + gdb_test "print full" " = \\(false, true, false, true, false\\)" gdb_test "print full'first" " = black" +gdb_test "ptype primary" \ + "type = array \\(red \\.\\. blue\\) of boolean <packed: 1-bit elements>" + +gdb_test "print primary" " = \\(red => false, true, false\\)" + +gdb_test "print primary'first" " = red" + +gdb_test "ptype cold" \ + "type = array \\(green \\.\\. blue\\) of boolean <packed: 1-bit elements>" + +gdb_test "print cold" " = \\(green => false, true\\)" + +gdb_test "print cold'first" " = green" + +# Note the bounds values are still not correctly displayed. So we get +# the enum equivalent of "1 .. 0" (empty range) as the array ranges. +# Accept that for now. +gdb_test "ptype small" \ + "array \\(red \\.\\. green\\) of boolean <packed: 1-bit elements>" + +gdb_test "print small" " = \\(red => false, true\\)" + +gdb_test "print small'first" " = red" + +gdb_test "ptype multi" \ + "array \\(red \\.\\. green, low .. medium\\) of boolean <packed: 1-bit elements>" + +gdb_test "print multi" \ + " = \\(red => \\(low => true, false\\), \\(low => true, false\\)\\)" + +gdb_test "print multi'first" " = red" + +set base "\\(true, false, true, false, true, false, true, false, true, false\\)" +set matrix "\\(" +foreach x {1 2 3 4 5 6 7} { + if {$x > 1} { + append matrix ", " + } + append matrix $base +} +append matrix "\\)" + +gdb_test "print multi_multi" " = \\($matrix, $matrix\\)" +gdb_test "print multi_multi(1,3)" " = $base" +gdb_test "print multi_multi(2)" " = $matrix" diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb index 6f142a18b00..e9f30747167 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb @@ -17,8 +17,16 @@ with Pck; use Pck; procedure Foo is Full : Full_Table := (False, True, False, True, False); + Primary : Primary_Table := (False, True, False); + Cold : Cold_Table := (False, True); + Small : Small_Table := New_Small_Table (Low => Red, High => Green); + Multi : Multi_Table := New_Multi_Table (Red, Green, Low, Medium); + Multi_Multi : Multi_Multi_Table := New_Multi_Multi_Table (1, 2, 1, 7, 1, 10); begin Do_Nothing (Full'Address); -- STOP + Do_Nothing (Primary'Address); + Do_Nothing (Cold'Address); + Do_Nothing (Small'Address); + Do_Nothing (Multi'Address); + Do_Nothing (Multi_Multi'Address); end Foo; - - diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb index 5b18de9952b..a4e04747526 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.adb @@ -14,6 +14,46 @@ -- along with this program. If not, see <http://www.gnu.org/licenses/>. package body Pck is + + function New_Small_Table (Low: Color; High: Color) return Small_Table is + Result : Small_Table (Low .. High); + begin + for J in Low .. High loop + Result (J) := (J = Black or J = Green or J = White); + end loop; + return Result; + end New_Small_Table; + + function New_Multi_Table (Low, High: Color; LS, HS: Strength) + return Multi_Table is + Result : Multi_Table (Low .. High, LS .. HS); + Next : Boolean := True; + begin + for J in Low .. High loop + for K in LS .. HS loop + Result (J, K) := Next; + Next := not Next; + end loop; + end loop; + return Result; + end New_Multi_Table; + + function New_Multi_Multi_Table (L1, H1, L2, H2, L3, H3: Positive) + return Multi_Multi_Table is + Result : Multi_Multi_Table (L1 .. H1, L2 .. H2, L3 .. H3); + Next : Boolean := True; + begin + for J in L1 .. H1 loop + for K in L2 .. H2 loop + for L in L3 .. H3 loop + Result (J, K, L) := Next; + Next := not Next; + end loop; + end loop; + end loop; + return Result; + end New_Multi_Multi_Table; + procedure Do_Nothing (A : System.Address) is begin null; diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads index c8f5b00d5c0..fdfd8bbc4c6 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads @@ -16,8 +16,32 @@ with System; package Pck is type Color is (Black, Red, Green, Blue, White); + type Strength is (None, Low, Medium, High); + type Full_Table is array (Color) of Boolean; pragma Pack (Full_Table); + subtype Primary_Color is Color range Red .. Blue; + type Primary_Table is array (Primary_Color) of Boolean; + pragma Pack (Primary_Table); + + type Cold_Color is new Color range Green .. Blue; + type Cold_Table is array (Cold_Color) of Boolean; + pragma Pack (Cold_Table); + + type Small_Table is array (Color range <>) of Boolean; + pragma Pack (Small_Table); + function New_Small_Table (Low: Color; High: Color) return Small_Table; + + type Multi_Table is array (Color range <>, Strength range <>) of Boolean; + pragma Pack (Multi_Table); + function New_Multi_Table (Low, High: Color; LS, HS: Strength) + return Multi_Table; + + type Multi_Multi_Table is array (Positive range <>, Positive range <>, Positive range <>) of Boolean; + pragma Pack (Multi_Multi_Table); + function New_Multi_Multi_Table (L1, H1, L2, H2, L3, H3: Positive) + return Multi_Multi_Table; + procedure Do_Nothing (A : System.Address); end Pck; -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 2020-09-30 20:05 ` [PATCH 1/9] Avoid crash in ada-lang.c:to_fixed_array_type Tom Tromey 2020-09-30 20:05 ` [PATCH 2/9] Fix decoding of multi-dimensional constrained packed arrays Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-11-06 12:08 ` Luis Machado 2020-09-30 20:05 ` [PATCH 4/9] Reject slicing a packed array Tom Tromey ` (6 subsequent siblings) 9 siblings, 1 reply; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey When -fgnat-encodings=minimal, the compiler will avoid the special GNAT-specific "encodings" format, and instead emit ordinary DWARF as much as possible. When emitting DWARF for thick pointers to arrays, the compiler emits something like: <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string <11e0> DW_AT_data_location: 2 byte block: 97 6 (DW_OP_push_object_address; DW_OP_deref) <11e3> DW_AT_type : <0x1173> <11e7> DW_AT_sibling : <0x1201> <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) <11ec> DW_AT_type : <0x1206> <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; DW_OP_deref_size: 4) <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) If you read between the lines, the "array" is actually a structure with two elements. One element is a pointer to the array data, and the other structure describes the bounds of the array. However, the compiler doesn't emit this explicitly, but instead hides it behind these location expressions. gdb can print such objects, but currently there is no way to construct one. So, this patch adds some code to the DWARF reader to recognize this construct, and then synthesize an array descriptor. This descriptor is then handled by the existing Ada code. Internally, we've modified GCC to emit the structure type explicitly (we will of course be sending this upstream). In this case, the array still has the DW_AT_data_location, though. This patch also modifies gdb to ignore the data location in this case -- this is preferred because the location only serves to confuse the Ada code that already knows where to find the data. In the future I hope to move some of this handling to the gdb core, so that Ada-specific hacks are not needed; however I have not yet done this. Because parallel types are not emitted with -fgnat-encodings=minimal, some changes to the Ada code were also required. The change ina ada-valprint.c was needed to avoid infinite recursion when trying to print a constrained packed array. And, there didn't seem to be any need for a recursive call here -- the value could simply be returned instead. Finally, gdb.ada/frame_arg_lang.exp no longer works in C mode, because we drop back to the structure approach now. As mentioned earlier, future work should probably fix this again; meanwhile, this doesn't seem to be a big problem, because it is what is currently done (users as a rule don't use -fgnat-encodings=minimal -- which is what I am ultimately trying to fix). Note that a couple of tests have an added KFAIL. Some -fgnat-encodings=minimal changes have landed in GNAT, and you need something very recent to pass all the tests. I'm using git gcc to accomplish this. gdb/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * dwarf2/read.c (recognize_bound_expression) (quirk_ada_thick_pointer): New functions. (read_array_type): Call quirk_ada_thick_pointer. (set_die_type): Add "skip_data_location" parameter. (quirk_ada_thick_pointer): New function. (process_structure_scope): Call quirk_ada_thick_pointer. * ada-lang.c (ada_is_unconstrained_packed_array_type) (decode_packed_array_bitsize): Handle thick pointers without parallel types. (ada_is_gnat_encoded_packed_array_type): Rename from ada_is_packed_array_type. (ada_is_constrained_packed_array_type): Update. * ada-valprint.c (ada_val_print_gnat_array): Remove. (ada_value_print_1): Use ada_get_decoded_value. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/O2_float_param.exp: Test different -fgnat-encodings values. * gdb.ada/access_to_unbounded_array.exp: Test different -fgnat-encodings values. * gdb.ada/big_packed_array.exp: Test different -fgnat-encodings values. * gdb.ada/arr_enum_idx_w_gap.exp: Test different -fgnat-encodings values. * gdb.ada/array_ptr_renaming.exp: Test different -fgnat-encodings values. * gdb.ada/array_of_variable_length.exp: Test different -fgnat-encodings values. * gdb.ada/arrayparam.exp: Test different -fgnat-encodings values. * gdb.ada/arrayptr.exp: Test different -fgnat-encodings values. * gdb.ada/frame_arg_lang.exp: Revert -fgnat-encodings=minimal change. * gdb.ada/mi_string_access.exp: Test different -fgnat-encodings values. * gdb.ada/mod_from_name.exp: Test different -fgnat-encodings values. * gdb.ada/out_of_line_in_inlined.exp: Test different -fgnat-encodings values. * gdb.ada/packed_array.exp: Test different -fgnat-encodings values. * gdb.ada/pckd_arr_ren.exp: Test different -fgnat-encodings values. * gdb.ada/unc_arr_ptr_in_var_rec.exp: Test different -fgnat-encodings values. * gdb.ada/variant_record_packed_array.exp: Test different -fgnat-encodings values. --- gdb/ChangeLog | 17 + gdb/ada-lang.c | 38 +- gdb/ada-valprint.c | 46 +-- gdb/dwarf2/read.c | 328 +++++++++++++++++- gdb/testsuite/ChangeLog | 32 ++ gdb/testsuite/gdb.ada/O2_float_param.exp | 20 +- .../gdb.ada/access_to_unbounded_array.exp | 20 +- gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp | 26 +- .../gdb.ada/array_of_variable_length.exp | 52 +-- gdb/testsuite/gdb.ada/array_ptr_renaming.exp | 36 +- gdb/testsuite/gdb.ada/arrayparam.exp | 50 +-- gdb/testsuite/gdb.ada/arrayptr.exp | 46 +-- gdb/testsuite/gdb.ada/big_packed_array.exp | 24 +- gdb/testsuite/gdb.ada/frame_arg_lang.exp | 8 +- gdb/testsuite/gdb.ada/mi_string_access.exp | 74 ++-- gdb/testsuite/gdb.ada/mod_from_name.exp | 30 +- .../gdb.ada/out_of_line_in_inlined.exp | 34 +- gdb/testsuite/gdb.ada/packed_array.exp | 55 +-- gdb/testsuite/gdb.ada/pckd_arr_ren.exp | 26 +- .../gdb.ada/unc_arr_ptr_in_var_rec.exp | 92 ++--- .../gdb.ada/variant_record_packed_array.exp | 66 ++-- 21 files changed, 785 insertions(+), 335 deletions(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 624e4ad702b..c7eabbef2ae 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -170,8 +170,6 @@ static long decode_packed_array_bitsize (struct type *); static struct value *decode_constrained_packed_array (struct value *); -static int ada_is_packed_array_type (struct type *); - static int ada_is_unconstrained_packed_array_type (struct type *); static struct value *value_subscript_packed (struct value *, int, @@ -1983,7 +1981,7 @@ ada_coerce_to_simple_array_type (struct type *type) /* Non-zero iff TYPE represents a standard GNAT packed-array type. */ static int -ada_is_packed_array_type (struct type *type) +ada_is_gnat_encoded_packed_array_type (struct type *type) { if (type == NULL) return 0; @@ -2000,7 +1998,7 @@ ada_is_packed_array_type (struct type *type) int ada_is_constrained_packed_array_type (struct type *type) { - return ada_is_packed_array_type (type) + return ada_is_gnat_encoded_packed_array_type (type) && !ada_is_array_descriptor_type (type); } @@ -2010,8 +2008,26 @@ ada_is_constrained_packed_array_type (struct type *type) static int ada_is_unconstrained_packed_array_type (struct type *type) { - return ada_is_packed_array_type (type) - && ada_is_array_descriptor_type (type); + if (!ada_is_array_descriptor_type (type)) + return 0; + + if (ada_is_gnat_encoded_packed_array_type (type)) + return 1; + + /* If we saw GNAT encodings, then the above code is sufficient. + However, with minimal encodings, we will just have a thick + pointer instead. */ + if (is_thick_pntr (type)) + { + type = desc_base_type (type); + /* The structure's first field is a pointer to an array, so this + fetches the array type. */ + type = TYPE_TARGET_TYPE (type->field (0).type ()); + /* Now we can see if the array elements are packed. */ + return TYPE_FIELD_BITSIZE (type, 0) > 0; + } + + return 0; } /* Given that TYPE encodes a packed array type (constrained or unconstrained), @@ -2038,7 +2054,15 @@ decode_packed_array_bitsize (struct type *type) return 0; tail = strstr (raw_name, "___XP"); - gdb_assert (tail != NULL); + if (tail == nullptr) + { + gdb_assert (is_thick_pntr (type)); + /* The structure's first field is a pointer to an array, so this + fetches the array type. */ + type = TYPE_TARGET_TYPE (type->field (0).type ()); + /* Now we can see if the array elements are packed. */ + return TYPE_FIELD_BITSIZE (type, 0); + } if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1) { diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index 3616711ef09..29cc6cee653 100644 --- a/gdb/ada-valprint.c +++ b/gdb/ada-valprint.c @@ -711,36 +711,6 @@ ada_val_print_string (struct type *type, const gdb_byte *valaddr, eltlen, options); } -/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers, - thin pointers, etc). */ - -static void -ada_val_print_gnat_array (struct value *val, - struct ui_file *stream, int recurse, - const struct value_print_options *options) -{ - scoped_value_mark free_values; - - struct type *type = ada_check_typedef (value_type (val)); - - /* If this is a reference, coerce it now. This helps taking care - of the case where ADDRESS is meaningless because original_value - was not an lval. */ - val = coerce_ref (val); - if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */ - val = ada_coerce_to_simple_array_ptr (val); - else - val = ada_coerce_to_simple_array (val); - if (val == NULL) - { - gdb_assert (type->code () == TYPE_CODE_TYPEDEF); - fprintf_filtered (stream, "0x0"); - } - else - common_val_print (val, stream, recurse, options, - language_def (language_ada)); -} - /* Implement Ada value_print'ing for the case where TYPE is a TYPE_CODE_PTR. */ @@ -1028,11 +998,21 @@ ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse, || (ada_is_constrained_packed_array_type (type) && type->code () != TYPE_CODE_PTR)) { - ada_val_print_gnat_array (val, stream, recurse, options); - return; + /* If this is a reference, coerce it now. This helps taking + care of the case where ADDRESS is meaningless because + original_value was not an lval. */ + val = coerce_ref (val); + val = ada_get_decoded_value (val); + if (val == nullptr) + { + gdb_assert (type->code () == TYPE_CODE_TYPEDEF); + fprintf_filtered (stream, "0x0"); + return; + } } + else + val = ada_to_fixed_value (val); - val = ada_to_fixed_value (val); type = value_type (val); struct type *saved_type = type; diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c index c0a89ecbe1e..e3e68fc1f29 100644 --- a/gdb/dwarf2/read.c +++ b/gdb/dwarf2/read.c @@ -1373,6 +1373,9 @@ static void dwarf2_const_value_attr (const struct attribute *attr, const gdb_byte **bytes, struct dwarf2_locexpr_baton **baton); +static struct type *read_subrange_index_type (struct die_info *die, + struct dwarf2_cu *cu); + static struct type *die_type (struct die_info *, struct dwarf2_cu *); static int need_gnat_info (struct dwarf2_cu *); @@ -1598,7 +1601,7 @@ static void prepare_one_comp_unit (struct dwarf2_cu *cu, enum language pretend_language); static struct type *set_die_type (struct die_info *, struct type *, - struct dwarf2_cu *); + struct dwarf2_cu *, bool = false); static void create_all_comp_units (dwarf2_per_objfile *per_objfile); @@ -15825,6 +15828,48 @@ quirk_gcc_member_function_pointer (struct type *type, struct objfile *objfile) smash_to_methodptr_type (type, new_type); } +/* While some versions of GCC will generate complicated DWARF for an + array (see quirk_ada_thick_pointer), more recent versions were + modified to emit an explicit thick pointer structure. However, in + this case, the array still has DWARF expressions for its ranges, + and these must be ignored. */ + +static void +quirk_ada_thick_pointer_struct (struct die_info *die, struct dwarf2_cu *cu, + struct type *type) +{ + gdb_assert (cu->language == language_ada); + + /* Check for a structure with two children. */ + if (type->code () != TYPE_CODE_STRUCT || type->num_fields () != 2) + return; + + /* Check for P_ARRAY and P_BOUNDS members. */ + if (TYPE_FIELD_NAME (type, 0) == NULL + || strcmp (TYPE_FIELD_NAME (type, 0), "P_ARRAY") != 0 + || TYPE_FIELD_NAME (type, 1) == NULL + || strcmp (TYPE_FIELD_NAME (type, 1), "P_BOUNDS") != 0) + return; + + /* Make sure we're looking at a pointer to an array. */ + if (type->field (0).type ()->code () != TYPE_CODE_PTR) + return; + struct type *ary_type = TYPE_TARGET_TYPE (type->field (0).type ()); + + while (ary_type->code () == TYPE_CODE_ARRAY) + { + /* The Ada code already knows how to handle these types, so all + that we need to do is turn the bounds into static bounds. */ + struct type *index_type = ary_type->index_type (); + + index_type->bounds ()->low.set_const_val (1); + index_type->bounds ()->high.set_const_val (0); + + /* Handle multi-dimensional arrays. */ + ary_type = TYPE_TARGET_TYPE (ary_type); + } +} + /* If the DIE has a DW_AT_alignment attribute, return its value, doing appropriate error checking and issuing complaints if there is a problem. */ @@ -16400,6 +16445,8 @@ process_structure_scope (struct die_info *die, struct dwarf2_cu *cu) quirk_gcc_member_function_pointer (type, objfile); if (cu->language == language_rust && die->tag == DW_TAG_union_type) cu->rust_unions.push_back (type); + else if (cu->language == language_ada) + quirk_ada_thick_pointer_struct (die, cu, type); /* NOTE: carlton/2004-03-16: GCC 3.4 (or at least one of its snapshots) has been known to create a die giving a declaration @@ -16696,6 +16743,263 @@ process_enumeration_scope (struct die_info *die, struct dwarf2_cu *cu) new_symbol (die, this_type, cu); } +/* Helper function for quirk_ada_thick_pointer that examines a bounds + expression for an index type and finds the corresponding field + offset in the hidden "P_BOUNDS" structure. Returns true on success + and updates *FIELD, false if it fails to recognize an + expression. */ + +static bool +recognize_bound_expression (struct die_info *die, enum dwarf_attribute name, + int *bounds_offset, struct field *field, + struct dwarf2_cu *cu) +{ + struct attribute *attr = dwarf2_attr (die, name, cu); + if (attr == nullptr || !attr->form_is_block ()) + return false; + + const struct dwarf_block *block = attr->as_block (); + const gdb_byte *start = block->data; + const gdb_byte *end = block->data + block->size; + + /* The expression to recognize generally looks like: + + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) + + However, the second "plus_uconst" may be missing: + + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; + DW_OP_deref_size: 4) + + This happens when the field is at the start of the structure. + + Also, the final deref may not be sized: + + (DW_OP_push_object_address; DW_OP_plus_uconst: 4; DW_OP_deref; + DW_OP_deref) + + This happens when the size of the index type happens to be the + same as the architecture's word size. This can occur with or + without the second plus_uconst. */ + + if (end - start < 2) + return false; + if (*start++ != DW_OP_push_object_address) + return false; + if (*start++ != DW_OP_plus_uconst) + return false; + + uint64_t this_bound_off; + start = gdb_read_uleb128 (start, end, &this_bound_off); + if (start == nullptr || (int) this_bound_off != this_bound_off) + return false; + /* Update *BOUNDS_OFFSET if needed, or alternatively verify that it + is consistent among all bounds. */ + if (*bounds_offset == -1) + *bounds_offset = this_bound_off; + else if (*bounds_offset != this_bound_off) + return false; + + if (start == end || *start++ != DW_OP_deref) + return false; + + int offset = 0; + if (start ==end) + return false; + else if (*start == DW_OP_deref_size || *start == DW_OP_deref) + { + /* This means an offset of 0. */ + } + else if (*start++ != DW_OP_plus_uconst) + return false; + else + { + /* The size is the parameter to DW_OP_plus_uconst. */ + uint64_t val; + start = gdb_read_uleb128 (start, end, &val); + if (start == nullptr) + return false; + if ((int) val != val) + return false; + offset = val; + } + + if (start == end) + return false; + + uint64_t size; + if (*start == DW_OP_deref_size) + { + start = gdb_read_uleb128 (start + 1, end, &size); + if (start == nullptr) + return false; + } + else if (*start == DW_OP_deref) + { + size = cu->header.addr_size; + ++start; + } + else + return false; + + SET_FIELD_BITPOS (*field, 8 * offset); + if (size != TYPE_LENGTH (field->type ())) + FIELD_BITSIZE (*field) = 8 * size; + + return true; +} + +/* With -fgnat-encodings=minimal, gcc will emit some unusual DWARF for + some kinds of Ada arrays: + + <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) + <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string + <11e0> DW_AT_data_location: 2 byte block: 97 6 + (DW_OP_push_object_address; DW_OP_deref) + <11e3> DW_AT_type : <0x1173> + <11e7> DW_AT_sibling : <0x1201> + <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) + <11ec> DW_AT_type : <0x1206> + <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; + DW_OP_deref_size: 4) + <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) + + This actually represents a "thick pointer", which is a structure + with two elements: one that is a pointer to the array data, and one + that is a pointer to another structure; this second structure holds + the array bounds. + + This returns a new type on success, or nullptr if this didn't + recognize the type. */ + +static struct type * +quirk_ada_thick_pointer (struct die_info *die, struct dwarf2_cu *cu, + struct type *type) +{ + struct attribute *attr = dwarf2_attr (die, DW_AT_data_location, cu); + /* So far we've only seen this with block form. */ + if (attr == nullptr || !attr->form_is_block ()) + return nullptr; + + /* Note that this will fail if the structure layout is changed by + the compiler. However, we have no good way to recognize some + other layout, because we don't know what expression the compiler + might choose to emit should this happen. */ + struct dwarf_block *blk = attr->as_block (); + if (blk->size != 2 + || blk->data[0] != DW_OP_push_object_address + || blk->data[1] != DW_OP_deref) + return nullptr; + + int bounds_offset = -1; + int max_align = -1; + std::vector<struct field> range_fields; + for (struct die_info *child_die = die->child; + child_die; + child_die = child_die->sibling) + { + if (child_die->tag == DW_TAG_subrange_type) + { + struct type *underlying = read_subrange_index_type (child_die, cu); + + int this_align = type_align (underlying); + if (this_align > max_align) + max_align = this_align; + + range_fields.emplace_back (); + range_fields.emplace_back (); + + struct field &lower = range_fields[range_fields.size () - 2]; + struct field &upper = range_fields[range_fields.size () - 1]; + + lower.set_type (underlying); + FIELD_ARTIFICIAL (lower) = 1; + + upper.set_type (underlying); + FIELD_ARTIFICIAL (upper) = 1; + + if (!recognize_bound_expression (child_die, DW_AT_lower_bound, + &bounds_offset, &lower, cu) + || !recognize_bound_expression (child_die, DW_AT_upper_bound, + &bounds_offset, &upper, cu)) + return nullptr; + } + } + + /* This shouldn't really happen, but double-check that we found + where the bounds are stored. */ + if (bounds_offset == -1) + return nullptr; + + struct objfile *objfile = cu->per_objfile->objfile; + for (int i = 0; i < range_fields.size (); i += 2) + { + char name[20]; + + /* Set the name of each field in the bounds. */ + xsnprintf (name, sizeof (name), "LB%d", i / 2); + FIELD_NAME (range_fields[i]) = objfile->intern (name); + xsnprintf (name, sizeof (name), "UB%d", i / 2); + FIELD_NAME (range_fields[i + 1]) = objfile->intern (name); + } + + struct type *bounds = alloc_type (objfile); + bounds->set_code (TYPE_CODE_STRUCT); + + bounds->set_num_fields (range_fields.size ()); + bounds->set_fields + ((struct field *) TYPE_ALLOC (bounds, (bounds->num_fields () + * sizeof (struct field)))); + memcpy (bounds->fields (), range_fields.data (), + bounds->num_fields () * sizeof (struct field)); + + int last_fieldno = range_fields.size () - 1; + int bounds_size = (TYPE_FIELD_BITPOS (bounds, last_fieldno) / 8 + + TYPE_LENGTH (bounds->field (last_fieldno).type ())); + TYPE_LENGTH (bounds) = align_up (bounds_size, max_align); + + /* Rewrite the existing array type in place. Specifically, we + remove any dynamic properties we might have read, and we replace + the index types. */ + struct type *iter = type; + for (int i = 0; i < range_fields.size (); i += 2) + { + gdb_assert (iter->code () == TYPE_CODE_ARRAY); + iter->main_type->dyn_prop_list = nullptr; + iter->set_index_type + (create_static_range_type (NULL, bounds->field (i).type (), 1, 0)); + iter = TYPE_TARGET_TYPE (iter); + } + + struct type *result = alloc_type (objfile); + result->set_code (TYPE_CODE_STRUCT); + + result->set_num_fields (2); + result->set_fields + ((struct field *) TYPE_ZALLOC (result, (result->num_fields () + * sizeof (struct field)))); + + /* The names are chosen to coincide with what the compiler does with + -fgnat-encodings=all, which the Ada code in gdb already + understands. */ + TYPE_FIELD_NAME (result, 0) = "P_ARRAY"; + result->field (0).set_type (lookup_pointer_type (type)); + + TYPE_FIELD_NAME (result, 1) = "P_BOUNDS"; + result->field (1).set_type (lookup_pointer_type (bounds)); + SET_FIELD_BITPOS (result->field (1), 8 * bounds_offset); + + result->set_name (type->name ()); + TYPE_LENGTH (result) = (TYPE_LENGTH (result->field (0).type ()) + + TYPE_LENGTH (result->field (1).type ())); + + return result; +} + /* Extract all information from a DW_TAG_array_type DIE and put it in the DIE's type field. For now, this only handles one dimensional arrays. */ @@ -16825,8 +17129,16 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu) maybe_set_alignment (cu, die, type); + struct type *replacement_type = nullptr; + if (cu->language == language_ada) + { + replacement_type = quirk_ada_thick_pointer (die, cu, type); + if (replacement_type != nullptr) + type = replacement_type; + } + /* Install the type in the die. */ - set_die_type (die, type, cu); + set_die_type (die, type, cu, replacement_type != nullptr); /* set_die_type should be already done. */ set_descriptive_type (type, die, cu); @@ -24400,7 +24712,8 @@ per_cu_offset_and_type_eq (const void *item_lhs, const void *item_rhs) * Make the type as complete as possible before fetching more types. */ static struct type * -set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) +set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu, + bool skip_data_location) { dwarf2_per_objfile *per_objfile = cu->per_objfile; struct dwarf2_per_cu_offset_and_type **slot, ofs; @@ -24443,9 +24756,12 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) } /* Read DW_AT_data_location and set in type. */ - attr = dwarf2_attr (die, DW_AT_data_location, cu); - if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) - type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); + if (!skip_data_location) + { + attr = dwarf2_attr (die, DW_AT_data_location, cu); + if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) + type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); + } if (per_objfile->die_type_hash == NULL) per_objfile->die_type_hash diff --git a/gdb/testsuite/gdb.ada/O2_float_param.exp b/gdb/testsuite/gdb.ada/O2_float_param.exp index 09ebeec4059..debc21c407d 100644 --- a/gdb/testsuite/gdb.ada/O2_float_param.exp +++ b/gdb/testsuite/gdb.ada/O2_float_param.exp @@ -19,13 +19,19 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile foo -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { - return -1 -} +foreach_with_prefix scenario {all minimal} { + set flags [list debug \ + optimize=-O2 \ + additional_flags=-fgnat-encodings=$scenario] + + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -clean_restart ${testfile} + clean_restart ${testfile} -runto "increment" + runto "increment" -gdb_test "frame" \ - "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" + gdb_test "frame" \ + "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" +} diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp index 9830ef732b6..f3fea4abbeb 100644 --- a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp @@ -19,14 +19,18 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" -gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" + gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" + gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" +} diff --git a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp index f5936df46bb..b3a4c0d3d77 100644 --- a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp +++ b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile foo_q418_043 -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] -clean_restart ${testfile} + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] -if ![runto "foo_q418_043.adb:$bp_location" ] then { - perror "Couldn't run ${testfile}" - return -} + clean_restart ${testfile} -gdb_test "print A" \ - " = \\(42, 42\\)" + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] + if ![runto "foo_q418_043.adb:$bp_location" ] then { + perror "Couldn't run ${testfile}" + return + } + + gdb_test "print A" \ + " = \\(42, 42\\)" +} diff --git a/gdb/testsuite/gdb.ada/array_of_variable_length.exp b/gdb/testsuite/gdb.ada/array_of_variable_length.exp index 9eb67776299..af9cb6f9d0d 100644 --- a/gdb/testsuite/gdb.ada/array_of_variable_length.exp +++ b/gdb/testsuite/gdb.ada/array_of_variable_length.exp @@ -19,28 +19,32 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" + + # Pck.A is an array that embeds elements with variable size so compilers will + # emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch + # individual elements. Array stride is also a way to describe packed arrays: + # make sure we do not consider Pck.A as a packed array. + gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" + + # Make sure this also works with a type from a fully evaluated value. During + # evaluation, dynamic types can be "resolved" so GDB internals could "forget" + # that elements have variable size. Fortunately, type resolution of array + # elements happens only when processing individual elements (i.e. the resolved + # array type is still associated to the dynamic element type), so the following + # is supposed to work. + gdb_test "print pck.a" \ + "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" + gdb_test "ptype $"\ + "array \\(1 \\.\\. 2\\) of pck\\.r_type" } - -clean_restart ${testfile} - -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" - -# Pck.A is an array that embeds elements with variable size so compilers will -# emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch -# individual elements. Array stride is also a way to describe packed arrays: -# make sure we do not consider Pck.A as a packed array. -gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" - -# Make sure this also works with a type from a fully evaluated value. During -# evaluation, dynamic types can be "resolved" so GDB internals could "forget" -# that elements have variable size. Fortunately, type resolution of array -# elements happens only when processing individual elements (i.e. the resolved -# array type is still associated to the dynamic element type), so the following -# is supposed to work. -gdb_test "print pck.a" \ - "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" -gdb_test "ptype $"\ - "array \\(1 \\.\\. 2\\) of pck\\.r_type" diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp index 4355508a2f5..81c1a390d23 100644 --- a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp @@ -19,23 +19,27 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print nt" " = \\(10, 20\\)" -gdb_test "print nt(1)" " = 10" + gdb_test "print nt" " = \\(10, 20\\)" + gdb_test "print nt(1)" " = 10" -# Accesses to arrays and unconstrained arrays have the same runtime -# representation with GNAT (fat pointers). In this case, GDB "forgets" that -# it's dealing with an access and prints directly the array contents. This -# should be fixed some day. -setup_kfail "gdb/25883" *-*-* -gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" -gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" -gdb_test "print ntp(3)" " = 30" + # Accesses to arrays and unconstrained arrays have the same runtime + # representation with GNAT (fat pointers). In this case, GDB "forgets" that + # it's dealing with an access and prints directly the array contents. This + # should be fixed some day. + setup_kfail "gdb/25883" *-*-* + gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" + gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" + gdb_test "print ntp(3)" " = 30" +} diff --git a/gdb/testsuite/gdb.ada/arrayparam.exp b/gdb/testsuite/gdb.ada/arrayparam.exp index dc36499f33d..326c9d4aae8 100644 --- a/gdb/testsuite/gdb.ada/arrayparam.exp +++ b/gdb/testsuite/gdb.ada/arrayparam.exp @@ -19,34 +19,40 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile foo -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { - return -1 -} +# Note we don't test the "none" (no -fgnat-encodings option) scenario +# here, because "all" and "minimal" cover the cases, and this way we +# don't have to update the test when gnat changes its default. +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} -# Verify that a call to a function that takes an array as a parameter -# works without problem. + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print call_me(\"bonjour\")" \ - "= void" + # Verify that a call to a function that takes an array as a parameter + # works without problem. -# Verify that the array was passed properly by checking the global -# variables that Call_Me sets as side-effects. Use the package name to avoid -# name clash with debug info of system libraries. + gdb_test "print call_me(\"bonjour\")" \ + "= void" -gdb_test "print pck.first" \ - "= 98 'b'" \ - "print first after function call" + # Verify that the array was passed properly by checking the global + # variables that Call_Me sets as side-effects. Use the package name to avoid + # name clash with debug info of system libraries. -gdb_test "print pck.last" \ - "= 114 'r'" \ - "print last after function call" + gdb_test "print pck.first" \ + "= 98 'b'" \ + "print first after function call" -gdb_test "print pck.length" \ - "= 7" \ - "print length after function call" + gdb_test "print pck.last" \ + "= 114 'r'" \ + "print last after function call" + gdb_test "print pck.length" \ + "= 7" \ + "print length after function call" +} diff --git a/gdb/testsuite/gdb.ada/arrayptr.exp b/gdb/testsuite/gdb.ada/arrayptr.exp index 94a5d876bd2..fa84a7a2ff1 100644 --- a/gdb/testsuite/gdb.ada/arrayptr.exp +++ b/gdb/testsuite/gdb.ada/arrayptr.exp @@ -19,36 +19,40 @@ 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_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] -if ![runto "foo.adb:$bp_location" ] then { - perror "Couldn't run ${testfile}" - return -} + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] + if ![runto "foo.adb:$bp_location" ] then { + perror "Couldn't run ${testfile}" + return + } -gdb_test "print string_p" \ - "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" + gdb_test "print string_p" \ + "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" -gdb_test "print string_p(3..4)" "= \"ll\"" + gdb_test "print string_p(3..4)" "= \"ll\"" -gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" + gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" -gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" + gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" -gdb_test "print arr_ptr(2)" "= 22" + gdb_test "print arr_ptr(2)" "= 22" -gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" + gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" -gdb_test "ptype string_access" "= access array \\(<>\\) of character" + gdb_test "ptype string_access" "= access array \\(<>\\) of character" -gdb_test "print pa_ptr.all" \ - " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" + gdb_test "print pa_ptr.all" \ + " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" -gdb_test "print pa_ptr(3)" " = 30" + gdb_test "print pa_ptr(3)" " = 30" -gdb_test "print pa_ptr.all(3)" " = 30" + gdb_test "print pa_ptr.all(3)" " = 30" +} diff --git a/gdb/testsuite/gdb.ada/big_packed_array.exp b/gdb/testsuite/gdb.ada/big_packed_array.exp index fe49a1926d6..e24466b9cbe 100644 --- a/gdb/testsuite/gdb.ada/big_packed_array.exp +++ b/gdb/testsuite/gdb.ada/big_packed_array.exp @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile foo_ra24_010 -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] + + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -clean_restart ${testfile} + clean_restart ${testfile} -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] -runto "foo_ra24_010.adb:$bp_location" + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] + runto "foo_ra24_010.adb:$bp_location" -gdb_test "print good" \ - "= \\(false <repeats 196 times>\\)" \ + gdb_test "print good" \ + "= \\(false <repeats 196 times>\\)" \ -gdb_test "print bad" \ - "= \\(false <repeats 196 times>\\)" \ + gdb_test "print bad" \ + "= \\(false <repeats 196 times>\\)" +} diff --git a/gdb/testsuite/gdb.ada/frame_arg_lang.exp b/gdb/testsuite/gdb.ada/frame_arg_lang.exp index 9662e359524..9668f0e7d9e 100644 --- a/gdb/testsuite/gdb.ada/frame_arg_lang.exp +++ b/gdb/testsuite/gdb.ada/frame_arg_lang.exp @@ -69,14 +69,8 @@ foreach_with_prefix scenario {all minimal} { "The current source language is \"c\"." \ "show language when set to 'c'" - # With -fgnat-encodings=minimal, this works properly in C as well. - if {$scenario == "minimal"} { - set expected "\"test\"" - } else { - set expected "{P_ARRAY = $hex, P_BOUNDS = $hex}" - } gdb_test "bt" \ - "#1 $hex in pck\\.call_me \\(s=$expected\\).*" \ + "#1 $hex in pck\\.call_me \\(s={P_ARRAY = $hex, P_BOUNDS = $hex}\\).*" \ "backtrace with language forced to 'c'" gdb_test_no_output "set language auto" \ diff --git a/gdb/testsuite/gdb.ada/mi_string_access.exp b/gdb/testsuite/gdb.ada/mi_string_access.exp index 5e07f1ebcc0..0b5ab2dfd04 100644 --- a/gdb/testsuite/gdb.ada/mi_string_access.exp +++ b/gdb/testsuite/gdb.ada/mi_string_access.exp @@ -19,48 +19,52 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile bar -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] -load_lib mi-support.exp -set MIFLAGS "-i=mi" + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -gdb_exit -if [mi_gdb_start] { - continue -} + load_lib mi-support.exp + set MIFLAGS "-i=mi" -mi_delete_breakpoints -mi_gdb_reinitialize_dir $srcdir/$subdir -mi_gdb_load ${binfile} + gdb_exit + if [mi_gdb_start] { + continue + } -if ![mi_run_to_main] then { - fail "cannot run to main, testcase aborted" - return 0 -} + mi_delete_breakpoints + mi_gdb_reinitialize_dir $srcdir/$subdir + mi_gdb_load ${binfile} -set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] -mi_continue_to_line \ - "bar.adb:$bp_location" \ - "stop at start of main Ada procedure" + if ![mi_run_to_main] then { + fail "cannot run to main, testcase aborted" + return 0 + } -mi_gdb_test "-var-create var1 * Aos" \ - "\\^done,name=\"var1\",numchild=\"2\",.*" \ - "Create var1 varobj" + set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] + mi_continue_to_line \ + "bar.adb:$bp_location" \ + "stop at start of main Ada procedure" -mi_gdb_test "-var-list-children 1 var1" \ - "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ - "list var1's children" + mi_gdb_test "-var-create var1 * Aos" \ + "\\^done,name=\"var1\",numchild=\"2\",.*" \ + "Create var1 varobj" -mi_gdb_test "-var-evaluate-expression var1" \ - "\\^done,value=\"\\\[2\\\]\"" \ - "Print var1" + mi_gdb_test "-var-list-children 1 var1" \ + "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ + "list var1's children" -mi_gdb_test "-var-evaluate-expression var1.1" \ - "\\^done,value=\"$hex\"" \ - "Print var1 first child" + mi_gdb_test "-var-evaluate-expression var1" \ + "\\^done,value=\"\\\[2\\\]\"" \ + "Print var1" -mi_gdb_test "-var-evaluate-expression var1.2" \ - "\\^done,value=\"$hex\"" \ - "Print var1 second child" + mi_gdb_test "-var-evaluate-expression var1.1" \ + "\\^done,value=\"$hex\"" \ + "Print var1 first child" + + mi_gdb_test "-var-evaluate-expression var1.2" \ + "\\^done,value=\"$hex\"" \ + "Print var1 second child" +} diff --git a/gdb/testsuite/gdb.ada/mod_from_name.exp b/gdb/testsuite/gdb.ada/mod_from_name.exp index dce0f3ac3a6..fec383bb490 100644 --- a/gdb/testsuite/gdb.ada/mod_from_name.exp +++ b/gdb/testsuite/gdb.ada/mod_from_name.exp @@ -19,17 +19,25 @@ 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_location [gdb_get_line_number "START" ${testdir}/foo.adb] -if ![runto "foo.adb:$bp_location" ] then { - perror "Couldn't run ${testfile}" - return -} + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] + if ![runto "foo.adb:$bp_location" ] then { + perror "Couldn't run ${testfile}" + return + } -gdb_test "print xp" \ - "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" + # GNAT >= 11.0 has the needed fix here. + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print xp" \ + "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" +} diff --git a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp index 684a3699245..7ffb7cb7797 100644 --- a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp +++ b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp @@ -19,21 +19,27 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile foo_o224_021 -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { - return -1 -} +foreach_with_prefix scenario {all minimal} { + set flags [list debug \ + optimize=-O2 \ + additional_flags=-fgnat-encodings=$scenario] + + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -clean_restart ${testfile} + clean_restart ${testfile} -gdb_test "break foo_o224_021.child1.child2" \ - "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." + gdb_test "break foo_o224_021.child1.child2" \ + "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." -gdb_run_cmd -gdb_test "" \ - "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" + gdb_run_cmd + gdb_test "" \ + "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" -set opt_addr_in "($hex in)?" -gdb_test "bt" \ - [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ - "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ - "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] + set opt_addr_in "($hex in)?" + gdb_test "bt" \ + [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ + "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ + "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] +} diff --git a/gdb/testsuite/gdb.ada/packed_array.exp b/gdb/testsuite/gdb.ada/packed_array.exp index 0928b1b3646..96613183f69 100644 --- a/gdb/testsuite/gdb.ada/packed_array.exp +++ b/gdb/testsuite/gdb.ada/packed_array.exp @@ -19,39 +19,42 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile pa -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}/pa.adb] -runto "pa.adb:$bp_location" + clean_restart ${testfile} -gdb_test "print var" \ - "= \\(4 => true, false, true, false, true\\)" + set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb] + runto "pa.adb:$bp_location" -# Try printing the value and the type definition of a reference -# to variable "Var". + gdb_test "print var" \ + "= \\(4 => true, false, true, false, true\\)" -gdb_test "ptype &var" \ - "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>" + # Try printing the value and the type definition of a reference + # to variable "Var". -gdb_test "print &var" \ - "= \\(access pa.packed_array\\) 0x.*" + gdb_test "ptype &var" \ + "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>" -# Print the value of U_Var, an unconstrainted packed array. + gdb_test "print &var" \ + "= \\(access pa.packed_array\\) 0x.*" -set test "print u_var" -gdb_test_multiple "$test" "$test" { - -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { - pass $test - } - -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { - # The compiler forgot to emit the packed array's ___XA type, - # preventing us from determining the what the array bounds - # are. Observed with (FSF GNU Ada 4.5.3 20110124). - xfail $test + # Print the value of U_Var, an unconstrainted packed array. + + set test "print u_var" + gdb_test_multiple "$test" "$test" { + -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { + pass $test + } + -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { + # The compiler forgot to emit the packed array's ___XA type, + # preventing us from determining the what the array bounds + # are. Observed with (FSF GNU Ada 4.5.3 20110124). + xfail $test + } } } - diff --git a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp index d41de442b5d..13e599b6a58 100644 --- a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp +++ b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp @@ -19,15 +19,23 @@ 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] + + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -clean_restart ${testfile} + clean_restart ${testfile} -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print A2" \ - "= (<ref>\\s*)?\\(false, false\\)" \ - "print var" + # GNAT >= 11.0 has the needed fix here. + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print A2" \ + "= (<ref>\\s*)?\\(false, false\\)" \ + "print var" +} diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp index f7f3485161d..a7fd4655d48 100644 --- a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp @@ -19,68 +19,72 @@ 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_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -# Print My_Object and My_Object.Ptr when Ptr is null... + # Print My_Object and My_Object.Ptr when Ptr is null... -gdb_test "print my_object" \ - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ - "print My_Object with null Ptr" + gdb_test "print my_object" \ + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ + "print My_Object with null Ptr" -gdb_test "print my_object.ptr" \ - "= \\(foo.table_access\\) 0x0" \ - "print My_Object.Ptr when null" + gdb_test "print my_object.ptr" \ + "= \\(foo.table_access\\) 0x0" \ + "print My_Object.Ptr when null" -# Same for My_P_Object... + # Same for My_P_Object... -gdb_test "print my_p_object" \ - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ - "print My_P_Object with null Ptr" + gdb_test "print my_p_object" \ + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ + "print My_P_Object with null Ptr" -gdb_test "print my_p_object.ptr" \ - "\\(foo.p_table_access\\) 0x0" \ - "print My_P_Object.Ptr when null" + gdb_test "print my_p_object.ptr" \ + "\\(foo.p_table_access\\) 0x0" \ + "print My_P_Object.Ptr when null" -# Continue until the Ptr component of both objects get allocated. + # Continue until the Ptr component of both objects get allocated. -set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] + set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] -gdb_breakpoint "foo.adb:$bp_location" + gdb_breakpoint "foo.adb:$bp_location" -gdb_test "continue" \ - "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ - "continue to STOP2" + gdb_test "continue" \ + "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ + "continue to STOP2" -# Inspect My_Object again... + # Inspect My_Object again... -gdb_test "print my_object" \ - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ - "print my_object after setting Ptr" + gdb_test "print my_object" \ + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ + "print my_object after setting Ptr" -gdb_test "print my_object.ptr" \ - "\\(foo.table_access\\) $hex" \ - "print my_object.ptr when no longer null" + gdb_test "print my_object.ptr" \ + "\\(foo.table_access\\) $hex" \ + "print my_object.ptr when no longer null" -gdb_test "print my_object.ptr.all" \ - "= \\(13, 21, 34\\)" + gdb_test "print my_object.ptr.all" \ + "= \\(13, 21, 34\\)" -# Same with My_P_Object... + # Same with My_P_Object... -gdb_test "print my_p_object" \ - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ - "print my_p_object after setting Ptr" + gdb_test "print my_p_object" \ + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ + "print my_p_object after setting Ptr" -gdb_test "print my_p_object.ptr" \ - "= \\(foo.p_table_access\\) $hex" \ - "print My_P_Object.Ptr when no longer null" + gdb_test "print my_p_object.ptr" \ + "= \\(foo.p_table_access\\) $hex" \ + "print My_P_Object.Ptr when no longer null" -gdb_test "print my_p_object.ptr.all" \ - "\\(13, 21, 34\\)" + gdb_test "print my_p_object.ptr.all" \ + "\\(13, 21, 34\\)" +} diff --git a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp index e10c62b7bbf..7f10d3dfc06 100644 --- a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp +++ b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp @@ -19,35 +19,53 @@ 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] -clean_restart ${testfile} + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + clean_restart ${testfile} -set test "print my_buffer" -gdb_test_multiple "$test" $test { - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { - pass $test - } - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { - pass $test + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" + + set test "print my_buffer" + gdb_test_multiple "$test" $test { + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { + pass $test + } + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { + pass $test + } + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { + # GNAT >= 11.0 has the needed fix here. + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + setup_kfail "minimal encodings" *-*-* + } + fail $test + } } -} -gdb_test "print my_buffer'Address" \ - "= \\(system\\.address\\) $hex" \ - "print address" + gdb_test "print my_buffer'Address" \ + "= \\(system\\.address\\) $hex" \ + "print address" -set test "print {foo.octal_buffer}($)" -gdb_test_multiple "$test" $test { - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { - pass $test - } - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { - pass $test + set test "print {foo.octal_buffer}($)" + gdb_test_multiple "$test" $test { + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { + pass $test + } + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { + pass $test + } + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { + # GNAT >= 11.0 has the needed fix here. + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + setup_kfail "minimal encodings" *-*-* + } + fail $test + } } } -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal 2020-09-30 20:05 ` [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal Tom Tromey @ 2020-11-06 12:08 ` Luis Machado 2020-11-06 17:55 ` Tom Tromey 0 siblings, 1 reply; 20+ messages in thread From: Luis Machado @ 2020-11-06 12:08 UTC (permalink / raw) To: Tom Tromey, gdb-patches Hi, I bisected a few regressions on aarch64-linux to this commit: FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five FAIL: gdb.dwarf2/data-loc.exp: ptype foo.array_type FAIL: gdb.dwarf2/data-loc.exp: print foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__three FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three FAIL: gdb.dwarf2/data-loc.exp: print foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__five FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five FAIL: gdb.dwarf2/data-loc.exp: print foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type === gdb Summary === # of expected passes 34 # of unexpected failures 16 -- The failures look like the following: -- ptype foo.three^M type = array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three print foo.three_tdef^M $8 = (foo.array_type) 0xaaaaaaabb010 <table_1_data>^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef ptype foo.three_tdef^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three_tdef ptype foo.five^M type = array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five ptype foo.array_type^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.array_type print foo.five_tdef^M $24 = (foo.array_type) 0xaaaaaaabb028 <table_2_data>^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo.five_tdef ptype foo.five_tdef^M type = access array (<>) of integer^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five_tdef print foo__three^M $33 = {P_ARRAY = 0xaaaaaaabb010 <table_1_data>, P_BOUNDS = 0xaaaaaaabb020 <table_1_bounds>}^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__three ptype foo__three^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three print foo__three_tdef^M $34 = {P_ARRAY = 0xaaaaaaabb010 <table_1_data>, P_BOUNDS = 0xaaaaaaabb020 <table_1_bounds>}^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__three_tdef ptype foo__three_tdef^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three_tdef print foo__five^M $35 = {P_ARRAY = 0xaaaaaaabb028 <table_2_data>, P_BOUNDS = 0xaaaaaaabb040 <table_2_bounds>}^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__five ptype foo__five^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five print foo__five_tdef^M $36 = {P_ARRAY = 0xaaaaaaabb028 <table_2_data>, P_BOUNDS = 0xaaaaaaabb040 <table_2_bounds>}^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: print foo__five_tdef ptype foo__five_tdef^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five_tdef ptype foo__array_type^M type = struct foo__array_type {^M foo__array_type *P_ARRAY;^M struct {^M } *P_BOUNDS;^M }^M (gdb) FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type -- Could you please take a look? On 9/30/20 5:05 PM, Tom Tromey wrote: > When -fgnat-encodings=minimal, the compiler will avoid the special > GNAT-specific "encodings" format, and instead emit ordinary DWARF as > much as possible. > > When emitting DWARF for thick pointers to arrays, the compiler emits > something like: > > <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) > <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string > <11e0> DW_AT_data_location: 2 byte block: 97 6 > (DW_OP_push_object_address; DW_OP_deref) > <11e3> DW_AT_type : <0x1173> > <11e7> DW_AT_sibling : <0x1201> > <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) > <11ec> DW_AT_type : <0x1206> > <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 > (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > DW_OP_deref_size: 4) > <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 > (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > > If you read between the lines, the "array" is actually a structure > with two elements. One element is a pointer to the array data, and > the other structure describes the bounds of the array. However, the > compiler doesn't emit this explicitly, but instead hides it behind > these location expressions. > > gdb can print such objects, but currently there is no way to construct > one. So, this patch adds some code to the DWARF reader to recognize > this construct, and then synthesize an array descriptor. This > descriptor is then handled by the existing Ada code. > > Internally, we've modified GCC to emit the structure type explicitly > (we will of course be sending this upstream). In this case, the array > still has the DW_AT_data_location, though. This patch also modifies > gdb to ignore the data location in this case -- this is preferred > because the location only serves to confuse the Ada code that already > knows where to find the data. In the future I hope to move some of > this handling to the gdb core, so that Ada-specific hacks are not > needed; however I have not yet done this. > > Because parallel types are not emitted with -fgnat-encodings=minimal, > some changes to the Ada code were also required. > > The change ina ada-valprint.c was needed to avoid infinite recursion > when trying to print a constrained packed array. And, there didn't > seem to be any need for a recursive call here -- the value could > simply be returned instead. > > Finally, gdb.ada/frame_arg_lang.exp no longer works in C mode, because > we drop back to the structure approach now. As mentioned earlier, > future work should probably fix this again; meanwhile, this doesn't > seem to be a big problem, because it is what is currently done (users > as a rule don't use -fgnat-encodings=minimal -- which is what I am > ultimately trying to fix). > > Note that a couple of tests have an added KFAIL. Some > -fgnat-encodings=minimal changes have landed in GNAT, and you need > something very recent to pass all the tests. I'm using git gcc to > accomplish this. > > gdb/ChangeLog > 2020-09-30 Tom Tromey <tromey@adacore.com> > > * dwarf2/read.c (recognize_bound_expression) > (quirk_ada_thick_pointer): New functions. > (read_array_type): Call quirk_ada_thick_pointer. > (set_die_type): Add "skip_data_location" parameter. > (quirk_ada_thick_pointer): New function. > (process_structure_scope): Call quirk_ada_thick_pointer. > * ada-lang.c (ada_is_unconstrained_packed_array_type) > (decode_packed_array_bitsize): Handle thick pointers without > parallel types. > (ada_is_gnat_encoded_packed_array_type): Rename from > ada_is_packed_array_type. > (ada_is_constrained_packed_array_type): Update. > * ada-valprint.c (ada_val_print_gnat_array): Remove. > (ada_value_print_1): Use ada_get_decoded_value. > > gdb/testsuite/ChangeLog > 2020-09-30 Tom Tromey <tromey@adacore.com> > > * gdb.ada/O2_float_param.exp: Test different -fgnat-encodings > values. > * gdb.ada/access_to_unbounded_array.exp: Test different > -fgnat-encodings values. > * gdb.ada/big_packed_array.exp: Test different -fgnat-encodings > values. > * gdb.ada/arr_enum_idx_w_gap.exp: Test different -fgnat-encodings > values. > * gdb.ada/array_ptr_renaming.exp: Test different -fgnat-encodings > values. > * gdb.ada/array_of_variable_length.exp: Test different > -fgnat-encodings values. > * gdb.ada/arrayparam.exp: Test different -fgnat-encodings values. > * gdb.ada/arrayptr.exp: Test different -fgnat-encodings values. > * gdb.ada/frame_arg_lang.exp: Revert -fgnat-encodings=minimal > change. > * gdb.ada/mi_string_access.exp: Test different -fgnat-encodings > values. > * gdb.ada/mod_from_name.exp: Test different -fgnat-encodings values. > * gdb.ada/out_of_line_in_inlined.exp: Test different > -fgnat-encodings values. > * gdb.ada/packed_array.exp: Test different -fgnat-encodings > values. > * gdb.ada/pckd_arr_ren.exp: Test different -fgnat-encodings > values. > * gdb.ada/unc_arr_ptr_in_var_rec.exp: Test different > -fgnat-encodings values. > * gdb.ada/variant_record_packed_array.exp: Test different > -fgnat-encodings values. > --- > gdb/ChangeLog | 17 + > gdb/ada-lang.c | 38 +- > gdb/ada-valprint.c | 46 +-- > gdb/dwarf2/read.c | 328 +++++++++++++++++- > gdb/testsuite/ChangeLog | 32 ++ > gdb/testsuite/gdb.ada/O2_float_param.exp | 20 +- > .../gdb.ada/access_to_unbounded_array.exp | 20 +- > gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp | 26 +- > .../gdb.ada/array_of_variable_length.exp | 52 +-- > gdb/testsuite/gdb.ada/array_ptr_renaming.exp | 36 +- > gdb/testsuite/gdb.ada/arrayparam.exp | 50 +-- > gdb/testsuite/gdb.ada/arrayptr.exp | 46 +-- > gdb/testsuite/gdb.ada/big_packed_array.exp | 24 +- > gdb/testsuite/gdb.ada/frame_arg_lang.exp | 8 +- > gdb/testsuite/gdb.ada/mi_string_access.exp | 74 ++-- > gdb/testsuite/gdb.ada/mod_from_name.exp | 30 +- > .../gdb.ada/out_of_line_in_inlined.exp | 34 +- > gdb/testsuite/gdb.ada/packed_array.exp | 55 +-- > gdb/testsuite/gdb.ada/pckd_arr_ren.exp | 26 +- > .../gdb.ada/unc_arr_ptr_in_var_rec.exp | 92 ++--- > .../gdb.ada/variant_record_packed_array.exp | 66 ++-- > 21 files changed, 785 insertions(+), 335 deletions(-) > > diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c > index 624e4ad702b..c7eabbef2ae 100644 > --- a/gdb/ada-lang.c > +++ b/gdb/ada-lang.c > @@ -170,8 +170,6 @@ static long decode_packed_array_bitsize (struct type *); > > static struct value *decode_constrained_packed_array (struct value *); > > -static int ada_is_packed_array_type (struct type *); > - > static int ada_is_unconstrained_packed_array_type (struct type *); > > static struct value *value_subscript_packed (struct value *, int, > @@ -1983,7 +1981,7 @@ ada_coerce_to_simple_array_type (struct type *type) > /* Non-zero iff TYPE represents a standard GNAT packed-array type. */ > > static int > -ada_is_packed_array_type (struct type *type) > +ada_is_gnat_encoded_packed_array_type (struct type *type) > { > if (type == NULL) > return 0; > @@ -2000,7 +1998,7 @@ ada_is_packed_array_type (struct type *type) > int > ada_is_constrained_packed_array_type (struct type *type) > { > - return ada_is_packed_array_type (type) > + return ada_is_gnat_encoded_packed_array_type (type) > && !ada_is_array_descriptor_type (type); > } > > @@ -2010,8 +2008,26 @@ ada_is_constrained_packed_array_type (struct type *type) > static int > ada_is_unconstrained_packed_array_type (struct type *type) > { > - return ada_is_packed_array_type (type) > - && ada_is_array_descriptor_type (type); > + if (!ada_is_array_descriptor_type (type)) > + return 0; > + > + if (ada_is_gnat_encoded_packed_array_type (type)) > + return 1; > + > + /* If we saw GNAT encodings, then the above code is sufficient. > + However, with minimal encodings, we will just have a thick > + pointer instead. */ > + if (is_thick_pntr (type)) > + { > + type = desc_base_type (type); > + /* The structure's first field is a pointer to an array, so this > + fetches the array type. */ > + type = TYPE_TARGET_TYPE (type->field (0).type ()); > + /* Now we can see if the array elements are packed. */ > + return TYPE_FIELD_BITSIZE (type, 0) > 0; > + } > + > + return 0; > } > > /* Given that TYPE encodes a packed array type (constrained or unconstrained), > @@ -2038,7 +2054,15 @@ decode_packed_array_bitsize (struct type *type) > return 0; > > tail = strstr (raw_name, "___XP"); > - gdb_assert (tail != NULL); > + if (tail == nullptr) > + { > + gdb_assert (is_thick_pntr (type)); > + /* The structure's first field is a pointer to an array, so this > + fetches the array type. */ > + type = TYPE_TARGET_TYPE (type->field (0).type ()); > + /* Now we can see if the array elements are packed. */ > + return TYPE_FIELD_BITSIZE (type, 0); > + } > > if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1) > { > diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c > index 3616711ef09..29cc6cee653 100644 > --- a/gdb/ada-valprint.c > +++ b/gdb/ada-valprint.c > @@ -711,36 +711,6 @@ ada_val_print_string (struct type *type, const gdb_byte *valaddr, > eltlen, options); > } > > -/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers, > - thin pointers, etc). */ > - > -static void > -ada_val_print_gnat_array (struct value *val, > - struct ui_file *stream, int recurse, > - const struct value_print_options *options) > -{ > - scoped_value_mark free_values; > - > - struct type *type = ada_check_typedef (value_type (val)); > - > - /* If this is a reference, coerce it now. This helps taking care > - of the case where ADDRESS is meaningless because original_value > - was not an lval. */ > - val = coerce_ref (val); > - if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */ > - val = ada_coerce_to_simple_array_ptr (val); > - else > - val = ada_coerce_to_simple_array (val); > - if (val == NULL) > - { > - gdb_assert (type->code () == TYPE_CODE_TYPEDEF); > - fprintf_filtered (stream, "0x0"); > - } > - else > - common_val_print (val, stream, recurse, options, > - language_def (language_ada)); > -} > - > /* Implement Ada value_print'ing for the case where TYPE is a > TYPE_CODE_PTR. */ > > @@ -1028,11 +998,21 @@ ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse, > || (ada_is_constrained_packed_array_type (type) > && type->code () != TYPE_CODE_PTR)) > { > - ada_val_print_gnat_array (val, stream, recurse, options); > - return; > + /* If this is a reference, coerce it now. This helps taking > + care of the case where ADDRESS is meaningless because > + original_value was not an lval. */ > + val = coerce_ref (val); > + val = ada_get_decoded_value (val); > + if (val == nullptr) > + { > + gdb_assert (type->code () == TYPE_CODE_TYPEDEF); > + fprintf_filtered (stream, "0x0"); > + return; > + } > } > + else > + val = ada_to_fixed_value (val); > > - val = ada_to_fixed_value (val); > type = value_type (val); > struct type *saved_type = type; > > diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c > index c0a89ecbe1e..e3e68fc1f29 100644 > --- a/gdb/dwarf2/read.c > +++ b/gdb/dwarf2/read.c > @@ -1373,6 +1373,9 @@ static void dwarf2_const_value_attr (const struct attribute *attr, > const gdb_byte **bytes, > struct dwarf2_locexpr_baton **baton); > > +static struct type *read_subrange_index_type (struct die_info *die, > + struct dwarf2_cu *cu); > + > static struct type *die_type (struct die_info *, struct dwarf2_cu *); > > static int need_gnat_info (struct dwarf2_cu *); > @@ -1598,7 +1601,7 @@ static void prepare_one_comp_unit (struct dwarf2_cu *cu, > enum language pretend_language); > > static struct type *set_die_type (struct die_info *, struct type *, > - struct dwarf2_cu *); > + struct dwarf2_cu *, bool = false); > > static void create_all_comp_units (dwarf2_per_objfile *per_objfile); > > @@ -15825,6 +15828,48 @@ quirk_gcc_member_function_pointer (struct type *type, struct objfile *objfile) > smash_to_methodptr_type (type, new_type); > } > > +/* While some versions of GCC will generate complicated DWARF for an > + array (see quirk_ada_thick_pointer), more recent versions were > + modified to emit an explicit thick pointer structure. However, in > + this case, the array still has DWARF expressions for its ranges, > + and these must be ignored. */ > + > +static void > +quirk_ada_thick_pointer_struct (struct die_info *die, struct dwarf2_cu *cu, > + struct type *type) > +{ > + gdb_assert (cu->language == language_ada); > + > + /* Check for a structure with two children. */ > + if (type->code () != TYPE_CODE_STRUCT || type->num_fields () != 2) > + return; > + > + /* Check for P_ARRAY and P_BOUNDS members. */ > + if (TYPE_FIELD_NAME (type, 0) == NULL > + || strcmp (TYPE_FIELD_NAME (type, 0), "P_ARRAY") != 0 > + || TYPE_FIELD_NAME (type, 1) == NULL > + || strcmp (TYPE_FIELD_NAME (type, 1), "P_BOUNDS") != 0) > + return; > + > + /* Make sure we're looking at a pointer to an array. */ > + if (type->field (0).type ()->code () != TYPE_CODE_PTR) > + return; > + struct type *ary_type = TYPE_TARGET_TYPE (type->field (0).type ()); > + > + while (ary_type->code () == TYPE_CODE_ARRAY) > + { > + /* The Ada code already knows how to handle these types, so all > + that we need to do is turn the bounds into static bounds. */ > + struct type *index_type = ary_type->index_type (); > + > + index_type->bounds ()->low.set_const_val (1); > + index_type->bounds ()->high.set_const_val (0); > + > + /* Handle multi-dimensional arrays. */ > + ary_type = TYPE_TARGET_TYPE (ary_type); > + } > +} > + > /* If the DIE has a DW_AT_alignment attribute, return its value, doing > appropriate error checking and issuing complaints if there is a > problem. */ > @@ -16400,6 +16445,8 @@ process_structure_scope (struct die_info *die, struct dwarf2_cu *cu) > quirk_gcc_member_function_pointer (type, objfile); > if (cu->language == language_rust && die->tag == DW_TAG_union_type) > cu->rust_unions.push_back (type); > + else if (cu->language == language_ada) > + quirk_ada_thick_pointer_struct (die, cu, type); > > /* NOTE: carlton/2004-03-16: GCC 3.4 (or at least one of its > snapshots) has been known to create a die giving a declaration > @@ -16696,6 +16743,263 @@ process_enumeration_scope (struct die_info *die, struct dwarf2_cu *cu) > new_symbol (die, this_type, cu); > } > > +/* Helper function for quirk_ada_thick_pointer that examines a bounds > + expression for an index type and finds the corresponding field > + offset in the hidden "P_BOUNDS" structure. Returns true on success > + and updates *FIELD, false if it fails to recognize an > + expression. */ > + > +static bool > +recognize_bound_expression (struct die_info *die, enum dwarf_attribute name, > + int *bounds_offset, struct field *field, > + struct dwarf2_cu *cu) > +{ > + struct attribute *attr = dwarf2_attr (die, name, cu); > + if (attr == nullptr || !attr->form_is_block ()) > + return false; > + > + const struct dwarf_block *block = attr->as_block (); > + const gdb_byte *start = block->data; > + const gdb_byte *end = block->data + block->size; > + > + /* The expression to recognize generally looks like: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > + > + However, the second "plus_uconst" may be missing: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_deref_size: 4) > + > + This happens when the field is at the start of the structure. > + > + Also, the final deref may not be sized: > + > + (DW_OP_push_object_address; DW_OP_plus_uconst: 4; DW_OP_deref; > + DW_OP_deref) > + > + This happens when the size of the index type happens to be the > + same as the architecture's word size. This can occur with or > + without the second plus_uconst. */ > + > + if (end - start < 2) > + return false; > + if (*start++ != DW_OP_push_object_address) > + return false; > + if (*start++ != DW_OP_plus_uconst) > + return false; > + > + uint64_t this_bound_off; > + start = gdb_read_uleb128 (start, end, &this_bound_off); > + if (start == nullptr || (int) this_bound_off != this_bound_off) > + return false; > + /* Update *BOUNDS_OFFSET if needed, or alternatively verify that it > + is consistent among all bounds. */ > + if (*bounds_offset == -1) > + *bounds_offset = this_bound_off; > + else if (*bounds_offset != this_bound_off) > + return false; > + > + if (start == end || *start++ != DW_OP_deref) > + return false; > + > + int offset = 0; > + if (start ==end) > + return false; > + else if (*start == DW_OP_deref_size || *start == DW_OP_deref) > + { > + /* This means an offset of 0. */ > + } > + else if (*start++ != DW_OP_plus_uconst) > + return false; > + else > + { > + /* The size is the parameter to DW_OP_plus_uconst. */ > + uint64_t val; > + start = gdb_read_uleb128 (start, end, &val); > + if (start == nullptr) > + return false; > + if ((int) val != val) > + return false; > + offset = val; > + } > + > + if (start == end) > + return false; > + > + uint64_t size; > + if (*start == DW_OP_deref_size) > + { > + start = gdb_read_uleb128 (start + 1, end, &size); > + if (start == nullptr) > + return false; > + } > + else if (*start == DW_OP_deref) > + { > + size = cu->header.addr_size; > + ++start; > + } > + else > + return false; > + > + SET_FIELD_BITPOS (*field, 8 * offset); > + if (size != TYPE_LENGTH (field->type ())) > + FIELD_BITSIZE (*field) = 8 * size; > + > + return true; > +} > + > +/* With -fgnat-encodings=minimal, gcc will emit some unusual DWARF for > + some kinds of Ada arrays: > + > + <1><11db>: Abbrev Number: 7 (DW_TAG_array_type) > + <11dc> DW_AT_name : (indirect string, offset: 0x1bb8): string > + <11e0> DW_AT_data_location: 2 byte block: 97 6 > + (DW_OP_push_object_address; DW_OP_deref) > + <11e3> DW_AT_type : <0x1173> > + <11e7> DW_AT_sibling : <0x1201> > + <2><11eb>: Abbrev Number: 8 (DW_TAG_subrange_type) > + <11ec> DW_AT_type : <0x1206> > + <11f0> DW_AT_lower_bound : 6 byte block: 97 23 8 6 94 4 > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_deref_size: 4) > + <11f7> DW_AT_upper_bound : 8 byte block: 97 23 8 6 23 4 94 4 > + (DW_OP_push_object_address; DW_OP_plus_uconst: 8; DW_OP_deref; > + DW_OP_plus_uconst: 4; DW_OP_deref_size: 4) > + > + This actually represents a "thick pointer", which is a structure > + with two elements: one that is a pointer to the array data, and one > + that is a pointer to another structure; this second structure holds > + the array bounds. > + > + This returns a new type on success, or nullptr if this didn't > + recognize the type. */ > + > +static struct type * > +quirk_ada_thick_pointer (struct die_info *die, struct dwarf2_cu *cu, > + struct type *type) > +{ > + struct attribute *attr = dwarf2_attr (die, DW_AT_data_location, cu); > + /* So far we've only seen this with block form. */ > + if (attr == nullptr || !attr->form_is_block ()) > + return nullptr; > + > + /* Note that this will fail if the structure layout is changed by > + the compiler. However, we have no good way to recognize some > + other layout, because we don't know what expression the compiler > + might choose to emit should this happen. */ > + struct dwarf_block *blk = attr->as_block (); > + if (blk->size != 2 > + || blk->data[0] != DW_OP_push_object_address > + || blk->data[1] != DW_OP_deref) > + return nullptr; > + > + int bounds_offset = -1; > + int max_align = -1; > + std::vector<struct field> range_fields; > + for (struct die_info *child_die = die->child; > + child_die; > + child_die = child_die->sibling) > + { > + if (child_die->tag == DW_TAG_subrange_type) > + { > + struct type *underlying = read_subrange_index_type (child_die, cu); > + > + int this_align = type_align (underlying); > + if (this_align > max_align) > + max_align = this_align; > + > + range_fields.emplace_back (); > + range_fields.emplace_back (); > + > + struct field &lower = range_fields[range_fields.size () - 2]; > + struct field &upper = range_fields[range_fields.size () - 1]; > + > + lower.set_type (underlying); > + FIELD_ARTIFICIAL (lower) = 1; > + > + upper.set_type (underlying); > + FIELD_ARTIFICIAL (upper) = 1; > + > + if (!recognize_bound_expression (child_die, DW_AT_lower_bound, > + &bounds_offset, &lower, cu) > + || !recognize_bound_expression (child_die, DW_AT_upper_bound, > + &bounds_offset, &upper, cu)) > + return nullptr; > + } > + } > + > + /* This shouldn't really happen, but double-check that we found > + where the bounds are stored. */ > + if (bounds_offset == -1) > + return nullptr; > + > + struct objfile *objfile = cu->per_objfile->objfile; > + for (int i = 0; i < range_fields.size (); i += 2) > + { > + char name[20]; > + > + /* Set the name of each field in the bounds. */ > + xsnprintf (name, sizeof (name), "LB%d", i / 2); > + FIELD_NAME (range_fields[i]) = objfile->intern (name); > + xsnprintf (name, sizeof (name), "UB%d", i / 2); > + FIELD_NAME (range_fields[i + 1]) = objfile->intern (name); > + } > + > + struct type *bounds = alloc_type (objfile); > + bounds->set_code (TYPE_CODE_STRUCT); > + > + bounds->set_num_fields (range_fields.size ()); > + bounds->set_fields > + ((struct field *) TYPE_ALLOC (bounds, (bounds->num_fields () > + * sizeof (struct field)))); > + memcpy (bounds->fields (), range_fields.data (), > + bounds->num_fields () * sizeof (struct field)); > + > + int last_fieldno = range_fields.size () - 1; > + int bounds_size = (TYPE_FIELD_BITPOS (bounds, last_fieldno) / 8 > + + TYPE_LENGTH (bounds->field (last_fieldno).type ())); > + TYPE_LENGTH (bounds) = align_up (bounds_size, max_align); > + > + /* Rewrite the existing array type in place. Specifically, we > + remove any dynamic properties we might have read, and we replace > + the index types. */ > + struct type *iter = type; > + for (int i = 0; i < range_fields.size (); i += 2) > + { > + gdb_assert (iter->code () == TYPE_CODE_ARRAY); > + iter->main_type->dyn_prop_list = nullptr; > + iter->set_index_type > + (create_static_range_type (NULL, bounds->field (i).type (), 1, 0)); > + iter = TYPE_TARGET_TYPE (iter); > + } > + > + struct type *result = alloc_type (objfile); > + result->set_code (TYPE_CODE_STRUCT); > + > + result->set_num_fields (2); > + result->set_fields > + ((struct field *) TYPE_ZALLOC (result, (result->num_fields () > + * sizeof (struct field)))); > + > + /* The names are chosen to coincide with what the compiler does with > + -fgnat-encodings=all, which the Ada code in gdb already > + understands. */ > + TYPE_FIELD_NAME (result, 0) = "P_ARRAY"; > + result->field (0).set_type (lookup_pointer_type (type)); > + > + TYPE_FIELD_NAME (result, 1) = "P_BOUNDS"; > + result->field (1).set_type (lookup_pointer_type (bounds)); > + SET_FIELD_BITPOS (result->field (1), 8 * bounds_offset); > + > + result->set_name (type->name ()); > + TYPE_LENGTH (result) = (TYPE_LENGTH (result->field (0).type ()) > + + TYPE_LENGTH (result->field (1).type ())); > + > + return result; > +} > + > /* Extract all information from a DW_TAG_array_type DIE and put it in > the DIE's type field. For now, this only handles one dimensional > arrays. */ > @@ -16825,8 +17129,16 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu) > > maybe_set_alignment (cu, die, type); > > + struct type *replacement_type = nullptr; > + if (cu->language == language_ada) > + { > + replacement_type = quirk_ada_thick_pointer (die, cu, type); > + if (replacement_type != nullptr) > + type = replacement_type; > + } > + > /* Install the type in the die. */ > - set_die_type (die, type, cu); > + set_die_type (die, type, cu, replacement_type != nullptr); > > /* set_die_type should be already done. */ > set_descriptive_type (type, die, cu); > @@ -24400,7 +24712,8 @@ per_cu_offset_and_type_eq (const void *item_lhs, const void *item_rhs) > * Make the type as complete as possible before fetching more types. */ > > static struct type * > -set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > +set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu, > + bool skip_data_location) > { > dwarf2_per_objfile *per_objfile = cu->per_objfile; > struct dwarf2_per_cu_offset_and_type **slot, ofs; > @@ -24443,9 +24756,12 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) > } > > /* Read DW_AT_data_location and set in type. */ > - attr = dwarf2_attr (die, DW_AT_data_location, cu); > - if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) > - type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); > + if (!skip_data_location) > + { > + attr = dwarf2_attr (die, DW_AT_data_location, cu); > + if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) > + type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); > + } > > if (per_objfile->die_type_hash == NULL) > per_objfile->die_type_hash > diff --git a/gdb/testsuite/gdb.ada/O2_float_param.exp b/gdb/testsuite/gdb.ada/O2_float_param.exp > index 09ebeec4059..debc21c407d 100644 > --- a/gdb/testsuite/gdb.ada/O2_float_param.exp > +++ b/gdb/testsuite/gdb.ada/O2_float_param.exp > @@ -19,13 +19,19 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug \ > + optimize=-O2 \ > + additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -runto "increment" > + runto "increment" > > -gdb_test "frame" \ > - "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" > + gdb_test "frame" \ > + "#0\\s+callee\\.increment \\(val(=val@entry)?=99\\.0, msg=\\.\\.\\.\\).*" > +} > diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > index 9830ef732b6..f3fea4abbeb 100644 > --- a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp > @@ -19,14 +19,18 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" > -gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" > + gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" > + gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" > +} > diff --git a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > index f5936df46bb..b3a4c0d3d77 100644 > --- a/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > +++ b/gdb/testsuite/gdb.ada/arr_enum_idx_w_gap.exp > @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_q418_043 > > -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] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] > -if ![runto "foo_q418_043.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + clean_restart ${testfile} > > -gdb_test "print A" \ > - " = \\(42, 42\\)" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo_q418_043.adb] > + if ![runto "foo_q418_043.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > + > + gdb_test "print A" \ > + " = \\(42, 42\\)" > +} > diff --git a/gdb/testsuite/gdb.ada/array_of_variable_length.exp b/gdb/testsuite/gdb.ada/array_of_variable_length.exp > index 9eb67776299..af9cb6f9d0d 100644 > --- a/gdb/testsuite/gdb.ada/array_of_variable_length.exp > +++ b/gdb/testsuite/gdb.ada/array_of_variable_length.exp > @@ -19,28 +19,32 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > + > + # Pck.A is an array that embeds elements with variable size so compilers will > + # emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch > + # individual elements. Array stride is also a way to describe packed arrays: > + # make sure we do not consider Pck.A as a packed array. > + gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" > + > + # Make sure this also works with a type from a fully evaluated value. During > + # evaluation, dynamic types can be "resolved" so GDB internals could "forget" > + # that elements have variable size. Fortunately, type resolution of array > + # elements happens only when processing individual elements (i.e. the resolved > + # array type is still associated to the dynamic element type), so the following > + # is supposed to work. > + gdb_test "print pck.a" \ > + "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" > + gdb_test "ptype $"\ > + "array \\(1 \\.\\. 2\\) of pck\\.r_type" > } > - > -clean_restart ${testfile} > - > -set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > - > -# Pck.A is an array that embeds elements with variable size so compilers will > -# emit DWARF attributes such as DW_AT_byte_stride to tell GDB how to fetch > -# individual elements. Array stride is also a way to describe packed arrays: > -# make sure we do not consider Pck.A as a packed array. > -gdb_test "ptype pck.a" "array \\(1 \\.\\. 2\\) of pck\\.r_type" > - > -# Make sure this also works with a type from a fully evaluated value. During > -# evaluation, dynamic types can be "resolved" so GDB internals could "forget" > -# that elements have variable size. Fortunately, type resolution of array > -# elements happens only when processing individual elements (i.e. the resolved > -# array type is still associated to the dynamic element type), so the following > -# is supposed to work. > -gdb_test "print pck.a" \ > - "= \\(\\(l => 0, s => \"\"\\), \\(l => 2, s => \"ab\"\\)\\)" > -gdb_test "ptype $"\ > - "array \\(1 \\.\\. 2\\) of pck\\.r_type" > diff --git a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > index 4355508a2f5..81c1a390d23 100644 > --- a/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > +++ b/gdb/testsuite/gdb.ada/array_ptr_renaming.exp > @@ -19,23 +19,27 @@ 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_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print nt" " = \\(10, 20\\)" > -gdb_test "print nt(1)" " = 10" > + gdb_test "print nt" " = \\(10, 20\\)" > + gdb_test "print nt(1)" " = 10" > > -# Accesses to arrays and unconstrained arrays have the same runtime > -# representation with GNAT (fat pointers). In this case, GDB "forgets" that > -# it's dealing with an access and prints directly the array contents. This > -# should be fixed some day. > -setup_kfail "gdb/25883" *-*-* > -gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" > -gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" > -gdb_test "print ntp(3)" " = 30" > + # Accesses to arrays and unconstrained arrays have the same runtime > + # representation with GNAT (fat pointers). In this case, GDB "forgets" that > + # it's dealing with an access and prints directly the array contents. This > + # should be fixed some day. > + setup_kfail "gdb/25883" *-*-* > + gdb_test "print ntp" " = \\(access pack\\.table_type\\) $hex.*" > + gdb_test "print ntp.all" " = \\(3 => 30, 40\\)" > + gdb_test "print ntp(3)" " = 30" > +} > diff --git a/gdb/testsuite/gdb.ada/arrayparam.exp b/gdb/testsuite/gdb.ada/arrayparam.exp > index dc36499f33d..326c9d4aae8 100644 > --- a/gdb/testsuite/gdb.ada/arrayparam.exp > +++ b/gdb/testsuite/gdb.ada/arrayparam.exp > @@ -19,34 +19,40 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { > - return -1 > -} > +# Note we don't test the "none" (no -fgnat-encodings option) scenario > +# here, because "all" and "minimal" cover the cases, and this way we > +# don't have to update the test when gnat changes its default. > +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} > > -# Verify that a call to a function that takes an array as a parameter > -# works without problem. > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print call_me(\"bonjour\")" \ > - "= void" > + # Verify that a call to a function that takes an array as a parameter > + # works without problem. > > -# Verify that the array was passed properly by checking the global > -# variables that Call_Me sets as side-effects. Use the package name to avoid > -# name clash with debug info of system libraries. > + gdb_test "print call_me(\"bonjour\")" \ > + "= void" > > -gdb_test "print pck.first" \ > - "= 98 'b'" \ > - "print first after function call" > + # Verify that the array was passed properly by checking the global > + # variables that Call_Me sets as side-effects. Use the package name to avoid > + # name clash with debug info of system libraries. > > -gdb_test "print pck.last" \ > - "= 114 'r'" \ > - "print last after function call" > + gdb_test "print pck.first" \ > + "= 98 'b'" \ > + "print first after function call" > > -gdb_test "print pck.length" \ > - "= 7" \ > - "print length after function call" > + gdb_test "print pck.last" \ > + "= 114 'r'" \ > + "print last after function call" > > + gdb_test "print pck.length" \ > + "= 7" \ > + "print length after function call" > +} > diff --git a/gdb/testsuite/gdb.ada/arrayptr.exp b/gdb/testsuite/gdb.ada/arrayptr.exp > index 94a5d876bd2..fa84a7a2ff1 100644 > --- a/gdb/testsuite/gdb.ada/arrayptr.exp > +++ b/gdb/testsuite/gdb.ada/arrayptr.exp > @@ -19,36 +19,40 @@ 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_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > -if ![runto "foo.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + if ![runto "foo.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > > -gdb_test "print string_p" \ > - "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" > + gdb_test "print string_p" \ > + "= \\(foo\\.string_access\\) 0x\[0-9a-zA-Z\]+" > > -gdb_test "print string_p(3..4)" "= \"ll\"" > + gdb_test "print string_p(3..4)" "= \"ll\"" > > -gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" > + gdb_test "print null_string" "= \\(foo\\.string_access\\) 0x0" > > -gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" > + gdb_test "print arr_ptr" "= \\(access foo\\.little_array\\) 0x\[0-9a-zA-Z\]+" > > -gdb_test "print arr_ptr(2)" "= 22" > + gdb_test "print arr_ptr(2)" "= 22" > > -gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" > + gdb_test "print arr_ptr(3..4)" "= \\(3 => 23, 24\\)" > > -gdb_test "ptype string_access" "= access array \\(<>\\) of character" > + gdb_test "ptype string_access" "= access array \\(<>\\) of character" > > -gdb_test "print pa_ptr.all" \ > - " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" > + gdb_test "print pa_ptr.all" \ > + " = \\(10, 20, 30, 40, 50, 60, 62, 63, -23, 42\\)" > > -gdb_test "print pa_ptr(3)" " = 30" > + gdb_test "print pa_ptr(3)" " = 30" > > -gdb_test "print pa_ptr.all(3)" " = 30" > + gdb_test "print pa_ptr.all(3)" " = 30" > +} > diff --git a/gdb/testsuite/gdb.ada/big_packed_array.exp b/gdb/testsuite/gdb.ada/big_packed_array.exp > index fe49a1926d6..e24466b9cbe 100644 > --- a/gdb/testsuite/gdb.ada/big_packed_array.exp > +++ b/gdb/testsuite/gdb.ada/big_packed_array.exp > @@ -19,17 +19,21 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_ra24_010 > > -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] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] > -runto "foo_ra24_010.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_ra24_010.adb] > + runto "foo_ra24_010.adb:$bp_location" > > -gdb_test "print good" \ > - "= \\(false <repeats 196 times>\\)" \ > + gdb_test "print good" \ > + "= \\(false <repeats 196 times>\\)" \ > > -gdb_test "print bad" \ > - "= \\(false <repeats 196 times>\\)" \ > + gdb_test "print bad" \ > + "= \\(false <repeats 196 times>\\)" > +} > diff --git a/gdb/testsuite/gdb.ada/frame_arg_lang.exp b/gdb/testsuite/gdb.ada/frame_arg_lang.exp > index 9662e359524..9668f0e7d9e 100644 > --- a/gdb/testsuite/gdb.ada/frame_arg_lang.exp > +++ b/gdb/testsuite/gdb.ada/frame_arg_lang.exp > @@ -69,14 +69,8 @@ foreach_with_prefix scenario {all minimal} { > "The current source language is \"c\"." \ > "show language when set to 'c'" > > - # With -fgnat-encodings=minimal, this works properly in C as well. > - if {$scenario == "minimal"} { > - set expected "\"test\"" > - } else { > - set expected "{P_ARRAY = $hex, P_BOUNDS = $hex}" > - } > gdb_test "bt" \ > - "#1 $hex in pck\\.call_me \\(s=$expected\\).*" \ > + "#1 $hex in pck\\.call_me \\(s={P_ARRAY = $hex, P_BOUNDS = $hex}\\).*" \ > "backtrace with language forced to 'c'" > > gdb_test_no_output "set language auto" \ > diff --git a/gdb/testsuite/gdb.ada/mi_string_access.exp b/gdb/testsuite/gdb.ada/mi_string_access.exp > index 5e07f1ebcc0..0b5ab2dfd04 100644 > --- a/gdb/testsuite/gdb.ada/mi_string_access.exp > +++ b/gdb/testsuite/gdb.ada/mi_string_access.exp > @@ -19,48 +19,52 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile bar > > -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] > > -load_lib mi-support.exp > -set MIFLAGS "-i=mi" > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -gdb_exit > -if [mi_gdb_start] { > - continue > -} > + load_lib mi-support.exp > + set MIFLAGS "-i=mi" > > -mi_delete_breakpoints > -mi_gdb_reinitialize_dir $srcdir/$subdir > -mi_gdb_load ${binfile} > + gdb_exit > + if [mi_gdb_start] { > + continue > + } > > -if ![mi_run_to_main] then { > - fail "cannot run to main, testcase aborted" > - return 0 > -} > + mi_delete_breakpoints > + mi_gdb_reinitialize_dir $srcdir/$subdir > + mi_gdb_load ${binfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] > -mi_continue_to_line \ > - "bar.adb:$bp_location" \ > - "stop at start of main Ada procedure" > + if ![mi_run_to_main] then { > + fail "cannot run to main, testcase aborted" > + return 0 > + } > > -mi_gdb_test "-var-create var1 * Aos" \ > - "\\^done,name=\"var1\",numchild=\"2\",.*" \ > - "Create var1 varobj" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] > + mi_continue_to_line \ > + "bar.adb:$bp_location" \ > + "stop at start of main Ada procedure" > > -mi_gdb_test "-var-list-children 1 var1" \ > - "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ > - "list var1's children" > + mi_gdb_test "-var-create var1 * Aos" \ > + "\\^done,name=\"var1\",numchild=\"2\",.*" \ > + "Create var1 varobj" > > -mi_gdb_test "-var-evaluate-expression var1" \ > - "\\^done,value=\"\\\[2\\\]\"" \ > - "Print var1" > + mi_gdb_test "-var-list-children 1 var1" \ > + "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ > + "list var1's children" > > -mi_gdb_test "-var-evaluate-expression var1.1" \ > - "\\^done,value=\"$hex\"" \ > - "Print var1 first child" > + mi_gdb_test "-var-evaluate-expression var1" \ > + "\\^done,value=\"\\\[2\\\]\"" \ > + "Print var1" > > -mi_gdb_test "-var-evaluate-expression var1.2" \ > - "\\^done,value=\"$hex\"" \ > - "Print var1 second child" > + mi_gdb_test "-var-evaluate-expression var1.1" \ > + "\\^done,value=\"$hex\"" \ > + "Print var1 first child" > + > + mi_gdb_test "-var-evaluate-expression var1.2" \ > + "\\^done,value=\"$hex\"" \ > + "Print var1 second child" > +} > diff --git a/gdb/testsuite/gdb.ada/mod_from_name.exp b/gdb/testsuite/gdb.ada/mod_from_name.exp > index dce0f3ac3a6..fec383bb490 100644 > --- a/gdb/testsuite/gdb.ada/mod_from_name.exp > +++ b/gdb/testsuite/gdb.ada/mod_from_name.exp > @@ -19,17 +19,25 @@ 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_location [gdb_get_line_number "START" ${testdir}/foo.adb] > -if ![runto "foo.adb:$bp_location" ] then { > - perror "Couldn't run ${testfile}" > - return > -} > + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > + if ![runto "foo.adb:$bp_location" ] then { > + perror "Couldn't run ${testfile}" > + return > + } > > -gdb_test "print xp" \ > - "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + gdb_test "print xp" \ > + "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" > +} > diff --git a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > index 684a3699245..7ffb7cb7797 100644 > --- a/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > +++ b/gdb/testsuite/gdb.ada/out_of_line_in_inlined.exp > @@ -19,21 +19,27 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile foo_o224_021 > > -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug optimize=-O2}] != ""} { > - return -1 > -} > +foreach_with_prefix scenario {all minimal} { > + set flags [list debug \ > + optimize=-O2 \ > + additional_flags=-fgnat-encodings=$scenario] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -gdb_test "break foo_o224_021.child1.child2" \ > - "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." > + gdb_test "break foo_o224_021.child1.child2" \ > + "Breakpoint \[0-9\]+ at.*: file .*foo_o224_021.adb, line \[0-9\]+." > > -gdb_run_cmd > -gdb_test "" \ > - "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" > + gdb_run_cmd > + gdb_test "" \ > + "Breakpoint $decimal, foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" > > -set opt_addr_in "($hex in)?" > -gdb_test "bt" \ > - [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ > - "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ > - "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] > + set opt_addr_in "($hex in)?" > + gdb_test "bt" \ > + [multi_line "#0 +$opt_addr_in +foo_o224_021\\.child1\\.child2 \\(s=\\.\\.\\.\\).*" \ > + "#1 +$opt_addr_in +foo_o224_021\\.child1 \\(\\).*" \ > + "#2 +$opt_addr_in +foo_o224_021 \\(\\).*" ] > +} > diff --git a/gdb/testsuite/gdb.ada/packed_array.exp b/gdb/testsuite/gdb.ada/packed_array.exp > index 0928b1b3646..96613183f69 100644 > --- a/gdb/testsuite/gdb.ada/packed_array.exp > +++ b/gdb/testsuite/gdb.ada/packed_array.exp > @@ -19,39 +19,42 @@ if { [skip_ada_tests] } { return -1 } > > standard_ada_testfile pa > > -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}/pa.adb] > -runto "pa.adb:$bp_location" > + clean_restart ${testfile} > > -gdb_test "print var" \ > - "= \\(4 => true, false, true, false, true\\)" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/pa.adb] > + runto "pa.adb:$bp_location" > > -# Try printing the value and the type definition of a reference > -# to variable "Var". > + gdb_test "print var" \ > + "= \\(4 => true, false, true, false, true\\)" > > -gdb_test "ptype &var" \ > - "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>" > + # Try printing the value and the type definition of a reference > + # to variable "Var". > > -gdb_test "print &var" \ > - "= \\(access pa.packed_array\\) 0x.*" > + gdb_test "ptype &var" \ > + "type = access array \\(4 \\.\\. 8\\) of boolean <packed: 1-bit elements>" > > -# Print the value of U_Var, an unconstrainted packed array. > + gdb_test "print &var" \ > + "= \\(access pa.packed_array\\) 0x.*" > > -set test "print u_var" > -gdb_test_multiple "$test" "$test" { > - -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { > - # The compiler forgot to emit the packed array's ___XA type, > - # preventing us from determining the what the array bounds > - # are. Observed with (FSF GNU Ada 4.5.3 20110124). > - xfail $test > + # Print the value of U_Var, an unconstrainted packed array. > + > + set test "print u_var" > + gdb_test_multiple "$test" "$test" { > + -re "= \\(true, false, false, true, true, false\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(warning: unable to get bounds of array.*\\)\[\r\n\]+$gdb_prompt $" { > + # The compiler forgot to emit the packed array's ___XA type, > + # preventing us from determining the what the array bounds > + # are. Observed with (FSF GNU Ada 4.5.3 20110124). > + xfail $test > + } > } > } > - > diff --git a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > index d41de442b5d..13e599b6a58 100644 > --- a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > +++ b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp > @@ -19,15 +19,23 @@ 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] > + > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -clean_restart ${testfile} > + clean_restart ${testfile} > > -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -gdb_test "print A2" \ > - "= (<ref>\\s*)?\\(false, false\\)" \ > - "print var" > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + gdb_test "print A2" \ > + "= (<ref>\\s*)?\\(false, false\\)" \ > + "print var" > +} > diff --git a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > index f7f3485161d..a7fd4655d48 100644 > --- a/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > +++ b/gdb/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp > @@ -19,68 +19,72 @@ 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_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + set bp_location [gdb_get_line_number "STOP1" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > > -# Print My_Object and My_Object.Ptr when Ptr is null... > + # Print My_Object and My_Object.Ptr when Ptr is null... > > -gdb_test "print my_object" \ > - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > - "print My_Object with null Ptr" > + gdb_test "print my_object" \ > + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > + "print My_Object with null Ptr" > > -gdb_test "print my_object.ptr" \ > - "= \\(foo.table_access\\) 0x0" \ > - "print My_Object.Ptr when null" > + gdb_test "print my_object.ptr" \ > + "= \\(foo.table_access\\) 0x0" \ > + "print My_Object.Ptr when null" > > -# Same for My_P_Object... > + # Same for My_P_Object... > > -gdb_test "print my_p_object" \ > - "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > - "print My_P_Object with null Ptr" > + gdb_test "print my_p_object" \ > + "= \\(n => 3, ptr => 0x0, data => \\(3, 5, 8\\)\\)" \ > + "print My_P_Object with null Ptr" > > -gdb_test "print my_p_object.ptr" \ > - "\\(foo.p_table_access\\) 0x0" \ > - "print My_P_Object.Ptr when null" > + gdb_test "print my_p_object.ptr" \ > + "\\(foo.p_table_access\\) 0x0" \ > + "print My_P_Object.Ptr when null" > > -# Continue until the Ptr component of both objects get allocated. > + # Continue until the Ptr component of both objects get allocated. > > -set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] > + set bp_location [gdb_get_line_number "STOP2" ${testdir}/foo.adb] > > -gdb_breakpoint "foo.adb:$bp_location" > + gdb_breakpoint "foo.adb:$bp_location" > > -gdb_test "continue" \ > - "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ > - "continue to STOP2" > + gdb_test "continue" \ > + "Breakpoint $decimal, foo \\(\\) at .*foo.adb:$decimal.*" \ > + "continue to STOP2" > > -# Inspect My_Object again... > + # Inspect My_Object again... > > -gdb_test "print my_object" \ > - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > - "print my_object after setting Ptr" > + gdb_test "print my_object" \ > + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > + "print my_object after setting Ptr" > > -gdb_test "print my_object.ptr" \ > - "\\(foo.table_access\\) $hex" \ > - "print my_object.ptr when no longer null" > + gdb_test "print my_object.ptr" \ > + "\\(foo.table_access\\) $hex" \ > + "print my_object.ptr when no longer null" > > -gdb_test "print my_object.ptr.all" \ > - "= \\(13, 21, 34\\)" > + gdb_test "print my_object.ptr.all" \ > + "= \\(13, 21, 34\\)" > > -# Same with My_P_Object... > + # Same with My_P_Object... > > -gdb_test "print my_p_object" \ > - "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > - "print my_p_object after setting Ptr" > + gdb_test "print my_p_object" \ > + "= \\(n => 3, ptr => $hex, data => \\(3, 5, 8\\)\\)" \ > + "print my_p_object after setting Ptr" > > -gdb_test "print my_p_object.ptr" \ > - "= \\(foo.p_table_access\\) $hex" \ > - "print My_P_Object.Ptr when no longer null" > + gdb_test "print my_p_object.ptr" \ > + "= \\(foo.p_table_access\\) $hex" \ > + "print My_P_Object.Ptr when no longer null" > > -gdb_test "print my_p_object.ptr.all" \ > - "\\(13, 21, 34\\)" > + gdb_test "print my_p_object.ptr.all" \ > + "\\(13, 21, 34\\)" > > +} > diff --git a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > index e10c62b7bbf..7f10d3dfc06 100644 > --- a/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > +++ b/gdb/testsuite/gdb.ada/variant_record_packed_array.exp > @@ -19,35 +19,53 @@ 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] > > -clean_restart ${testfile} > + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { > + return -1 > + } > > -set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > -runto "foo.adb:$bp_location" > + clean_restart ${testfile} > > -set test "print my_buffer" > -gdb_test_multiple "$test" $test { > - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > + set bp_location [gdb_get_line_number "START" ${testdir}/foo.adb] > + runto "foo.adb:$bp_location" > + > + set test "print my_buffer" > + gdb_test_multiple "$test" $test { > + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + fail $test > + } > } > -} > > -gdb_test "print my_buffer'Address" \ > - "= \\(system\\.address\\) $hex" \ > - "print address" > + gdb_test "print my_buffer'Address" \ > + "= \\(system\\.address\\) $hex" \ > + "print address" > > -set test "print {foo.octal_buffer}($)" > -gdb_test_multiple "$test" $test { > - -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > - } > - -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > - pass $test > + set test "print {foo.octal_buffer}($)" > + gdb_test_multiple "$test" $test { > + -re "= \\(size => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\), length => 8\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re "= \\(size => 8, length => 8, buffer => \\(1, 2, 3, 4, 5, 6, 7, 0\\)\\)\[\r\n\]+$gdb_prompt $" { > + pass $test > + } > + -re " = \\(size => 8, length => 8, buffer => warning: could not find bounds information on packed array.*$gdb_prompt $" { > + # GNAT >= 11.0 has the needed fix here. > + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { > + setup_kfail "minimal encodings" *-*-* > + } > + fail $test > + } > } > } > ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal 2020-11-06 12:08 ` Luis Machado @ 2020-11-06 17:55 ` Tom Tromey 0 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-11-06 17:55 UTC (permalink / raw) To: Luis Machado; +Cc: Tom Tromey, gdb-patches Luis> FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three Luis> FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef [...] Thanks. Tom de Vries also noticed this. I will look into this soon, either today if there is time, or next week. Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 4/9] Reject slicing a packed array 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (2 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 5/9] Resolve dynamic type in ada_value_struct_elt Tom Tromey ` (5 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey In Ada mode, gdb rejects slicing a packed array. However, with -fgnat-encodings=minimal, gdb will instead print incorrect results. This patch changes gdb to also reject slicing a packed array in this mode. FWIW I believe that this rejection is a gdb limitation. Removing it looked complicated, though, and meanwhile my main goal for the time being is to bring the DWARF encodings up to par with Gnat encodings. 2020-09-30 Tom Tromey <tromey@adacore.com> * ada-lang.c (ada_is_any_packed_array_type): New function. (ada_evaluate_subexp) <case TERNOP_SLICE>: Use it. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/mod_from_name.exp: Test printing slice. --- gdb/ChangeLog | 5 +++++ gdb/ada-lang.c | 13 ++++++++++++- gdb/testsuite/ChangeLog | 4 ++++ gdb/testsuite/gdb.ada/mod_from_name.exp | 1 + 4 files changed, 22 insertions(+), 1 deletion(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index c7eabbef2ae..d851f57414b 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -2030,6 +2030,17 @@ ada_is_unconstrained_packed_array_type (struct type *type) return 0; } +/* Return true if TYPE is a (Gnat-encoded) constrained packed array + type, or if it is an ordinary (non-Gnat-encoded) packed array. */ + +static bool +ada_is_any_packed_array_type (struct type *type) +{ + return (ada_is_constrained_packed_array_type (type) + || (type->code () == TYPE_CODE_ARRAY + && TYPE_FIELD_BITSIZE (type, 0) % 8 != 0)); +} + /* Given that TYPE encodes a packed array type (constrained or unconstrained), return the size of its elements in bits. */ @@ -10626,7 +10637,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, TYPE_TARGET_TYPE (value_type (array)) = ada_aligned_type (TYPE_TARGET_TYPE (value_type (array))); - if (ada_is_constrained_packed_array_type (value_type (array))) + if (ada_is_any_packed_array_type (value_type (array))) error (_("cannot slice a packed array")); /* If this is a reference to an array or an array lvalue, diff --git a/gdb/testsuite/gdb.ada/mod_from_name.exp b/gdb/testsuite/gdb.ada/mod_from_name.exp index fec383bb490..43d81e0026f 100644 --- a/gdb/testsuite/gdb.ada/mod_from_name.exp +++ b/gdb/testsuite/gdb.ada/mod_from_name.exp @@ -40,4 +40,5 @@ foreach_with_prefix scenario {all minimal} { } gdb_test "print xp" \ "= \\(y => \\(-1, -2, -3, -4, -5, -6, -7, -8, -9, -10\\)\\)" + gdb_test "print slice" "cannot slice a packed array" } -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 5/9] Resolve dynamic type in ada_value_struct_elt 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (3 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 4/9] Reject slicing a packed array Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 6/9] Fix bit strides for -fgnat-encodings=minimal Tom Tromey ` (4 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey 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. 2020-09-30 Tom Tromey <tromey@adacore.com> * ada-lang.c (ada_value_struct_elt): Resolve dynamic type. gdb/testsuite/ChangeLog 2020-09-30 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. --- gdb/ChangeLog | 4 +++ gdb/ada-lang.c | 4 +++ gdb/testsuite/ChangeLog | 11 ++++++ gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp | 35 ++++++++++++------- .../gdb.ada/set_pckd_arr_elt/foo.adb | 2 ++ .../gdb.ada/set_pckd_arr_elt/pck.adb | 7 ++++ .../gdb.ada/set_pckd_arr_elt/pck.ads | 14 ++++++++ 7 files changed, 64 insertions(+), 13 deletions(-) diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index d851f57414b..e81a7877ccb 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -4414,6 +4414,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)) diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp index bf28b9113e4..adaee7d592d 100644 --- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt.exp @@ -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] + + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -clean_restart ${testfile} + clean_restart ${testfile} -set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] -runto "foo.adb:$bp_location" + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print sa(3) := 9" " = 9" + gdb_test "print sa(3) := 9" " = 9" + gdb_test "print va.t(1) := 15" " = 15" -# 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. + # 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_breakpoint "update_small" + gdb_breakpoint "update_small" -gdb_test "continue" \ + 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" +} diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb index da826a6e0ae..04b444ada95 100644 --- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/foo.adb @@ -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; diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb index 0cebce3430b..d19ed2ed20a 100644 --- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.adb @@ -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; diff --git a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads index fe8b6022702..d04809d9d0a 100644 --- a/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads +++ b/gdb/testsuite/gdb.ada/set_pckd_arr_elt/pck.ads @@ -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; -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 6/9] Fix bit strides for -fgnat-encodings=minimal 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (4 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 5/9] Resolve dynamic type in ada_value_struct_elt Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 7/9] Only use stride for final element type Tom Tromey ` (3 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey With -fgnat-encodings=minimal, the enum_idx_packed.exp test will fail. In this test case, we have an array (with dynamic length) of arrays, and the inner array has a bit stride. In this situation, the outer array's bit stride must be updated to account for the entire bit length of the inner array. Here, again, some tests must be kfail'd when an older version of GNAT is in use. gdb/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdbtypes.c (update_static_array_size): Handle bit stride. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/enum_idx_packed.exp: Test two forms of -fgnat-encodings. --- gdb/ChangeLog | 4 + gdb/gdbtypes.c | 14 +++ gdb/testsuite/ChangeLog | 4 + gdb/testsuite/gdb.ada/enum_idx_packed.exp | 121 ++++++++++++++-------- 4 files changed, 102 insertions(+), 41 deletions(-) diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 43c05d344d0..872a23ea497 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1235,6 +1235,20 @@ update_static_array_size (struct type *type) TYPE_LENGTH (type) = TYPE_LENGTH (element_type) * (high_bound - low_bound + 1); + /* If this array's element is itself an array with a bit stride, + then we want to update this array's bit stride to reflect the + size of the sub-array. Otherwise, we'll end up using the + wrong size when trying to find elements of the outer + array. */ + if (element_type->code () == TYPE_CODE_ARRAY + && TYPE_LENGTH (element_type) != 0 + && TYPE_FIELD_BITSIZE (element_type, 0) != 0 + && get_array_bounds (element_type, &low_bound, &high_bound) >= 0 + && high_bound >= low_bound) + TYPE_FIELD_BITSIZE (type, 0) + = ((high_bound - low_bound + 1) + * TYPE_FIELD_BITSIZE (element_type, 0)); + return true; } diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed.exp b/gdb/testsuite/gdb.ada/enum_idx_packed.exp index 480de71b7c4..91859689c4a 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed.exp +++ b/gdb/testsuite/gdb.ada/enum_idx_packed.exp @@ -19,64 +19,103 @@ 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 "ptype full" \ - "type = array \\(black \\.\\. white\\) of boolean <packed: 1-bit elements>" + # GNAT >= 11.0 has the needed fix here. + if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + set old_compiler 1 + } else { + set old_compiler 0 + } -gdb_test "print full" " = \\(false, true, false, true, false\\)" + set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] + runto "foo.adb:$bp_location" -gdb_test "print full'first" " = black" + gdb_test "ptype full" \ + "type = array \\(black \\.\\. white\\) of boolean <packed: 1-bit elements>" -gdb_test "ptype primary" \ - "type = array \\(red \\.\\. blue\\) of boolean <packed: 1-bit elements>" + gdb_test "print full" " = \\(false, true, false, true, false\\)" -gdb_test "print primary" " = \\(red => false, true, false\\)" + gdb_test "print full'first" " = black" -gdb_test "print primary'first" " = red" + gdb_test "ptype primary" \ + "type = array \\(red \\.\\. blue\\) of boolean <packed: 1-bit elements>" -gdb_test "ptype cold" \ - "type = array \\(green \\.\\. blue\\) of boolean <packed: 1-bit elements>" + gdb_test "print primary" " = \\(red => false, true, false\\)" -gdb_test "print cold" " = \\(green => false, true\\)" + gdb_test "print primary'first" " = red" -gdb_test "print cold'first" " = green" + gdb_test "ptype cold" \ + "type = array \\(green \\.\\. blue\\) of boolean <packed: 1-bit elements>" -# Note the bounds values are still not correctly displayed. So we get -# the enum equivalent of "1 .. 0" (empty range) as the array ranges. -# Accept that for now. -gdb_test "ptype small" \ - "array \\(red \\.\\. green\\) of boolean <packed: 1-bit elements>" + gdb_test "print cold" " = \\(green => false, true\\)" -gdb_test "print small" " = \\(red => false, true\\)" + gdb_test "print cold'first" " = green" -gdb_test "print small'first" " = red" + # Note the bounds values are still not correctly displayed. So we get + # the enum equivalent of "1 .. 0" (empty range) as the array ranges. + # Accept that for now. + # GNAT >= 11.0 has the needed fix here. + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "ptype small" \ + "array \\(red \\.\\. green\\) of boolean <packed: 1-bit elements>" -gdb_test "ptype multi" \ - "array \\(red \\.\\. green, low .. medium\\) of boolean <packed: 1-bit elements>" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print small" " = \\(red => false, true\\)" -gdb_test "print multi" \ - " = \\(red => \\(low => true, false\\), \\(low => true, false\\)\\)" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print small'first" " = red" -gdb_test "print multi'first" " = red" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "ptype multi" \ + "array \\(red \\.\\. green, low .. medium\\) of boolean <packed: 1-bit elements>" -set base "\\(true, false, true, false, true, false, true, false, true, false\\)" -set matrix "\\(" -foreach x {1 2 3 4 5 6 7} { - if {$x > 1} { - append matrix ", " + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* } - append matrix $base -} -append matrix "\\)" + gdb_test "print multi" \ + " = \\(red => \\(low => true, false\\), \\(low => true, false\\)\\)" -gdb_test "print multi_multi" " = \\($matrix, $matrix\\)" -gdb_test "print multi_multi(1,3)" " = $base" -gdb_test "print multi_multi(2)" " = $matrix" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print multi'first" " = red" + + set base "\\(true, false, true, false, true, false, true, false, true, false\\)" + set matrix "\\(" + foreach x {1 2 3 4 5 6 7} { + if {$x > 1} { + append matrix ", " + } + append matrix $base + } + append matrix "\\)" + + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print multi_multi" " = \\($matrix, $matrix\\)" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print multi_multi(1,3)" " = $base" + if {$old_compiler} { + setup_kfail "minimal encodings" *-*-* + } + gdb_test "print multi_multi(2)" " = $matrix" +} -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 7/9] Only use stride for final element type 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (5 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 6/9] Fix bit strides for -fgnat-encodings=minimal Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 8/9] Use bit stride when taking slice of array Tom Tromey ` (2 subsequent siblings) 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey A DWARF array type may specify a stride. Currently, the DWARF reader applies this stride to every dimension of an array. However, this seems incorrect to me -- only the innermost array ought to use the stride, while outer arrays should compute a stride based on the size of the inner arrays. This patch arranges to apply the stride only to the innermost array type. This fixes a bug noticed when running some Ada tests with -fgnat-encodings=minimal. 2020-09-30 Tom Tromey <tromey@adacore.com> * dwarf2/read.c (read_array_type): Only apply stride to innermost array. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/enum_idx_packed.exp: Add test. * gdb.ada/enum_idx_packed/foo.adb (Multi_Access): New variable. * gdb.ada/enum_idx_packed/pck.ads (Short) (Multi_Dimension, Multi_Dimension_Access): New types. --- gdb/ChangeLog | 5 +++++ gdb/dwarf2/read.c | 16 ++++++++++++---- gdb/testsuite/ChangeLog | 8 ++++++++ gdb/testsuite/gdb.ada/enum_idx_packed.exp | 3 +++ gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb | 5 +++++ gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads | 5 +++++ 6 files changed, 38 insertions(+), 4 deletions(-) diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c index e3e68fc1f29..9a94c5b349f 100644 --- a/gdb/dwarf2/read.c +++ b/gdb/dwarf2/read.c @@ -17089,15 +17089,23 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu) int i = 0; while (i < range_types.size ()) - type = create_array_type_with_stride (NULL, type, range_types[i++], - byte_stride_prop, bit_stride); + { + type = create_array_type_with_stride (NULL, type, range_types[i++], + byte_stride_prop, bit_stride); + bit_stride = 0; + byte_stride_prop = nullptr; + } } else { size_t ndim = range_types.size (); while (ndim-- > 0) - type = create_array_type_with_stride (NULL, type, range_types[ndim], - byte_stride_prop, bit_stride); + { + type = create_array_type_with_stride (NULL, type, range_types[ndim], + byte_stride_prop, bit_stride); + bit_stride = 0; + byte_stride_prop = nullptr; + } } /* Understand Dwarf2 support for vector types (like they occur on diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed.exp b/gdb/testsuite/gdb.ada/enum_idx_packed.exp index 91859689c4a..2e5a85e76b3 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed.exp +++ b/gdb/testsuite/gdb.ada/enum_idx_packed.exp @@ -118,4 +118,7 @@ foreach_with_prefix scenario {all minimal} { setup_kfail "minimal encodings" *-*-* } gdb_test "print multi_multi(2)" " = $matrix" + + gdb_test "print multi_access.all" \ + " = \\(\\(8, 13, 21, 34, 55\\), \\(1, 1, 2, 3, 5\\)\\)" } diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb index e9f30747167..bc82831bb84 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/foo.adb @@ -22,6 +22,10 @@ procedure Foo is Small : Small_Table := New_Small_Table (Low => Red, High => Green); Multi : Multi_Table := New_Multi_Table (Red, Green, Low, Medium); Multi_Multi : Multi_Multi_Table := New_Multi_Multi_Table (1, 2, 1, 7, 1, 10); + Multi_Access : Multi_Dimension_Access + := new Multi_Dimension'(True => (1, 1, 2, 3, 5), + False => (8, 13, 21, 34, 55)); + begin Do_Nothing (Full'Address); -- STOP Do_Nothing (Primary'Address); @@ -29,4 +33,5 @@ begin Do_Nothing (Small'Address); Do_Nothing (Multi'Address); Do_Nothing (Multi_Multi'Address); + Do_Nothing (Multi_Access'Address); end Foo; diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads index fdfd8bbc4c6..7fe5a9e01d4 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads +++ b/gdb/testsuite/gdb.ada/enum_idx_packed/pck.ads @@ -17,6 +17,7 @@ with System; package Pck is type Color is (Black, Red, Green, Blue, White); type Strength is (None, Low, Medium, High); + type Short is new Natural range 0 .. 2 ** 8 - 1; type Full_Table is array (Color) of Boolean; pragma Pack (Full_Table); @@ -43,5 +44,9 @@ package Pck is function New_Multi_Multi_Table (L1, H1, L2, H2, L3, H3: Positive) return Multi_Multi_Table; + type Multi_Dimension is array (Boolean, Color) of Short; + pragma Pack (Multi_Dimension); + type Multi_Dimension_Access is access all Multi_Dimension; + procedure Do_Nothing (A : System.Address); end Pck; -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 8/9] Use bit stride when taking slice of array 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (6 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 7/9] Only use stride for final element type Tom Tromey @ 2020-09-30 20:05 ` Tom Tromey 2020-09-30 20:06 ` [PATCH 9/9] Recognize names of array types Tom Tromey 2020-11-04 15:49 ` [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:05 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey Testing with -fgnat-encodings=minimal showed that the Ada code failed to use the bit stride of an array when taking a slice. This patch fixes the oversight. 2020-09-30 Tom Tromey <tromey@adacore.com> * ada-lang.c (ada_value_slice_from_ptr): Use bit size. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/array_of_variant.exp: New file. * gdb.ada/array_of_variant/p.adb: New file. * gdb.ada/array_of_variant/pck.ads: New file. * gdb.ada/array_of_variant/pck.adb: New file. --- gdb/ChangeLog | 4 ++ gdb/ada-lang.c | 8 +-- gdb/testsuite/ChangeLog | 7 +++ gdb/testsuite/gdb.ada/array_of_variant.exp | 52 +++++++++++++++++++ gdb/testsuite/gdb.ada/array_of_variant/p.adb | 39 ++++++++++++++ .../gdb.ada/array_of_variant/pck.adb | 23 ++++++++ .../gdb.ada/array_of_variant/pck.ads | 23 ++++++++ 7 files changed, 153 insertions(+), 3 deletions(-) create mode 100644 gdb/testsuite/gdb.ada/array_of_variant.exp create mode 100644 gdb/testsuite/gdb.ada/array_of_variant/p.adb create mode 100644 gdb/testsuite/gdb.ada/array_of_variant/pck.adb create mode 100644 gdb/testsuite/gdb.ada/array_of_variant/pck.ads diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index e81a7877ccb..b06bb68df20 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -2846,9 +2846,11 @@ ada_value_slice_from_ptr (struct value *array_ptr, struct type *type, base_low_pos = base_low; } - base = value_as_address (array_ptr) - + ((low_pos - base_low_pos) - * TYPE_LENGTH (TYPE_TARGET_TYPE (type0))); + ULONGEST stride = TYPE_FIELD_BITSIZE (slice_type, 0) / 8; + if (stride == 0) + stride = TYPE_LENGTH (TYPE_TARGET_TYPE (type0)); + + base = value_as_address (array_ptr) + (low_pos - base_low_pos) * stride; return value_at_lazy (slice_type, base); } diff --git a/gdb/testsuite/gdb.ada/array_of_variant.exp b/gdb/testsuite/gdb.ada/array_of_variant.exp new file mode 100644 index 00000000000..f2c343fdab0 --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_of_variant.exp @@ -0,0 +1,52 @@ +# Copyright 2020 Free Software Foundation, Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +load_lib "ada.exp" + +if { [skip_ada_tests] } { return -1 } + +standard_ada_testfile p + +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_location [gdb_get_line_number "START" ${testdir}/p.adb] + runto "p.adb:$bp_location" + + set v1 "(tag => object, values => (2, 2, 2, 2, 2))" + set v2 "(tag => unused)" + + gdb_test "print objects" \ + [string_to_regexp " = ($v1, $v2)"] \ + "print entire array" + gdb_test "print objects(1)" \ + [string_to_regexp " = $v1"] \ + "print first array element" + gdb_test "print objects(1 .. 1)" \ + [string_to_regexp " = ($v1)"] \ + "print first array slice" + gdb_test "print objects(2)" \ + [string_to_regexp " = $v2"] \ + "print second array element" + gdb_test "print objects(2 .. 2)" \ + [string_to_regexp " = (2 => $v2)"] \ + "print second array slice" +} diff --git a/gdb/testsuite/gdb.ada/array_of_variant/p.adb b/gdb/testsuite/gdb.ada/array_of_variant/p.adb new file mode 100644 index 00000000000..d9974ef43bf --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_of_variant/p.adb @@ -0,0 +1,39 @@ +-- Copyright 2020 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +with Pck; use Pck; + +procedure P is + + type Tag_T is (Unused, Object); + + type Array_T is array (1 .. Five) of Integer; + + type Payload_T (Tag : Tag_T := Unused) is + record + case Tag is + when Object => + Values : Array_T := (others => 1); + when Unused => + null; + end case; + end record; + + Objects : array (1 .. 2) of Payload_T; + +begin + Objects (1) := (Tag => Object, Values => (others => 2)); + Do_Nothing (Objects'Address); -- START +end P; diff --git a/gdb/testsuite/gdb.ada/array_of_variant/pck.adb b/gdb/testsuite/gdb.ada/array_of_variant/pck.adb new file mode 100644 index 00000000000..af4fe6d6aa7 --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_of_variant/pck.adb @@ -0,0 +1,23 @@ +-- Copyright 2020 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +package body Pck is + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; + +end Pck; diff --git a/gdb/testsuite/gdb.ada/array_of_variant/pck.ads b/gdb/testsuite/gdb.ada/array_of_variant/pck.ads new file mode 100644 index 00000000000..f2a676ca205 --- /dev/null +++ b/gdb/testsuite/gdb.ada/array_of_variant/pck.ads @@ -0,0 +1,23 @@ +-- Copyright 2020 Free Software Foundation, Inc. +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +with System; + +package Pck is + Five : Integer := 5; + + procedure Do_Nothing (A : System.Address); + +end Pck; -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH 9/9] Recognize names of array types 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (7 preceding siblings ...) 2020-09-30 20:05 ` [PATCH 8/9] Use bit stride when taking slice of array Tom Tromey @ 2020-09-30 20:06 ` Tom Tromey 2020-11-04 15:49 ` [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 9 siblings, 0 replies; 20+ messages in thread From: Tom Tromey @ 2020-09-30 20:06 UTC (permalink / raw) To: gdb-patches; +Cc: Tom Tromey With -fgnat-encodings=minimal, Gnat will emit DW_TAG_array_type that has a name -- and this is the only time the name is emitted for the type. (For comparison, in C a typedef would be emitted in this situation.) This patch changes gdb to recognize the name of an array type. This is limited to Ada, to avoid any potential problems if some rogue DWARF happens to name an array type in some other language, and to avoid loading unnecessary partial DIEs. 2020-09-30 Tom Tromey <tromey@adacore.com> * dwarf2/read.c (add_partial_symbol, process_die): Handle DW_TAG_array_type. (is_type_tag_for_partial): Add "lang" parameter. (load_partial_dies, new_symbol): Handle DW_TAG_array_type. gdb/testsuite/ChangeLog 2020-09-30 Tom Tromey <tromey@adacore.com> * gdb.ada/tick_length_array_enum_idx.exp: Add ptype test. * gdb.ada/tick_length_array_enum_idx/foo_n207_004.adb (PT_Full): New variable. * gdb.ada/tick_length_array_enum_idx/pck.adb (Full_PT): New type. --- gdb/ChangeLog | 7 +++++ gdb/dwarf2/read.c | 26 +++++++++++++++---- gdb/testsuite/ChangeLog | 8 ++++++ .../gdb.ada/tick_length_array_enum_idx.exp | 1 + .../foo_n207_004.adb | 2 ++ .../tick_length_array_enum_idx/pck.ads | 3 +++ 6 files changed, 42 insertions(+), 5 deletions(-) diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c index 9a94c5b349f..1a124519b6f 100644 --- a/gdb/dwarf2/read.c +++ b/gdb/dwarf2/read.c @@ -8575,6 +8575,7 @@ add_partial_symbol (struct partial_die_info *pdi, struct dwarf2_cu *cu) where = psymbol_placement::STATIC; } break; + case DW_TAG_array_type: case DW_TAG_typedef: case DW_TAG_base_type: case DW_TAG_subrange_type: @@ -10194,7 +10195,6 @@ process_die (struct die_info *die, struct dwarf2_cu *cu) read them on-demand through read_type_die. */ case DW_TAG_subroutine_type: case DW_TAG_set_type: - case DW_TAG_array_type: case DW_TAG_pointer_type: case DW_TAG_ptr_to_member_type: case DW_TAG_reference_type: @@ -10202,6 +10202,13 @@ process_die (struct die_info *die, struct dwarf2_cu *cu) case DW_TAG_string_type: break; + case DW_TAG_array_type: + /* We only need to handle this case for Ada -- in other + languages, it's normal for the compiler to emit a typedef + instead. */ + if (cu->language != language_ada) + break; + /* FALLTHROUGH */ case DW_TAG_base_type: case DW_TAG_subrange_type: case DW_TAG_typedef: @@ -18976,20 +18983,27 @@ read_full_die (const struct die_reader_specs *reader, symbol for. */ static int -is_type_tag_for_partial (int tag) +is_type_tag_for_partial (int tag, enum language lang) { switch (tag) { #if 0 /* Some types that would be reasonable to generate partial symbols for, - that we don't at present. */ - case DW_TAG_array_type: + that we don't at present. Note that normally this does not + matter, mainly because C compilers don't give names to these + types, but instead emit DW_TAG_typedef. */ case DW_TAG_file_type: case DW_TAG_ptr_to_member_type: case DW_TAG_set_type: case DW_TAG_string_type: case DW_TAG_subroutine_type: #endif + + /* GNAT may emit an array with a name, but no typedef, so we + need to make a symbol in this case. */ + case DW_TAG_array_type: + return lang == language_ada; + case DW_TAG_base_type: case DW_TAG_class_type: case DW_TAG_interface_type: @@ -19083,7 +19097,7 @@ load_partial_dies (const struct die_reader_specs *reader, later variables referencing them via DW_AT_specification (for static members). */ if (!load_all - && !is_type_tag_for_partial (abbrev->tag) + && !is_type_tag_for_partial (abbrev->tag, cu->language) && abbrev->tag != DW_TAG_constant && abbrev->tag != DW_TAG_enumerator && abbrev->tag != DW_TAG_subprogram @@ -19127,6 +19141,7 @@ load_partial_dies (const struct die_reader_specs *reader, && pdi.is_declaration == 0 && ((pdi.tag == DW_TAG_typedef && !pdi.has_children) || pdi.tag == DW_TAG_base_type + || pdi.tag == DW_TAG_array_type || pdi.tag == DW_TAG_subrange_type)) { if (building_psymtab && pdi.raw_name != NULL) @@ -22020,6 +22035,7 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu, SYMBOL_DOMAIN (sym) = VAR_DOMAIN; list_to_add = cu->list_in_scope; break; + case DW_TAG_array_type: case DW_TAG_base_type: case DW_TAG_subrange_type: SYMBOL_ACLASS_INDEX (sym) = LOC_TYPEDEF; diff --git a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx.exp b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx.exp index 52715cf68e1..6dd01aca2b6 100644 --- a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx.exp +++ b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx.exp @@ -41,3 +41,4 @@ gdb_test "ptype vars'length" "type = <$decimal-byte integer>" gdb_test "ptype full_table'length" "type = <$decimal-byte integer>" gdb_test "ptype primary_table'length" "type = <$decimal-byte integer>" gdb_test "ptype variable_table'length" "type = <$decimal-byte integer>" +gdb_test "ptype full_pt'length" "type = <$decimal-byte integer>" diff --git a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/foo_n207_004.adb b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/foo_n207_004.adb index 934a7f8ae85..0b2584fa73c 100644 --- a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/foo_n207_004.adb +++ b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/foo_n207_004.adb @@ -20,9 +20,11 @@ procedure Foo_n207_004 is Prim : Primary_Table := (True, False, False); Cold : Variable_Table := (Green => False, Blue => True, White => True); Vars : Variable_Table := New_Variable_Table (Low => Red, High => Green); + PT_Full : Full_PT := (False, True, False, True, False); begin Do_Nothing (Full'Address); -- STOP Do_Nothing (Prim'Address); Do_Nothing (Cold'Address); Do_Nothing (Vars'Address); + Do_Nothing (PT_Full'Address); end Foo_n207_004; diff --git a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/pck.ads b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/pck.ads index 112caf1f651..461bee5377a 100644 --- a/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/pck.ads +++ b/gdb/testsuite/gdb.ada/tick_length_array_enum_idx/pck.ads @@ -21,6 +21,9 @@ package Pck is type Primary_Table is array (Color range Red .. Blue) of Boolean; type Variable_Table is array (Color range <>) of Boolean; + type Full_PT is array (Color) of Boolean; + pragma Pack (Full_PT); + function New_Variable_Table (Low: Color; High: Color) return Variable_Table; procedure Do_Nothing (A : System.Address); -- 2.26.2 ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey ` (8 preceding siblings ...) 2020-09-30 20:06 ` [PATCH 9/9] Recognize names of array types Tom Tromey @ 2020-11-04 15:49 ` Tom Tromey 2020-11-04 16:33 ` Tom de Vries 9 siblings, 1 reply; 20+ messages in thread From: Tom Tromey @ 2020-11-04 15:49 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches >>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes: Tom> GNAT has two debuginfo modes -- the default, which is to emit "GNAT Tom> encodings", and -fgnat-encodings=minimal, which emits something closer Tom> to pure DWARF. Tom> Historically gdb has only handled GNAT encodings. This patch series Tom> brings gdb most of the way to handling -fgnat-encodings=minimal. The Tom> remaining issues are going to require some patches to GNAT and gdb; my Tom> plan is to only land the gdb changes once the GNAT changes have gone Tom> in. Tom> Patches #2 - #9 were all reviewed internally by Joel. However, they Tom> aren't all purely Ada-specific. (Patch #1 is new, written while I was Tom> prepping this series -- see the comments there.) Tom> For gdb itself, the benefit of these changes is that with Tom> minimal-encodings, the Ada type system works more like the rest of Tom> gdb. For users the main benefit is that the Python API works more Tom> nicely. I'm checking these in now. Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-11-04 15:49 ` [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey @ 2020-11-04 16:33 ` Tom de Vries 2020-11-04 17:20 ` Tom de Vries ` (2 more replies) 0 siblings, 3 replies; 20+ messages in thread From: Tom de Vries @ 2020-11-04 16:33 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches On 11/4/20 4:49 PM, Tom Tromey wrote: >>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes: > > Tom> GNAT has two debuginfo modes -- the default, which is to emit "GNAT > Tom> encodings", and -fgnat-encodings=minimal, which emits something closer > Tom> to pure DWARF. > > Tom> Historically gdb has only handled GNAT encodings. This patch series > Tom> brings gdb most of the way to handling -fgnat-encodings=minimal. The > Tom> remaining issues are going to require some patches to GNAT and gdb; my > Tom> plan is to only land the gdb changes once the GNAT changes have gone > Tom> in. > > Tom> Patches #2 - #9 were all reviewed internally by Joel. However, they > Tom> aren't all purely Ada-specific. (Patch #1 is new, written while I was > Tom> prepping this series -- see the comments there.) > > Tom> For gdb itself, the benefit of these changes is that with > Tom> minimal-encodings, the Ada type system works more like the rest of > Tom> gdb. For users the main benefit is that the Python API works more > Tom> nicely. > > I'm checking these in now. With a build from commit d8f62e8447 "Recognize names of array types", I get: ... FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print entire array FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print first array element FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print first array slice FAIL: gdb.ada/big_packed_array.exp: scenario=minimal: print bad KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype small (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small'first (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype multi (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi'first (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi(1,3) (PRMS minimal encodings) KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi(2) (PRMS minimal encodings) KPASS: gdb.ada/mod_from_name.exp: scenario=minimal: print xp (PRMS minimal encodings) KPASS: gdb.ada/pckd_arr_ren.exp: scenario=minimal: print var (PRMS minimal encodings) ... Thanks, - Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-11-04 16:33 ` Tom de Vries @ 2020-11-04 17:20 ` Tom de Vries 2020-11-04 18:52 ` Tom Tromey 2020-11-16 14:01 ` [PATCH][gdb/testsuite] Fix minimal encodings KPASSes Tom de Vries 2 siblings, 0 replies; 20+ messages in thread From: Tom de Vries @ 2020-11-04 17:20 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches On 11/4/20 5:33 PM, Tom de Vries wrote: > On 11/4/20 4:49 PM, Tom Tromey wrote: >>>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes: >> >> Tom> GNAT has two debuginfo modes -- the default, which is to emit "GNAT >> Tom> encodings", and -fgnat-encodings=minimal, which emits something closer >> Tom> to pure DWARF. >> >> Tom> Historically gdb has only handled GNAT encodings. This patch series >> Tom> brings gdb most of the way to handling -fgnat-encodings=minimal. The >> Tom> remaining issues are going to require some patches to GNAT and gdb; my >> Tom> plan is to only land the gdb changes once the GNAT changes have gone >> Tom> in. >> >> Tom> Patches #2 - #9 were all reviewed internally by Joel. However, they >> Tom> aren't all purely Ada-specific. (Patch #1 is new, written while I was >> Tom> prepping this series -- see the comments there.) >> >> Tom> For gdb itself, the benefit of these changes is that with >> Tom> minimal-encodings, the Ada type system works more like the rest of >> Tom> gdb. For users the main benefit is that the Python API works more >> Tom> nicely. >> >> I'm checking these in now. > > With a build from commit d8f62e8447 "Recognize names of array types", I get: > ... > FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print entire array > FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print first array > element > FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print first array > slice > FAIL: gdb.ada/big_packed_array.exp: scenario=minimal: print bad > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype small (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small'first > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype multi (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi'first > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print > multi_multi(1,3) (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print > multi_multi(2) (PRMS minimal encodings) > KPASS: gdb.ada/mod_from_name.exp: scenario=minimal: print xp (PRMS > minimal encodings) > KPASS: gdb.ada/pckd_arr_ren.exp: scenario=minimal: print var (PRMS > minimal encodings) > ... As well as: ... FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three FAIL: gdb.dwarf2/data-loc.exp: print foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five FAIL: gdb.dwarf2/data-loc.exp: print foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo.five_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__three FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three FAIL: gdb.dwarf2/data-loc.exp: print foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__three_tdef FAIL: gdb.dwarf2/data-loc.exp: print foo__five FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five FAIL: gdb.dwarf2/data-loc.exp: print foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__five_tdef FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type ... Thanks, - Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-11-04 16:33 ` Tom de Vries 2020-11-04 17:20 ` Tom de Vries @ 2020-11-04 18:52 ` Tom Tromey 2020-11-04 19:54 ` Tom de Vries 2020-11-16 14:01 ` [PATCH][gdb/testsuite] Fix minimal encodings KPASSes Tom de Vries 2 siblings, 1 reply; 20+ messages in thread From: Tom Tromey @ 2020-11-04 18:52 UTC (permalink / raw) To: Tom de Vries; +Cc: Tom Tromey, gdb-patches >>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes: Tom> With a build from commit d8f62e8447 "Recognize names of array types", I get: What version of gcc are you using? It works for me but maybe we need to tweak this somehow. Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-11-04 18:52 ` Tom Tromey @ 2020-11-04 19:54 ` Tom de Vries 2020-11-16 14:32 ` Tom de Vries 0 siblings, 1 reply; 20+ messages in thread From: Tom de Vries @ 2020-11-04 19:54 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches On 11/4/20 7:52 PM, Tom Tromey wrote: >>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes: > > Tom> With a build from commit d8f62e8447 "Recognize names of array types", I get: > > What version of gcc are you using? gcc 7.5.0 > It works for me but maybe we need to tweak this somehow. Looking at this test-case: ... FAIL: gdb.dwarf2/data-loc.exp: ptype foo__array_type ... it fails for me with gcc-4.8, gcc 7.5.0, gcc 8, gcc 9, gcc 10 and gcc 11. But then again, it's a dwarf assembly test-case, it's expected that the gcc version doesn't influence it. Looking at this test-case: ... FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print entire array ... it fails for me with gcc-4.8, gcc 7.5.0, but passes with gcc 8, gcc 9, gcc 10 and gcc 11. Thanks, - Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures 2020-11-04 19:54 ` Tom de Vries @ 2020-11-16 14:32 ` Tom de Vries 0 siblings, 0 replies; 20+ messages in thread From: Tom de Vries @ 2020-11-16 14:32 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches On 11/4/20 8:54 PM, Tom de Vries wrote: > On 11/4/20 7:52 PM, Tom Tromey wrote: >>>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes: >> >> Tom> With a build from commit d8f62e8447 "Recognize names of array types", I get: >> >> What version of gcc are you using? > > gcc 7.5.0 > >> It works for me but maybe we need to tweak this somehow. > I've filed two PRs for this: - PR26903 - FAIL: gdb.ada/array_of_variant.exp: scenario=minimal: print entire array https://sourceware.org/bugzilla/show_bug.cgi?id=26903 - PR26904 - FAIL: gdb.ada/big_packed_array.exp: scenario=minimal: print bad https://sourceware.org/bugzilla/show_bug.cgi?id=26904 and attached info that's hopefully useful. Thanks, - Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH][gdb/testsuite] Fix minimal encodings KPASSes 2020-11-04 16:33 ` Tom de Vries 2020-11-04 17:20 ` Tom de Vries 2020-11-04 18:52 ` Tom Tromey @ 2020-11-16 14:01 ` Tom de Vries 2020-11-23 19:10 ` [committed][gdb/testsuite] " Tom de Vries 2 siblings, 1 reply; 20+ messages in thread From: Tom de Vries @ 2020-11-16 14:01 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches [-- Attachment #1: Type: text/plain, Size: 1255 bytes --] [ was: Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures ] On 11/4/20 5:33 PM, Tom de Vries wrote: > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype small (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small'first > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype multi (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi (PRMS > minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi'first > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi > (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print > multi_multi(1,3) (PRMS minimal encodings) > KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print > multi_multi(2) (PRMS minimal encodings) > KPASS: gdb.ada/mod_from_name.exp: scenario=minimal: print xp (PRMS > minimal encodings) > KPASS: gdb.ada/pckd_arr_ren.exp: scenario=minimal: print var (PRMS > minimal encodings) > ... Hi, This fixes the KPASSes for me. Any comments? Thanks, - Tom [-- Attachment #2: 0001-gdb-testsuite-Fix-minimal-encodings-KPASSes.patch --] [-- Type: text/x-patch, Size: 3125 bytes --] [gdb/testsuite] Fix minimal encodings KPASSes With current master I see a couple of KPASSes: ... KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype small \ (PRMS minimal encodings) ... KPASS: gdb.ada/mod_from_name.exp: scenario=minimal: print xp \ (PRMS minimal encodings) KPASS: gdb.ada/pckd_arr_ren.exp: scenario=minimal: print var \ (PRMS minimal encodings) ... The corresponding setup_kfail is called for everything before gnat 11. However, the test-cases also PASS for me with gnat-4.8, gnat-7.5.0 and gnat-8.4.0. Fix the KPASSes by limiting the setup_kfail to gnat 9 and 10. Tested on x86_64-linux. gdb/testsuite/ChangeLog: 2020-11-16 Tom de Vries <tdevries@suse.de> * gdb.ada/enum_idx_packed.exp: Limit setup_kfail to gnat 9 and 10. * gdb.ada/mod_from_name.exp: Same. * gdb.ada/pckd_arr_ren.exp: Same. --- gdb/testsuite/gdb.ada/enum_idx_packed.exp | 5 +++-- gdb/testsuite/gdb.ada/mod_from_name.exp | 5 +++-- gdb/testsuite/gdb.ada/pckd_arr_ren.exp | 5 +++-- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/gdb/testsuite/gdb.ada/enum_idx_packed.exp b/gdb/testsuite/gdb.ada/enum_idx_packed.exp index 2e5a85e76b3..f32c488e171 100644 --- a/gdb/testsuite/gdb.ada/enum_idx_packed.exp +++ b/gdb/testsuite/gdb.ada/enum_idx_packed.exp @@ -28,8 +28,9 @@ foreach_with_prefix scenario {all minimal} { clean_restart ${testfile} - # GNAT >= 11.0 has the needed fix here. - if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + # GNAT 9 and 10 are known to fail. + if {$scenario == "minimal" && ([test_compiler_info {gcc-9-*}] \ + || [test_compiler_info {gcc-10-*}])} { set old_compiler 1 } else { set old_compiler 0 diff --git a/gdb/testsuite/gdb.ada/mod_from_name.exp b/gdb/testsuite/gdb.ada/mod_from_name.exp index 43d81e0026f..5f779c30845 100644 --- a/gdb/testsuite/gdb.ada/mod_from_name.exp +++ b/gdb/testsuite/gdb.ada/mod_from_name.exp @@ -34,8 +34,9 @@ foreach_with_prefix scenario {all minimal} { return } - # GNAT >= 11.0 has the needed fix here. - if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + # GNAT 9 and 10 are known to fail. + if {$scenario == "minimal" && ([test_compiler_info {gcc-9-*}] \ + || [test_compiler_info {gcc-10-*}])} { setup_kfail "minimal encodings" *-*-* } gdb_test "print xp" \ diff --git a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp index 13e599b6a58..8c53f857bee 100644 --- a/gdb/testsuite/gdb.ada/pckd_arr_ren.exp +++ b/gdb/testsuite/gdb.ada/pckd_arr_ren.exp @@ -31,8 +31,9 @@ foreach_with_prefix scenario {all minimal} { set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb] runto "foo.adb:$bp_location" - # GNAT >= 11.0 has the needed fix here. - if {$scenario == "minimal" && ![test_compiler_info {gcc-1[1-9]-*}]} { + # GNAT 9 and 10 are known to fail. + if {$scenario == "minimal" && ([test_compiler_info {gcc-9-*}] \ + || [test_compiler_info {gcc-10-*}])} { setup_kfail "minimal encodings" *-*-* } gdb_test "print A2" \ ^ permalink raw reply [flat|nested] 20+ messages in thread
* [committed][gdb/testsuite] Fix minimal encodings KPASSes 2020-11-16 14:01 ` [PATCH][gdb/testsuite] Fix minimal encodings KPASSes Tom de Vries @ 2020-11-23 19:10 ` Tom de Vries 0 siblings, 0 replies; 20+ messages in thread From: Tom de Vries @ 2020-11-23 19:10 UTC (permalink / raw) To: Tom Tromey; +Cc: gdb-patches On 11/16/20 3:01 PM, Tom de Vries wrote: > [ was: Re: [PATCH 0/9] Fix most -fgnat-encodings=minimal failures ] > > On 11/4/20 5:33 PM, Tom de Vries wrote: >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype small (PRMS >> minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small (PRMS >> minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print small'first >> (PRMS minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: ptype multi (PRMS >> minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi (PRMS >> minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi'first >> (PRMS minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print multi_multi >> (PRMS minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print >> multi_multi(1,3) (PRMS minimal encodings) >> KPASS: gdb.ada/enum_idx_packed.exp: scenario=minimal: print >> multi_multi(2) (PRMS minimal encodings) >> KPASS: gdb.ada/mod_from_name.exp: scenario=minimal: print xp (PRMS >> minimal encodings) >> KPASS: gdb.ada/pckd_arr_ren.exp: scenario=minimal: print var (PRMS >> minimal encodings) >> ... > > Hi, > > This fixes the KPASSes for me. > > Any comments? Now committed. Thanks, - Tom ^ permalink raw reply [flat|nested] 20+ messages in thread
end of thread, other threads:[~2020-11-23 19:10 UTC | newest] Thread overview: 20+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2020-09-30 20:05 [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 2020-09-30 20:05 ` [PATCH 1/9] Avoid crash in ada-lang.c:to_fixed_array_type Tom Tromey 2020-09-30 20:05 ` [PATCH 2/9] Fix decoding of multi-dimensional constrained packed arrays Tom Tromey 2020-09-30 20:05 ` [PATCH 3/9] Synthesize array descriptors with -fgnat-encodings=minimal Tom Tromey 2020-11-06 12:08 ` Luis Machado 2020-11-06 17:55 ` Tom Tromey 2020-09-30 20:05 ` [PATCH 4/9] Reject slicing a packed array Tom Tromey 2020-09-30 20:05 ` [PATCH 5/9] Resolve dynamic type in ada_value_struct_elt Tom Tromey 2020-09-30 20:05 ` [PATCH 6/9] Fix bit strides for -fgnat-encodings=minimal Tom Tromey 2020-09-30 20:05 ` [PATCH 7/9] Only use stride for final element type Tom Tromey 2020-09-30 20:05 ` [PATCH 8/9] Use bit stride when taking slice of array Tom Tromey 2020-09-30 20:06 ` [PATCH 9/9] Recognize names of array types Tom Tromey 2020-11-04 15:49 ` [PATCH 0/9] Fix most -fgnat-encodings=minimal failures Tom Tromey 2020-11-04 16:33 ` Tom de Vries 2020-11-04 17:20 ` Tom de Vries 2020-11-04 18:52 ` Tom Tromey 2020-11-04 19:54 ` Tom de Vries 2020-11-16 14:32 ` Tom de Vries 2020-11-16 14:01 ` [PATCH][gdb/testsuite] Fix minimal encodings KPASSes Tom de Vries 2020-11-23 19:10 ` [committed][gdb/testsuite] " Tom de Vries
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).