From 575673752cade1772f4a6ba2e38306e5ac9a91f6 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 4 Nov 2020 08:49:16 -0700 Subject: Synthesize array descriptors with -fgnat-encodings=minimal 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-11-04 Tom Tromey * 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-11-04 Tom Tromey * 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/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/testsuite/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 | 60 +++++++------- gdb/testsuite/gdb.ada/mod_from_name.exp | 30 ++++--- gdb/testsuite/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/testsuite/gdb.ada/unc_arr_ptr_in_var_rec.exp | 92 +++++++++++----------- .../gdb.ada/variant_record_packed_array.exp | 66 ++++++++++------ 17 files changed, 395 insertions(+), 282 deletions(-) (limited to 'gdb/testsuite') diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index e9d5a23..5190920 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,37 @@ 2020-11-04 Tom Tromey + * 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. + +2020-11-04 Tom Tromey + * 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. diff --git a/gdb/testsuite/gdb.ada/O2_float_param.exp b/gdb/testsuite/gdb.ada/O2_float_param.exp index 09ebeec..debc21c 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 9830ef7..f3fea4a 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 f5936df..b3a4c0d 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 9eb6777..af9cb6f 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 4355508..81c1a39 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 dc36499..326c9d4 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 94a5d87..fa84a7a 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 fe49a19..e24466b 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 \\)" \ + gdb_test "print good" \ + "= \\(false \\)" \ -gdb_test "print bad" \ - "= \\(false \\)" \ + gdb_test "print bad" \ + "= \\(false \\)" +} diff --git a/gdb/testsuite/gdb.ada/frame_arg_lang.exp b/gdb/testsuite/gdb.ada/frame_arg_lang.exp index 9662e35..9668f0e 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 56c8522..691320b 100644 --- a/gdb/testsuite/gdb.ada/mi_string_access.exp +++ b/gdb/testsuite/gdb.ada/mi_string_access.exp @@ -19,41 +19,45 @@ if { [skip_ada_tests] } { return -1 } standard_ada_testfile bar -if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { - return -1 -} - load_lib mi-support.exp set MIFLAGS "-i=mi" -mi_clean_restart $binfile +foreach_with_prefix scenario {all minimal} { + set flags [list debug additional_flags=-fgnat-encodings=$scenario] -if {[mi_runto_main] < 0} { - fail "cannot run to main, testcase aborted" - return 0 -} + if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} { + return -1 + } -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_clean_restart $binfile -mi_gdb_test "-var-create var1 * Aos" \ - "\\^done,name=\"var1\",numchild=\"2\",.*" \ - "Create var1 varobj" + if {[mi_runto_main] < 0} { + fail "cannot run to main, testcase aborted" + return 0 + } -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" + 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-evaluate-expression var1" \ - "\\^done,value=\"\\\[2\\\]\"" \ - "Print var1" + mi_gdb_test "-var-create var1 * Aos" \ + "\\^done,name=\"var1\",numchild=\"2\",.*" \ + "Create var1 varobj" -mi_gdb_test "-var-evaluate-expression var1.1" \ - "\\^done,value=\"$hex\"" \ - "Print var1 first child" + 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.2" \ - "\\^done,value=\"$hex\"" \ - "Print var1 second child" + mi_gdb_test "-var-evaluate-expression var1" \ + "\\^done,value=\"\\\[2\\\]\"" \ + "Print var1" + + 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 dce0f3a..fec383b 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 684a369..7ffb7cb 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 0928b1b..9661318 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 " + # 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 " -# 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 d41de44..13e599b 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" \ - "= (\\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" \ + "= (\\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 f7f3485..a7fd465 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 e10c62b..7f10d3d 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 + } } } -- cgit v1.1