+2020-04-24 Tom Tromey <tromey@adacore.com>
+
+ * gdb.ada/frame_arg_lang.exp: Run with multiple -fgnat-encodings
+ values.
+ * gdb.ada/funcall_ref.exp: Run with multiple -fgnat-encodings
+ values. Update test for minimal encodings.
+ * gdb.ada/lang_switch.exp: Update test for minimal encodings.
+ * gdb.ada/var_rec_arr.exp: Run with multiple -fgnat-encodings
+ values. Update test for minimal encodings.
+
2020-04-24 Tom Tromey <tromey@adacore.com>
PR python/23662:
set cobject [standard_output_file ${cfile}.o]
gdb_compile "${csrcfile}" "${cobject}" object [list debug]
-if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-largs additional_flags=${cobject} additional_flags=-margs]] != "" } {
- return -1
-}
-clean_restart ${testfile}
+# 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=-largs \
+ additional_flags=${cobject} \
+ additional_flags=-margs \
+ additional_flags=-fgnat-encodings=$scenario]
+
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
+ }
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.c]
-runto "foo.c:$bp_location"
+ clean_restart ${testfile}
-gdb_test_no_output "set print frame-arguments all"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.c]
+ runto "foo.c:$bp_location"
-# Here is the scenario:
-# - Once stopped in a C function, with language_mode set to auto, print
-# backtrace, we should see the Ada frame arguments printed using Ada
-# syntax.
-# - Set language to C, then check that printing backtrace shows the Ada
-# frame arguments using C syntax.
-# - Set language back to auto, check language mode value, then print
-# backtrace, we should see Ada frame arguments printed using Ada C
-# syntax.
+ gdb_test_no_output "set print frame-arguments all"
-gdb_test "show lang" \
- "The current source language is \"auto; currently c\"." \
- "show language when set to 'auto; c'"
+ # Here is the scenario:
+ # - Once stopped in a C function, with language_mode set to auto, print
+ # backtrace, we should see the Ada frame arguments printed using Ada
+ # syntax.
+ # - Set language to C, then check that printing backtrace shows the Ada
+ # frame arguments using C syntax.
+ # - Set language back to auto, check language mode value, then print
+ # backtrace, we should see Ada frame arguments printed using Ada C
+ # syntax.
-gdb_test "bt" \
- "#1 $hex in pck\\.call_me \\(s=\"test\"\\).*" \
- "backtrace with auto: c"
+ gdb_test "show lang" \
+ "The current source language is \"auto; currently c\"." \
+ "show language when set to 'auto; c'"
-gdb_test_no_output "set language c" \
- "Set current source language to \"manual; currently c\"."
+ gdb_test "bt" \
+ "#1 $hex in pck\\.call_me \\(s=\"test\"\\).*" \
+ "backtrace with auto: c"
-gdb_test "show lang" \
- "The current source language is \"c\"." \
- "show language when set to 'c'"
+ gdb_test_no_output "set language c" \
+ "Set current source language to \"manual; currently c\"."
-gdb_test "bt" \
- "#1 $hex in pck\\.call_me \\(s={P_ARRAY = $hex, P_BOUNDS = $hex}\\).*" \
- "backtrace with language forced to 'c'"
+ gdb_test "show lang" \
+ "The current source language is \"c\"." \
+ "show language when set to 'c'"
-gdb_test_no_output "set language auto" \
- "Set current source language to \"auto; currently 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\\).*" \
+ "backtrace with language forced to 'c'"
-gdb_test "show lang" \
- "The current source language is \"auto; currently c\"." \
- "show language when set back to 'auto; c'"
+ gdb_test_no_output "set language auto" \
+ "Set current source language to \"auto; currently c\"."
-gdb_test "bt" \
- "#1 $hex in pck\\.call_me \\(s=\"test\"\\).*" \
- "backtrace with language back to 'auto; c'"
+ gdb_test "show lang" \
+ "The current source language is \"auto; currently c\"." \
+ "show language when set back to 'auto; c'"
+
+ gdb_test "bt" \
+ "#1 $hex in pck\\.call_me \\(s=\"test\"\\).*" \
+ "backtrace with language back to 'auto; c'"
+}
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}
-
-set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
-runto "foo.adb:$bp_location"
-
-# Test printing and type-printing of a discriminated record that a function
-# returns by reference.
-
-# Currently, GCC describes such functions as returning pointers (instead of
-# references).
-set pass_re [multi_line "type = <ref> record" \
- " n: natural;" \
- " s: access array \\(1 \\.\\. n\\) of character;" \
- "end record"]
-set unsupported_re [multi_line "type = access record" \
- " n: natural;" \
- " s: access array \\(1 \\.\\. n\\) of character;" \
- "end record"]
-set supported 1
-gdb_test_multiple "ptype get (\"Hello world!\")" "" {
- -re -wrap $pass_re {
- pass $gdb_test_name
+ if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+ return -1
}
- -re -wrap $unsupported_re {
- unsupported $gdb_test_name
- set supported 0
+
+ clean_restart ${testfile}
+
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo.adb]
+ runto "foo.adb:$bp_location"
+
+ # Test printing and type-printing of a discriminated record that a function
+ # returns by reference.
+
+ # Currently, GCC describes such functions as returning pointers (instead of
+ # references).
+ set pass_re [multi_line "type = <ref> record" \
+ " n: natural;" \
+ " s: access array \\(1 \\.\\. n\\) of character;" \
+ "end record"]
+ # With DWARF we get debuginfo that could in theory show "1..n" for
+ # the range:
+ # <3><1230>: Abbrev Number: 15 (DW_TAG_member)
+ # <1231> DW_AT_name : n
+ # ...
+ # <4><1257>: Abbrev Number: 18 (DW_TAG_subrange_type)
+ # <1258> DW_AT_type : <0x126e>
+ # <125c> DW_AT_upper_bound : <0x1230>
+ # However, we don't currently record the needed information in the
+ # location batons. In the meantime, we accept and kfail the
+ # compromise output.
+ set dwarf_kfail_re [multi_line "type = <ref> record" \
+ " n: natural;" \
+ " s: array \\(<>\\) of character;" \
+ "end record"]
+ set unsupported_re [multi_line "type = access record" \
+ " n: natural;" \
+ " s: access array \\(1 \\.\\. n\\) of character;" \
+ "end record"]
+ set supported 1
+ gdb_test_multiple "ptype get (\"Hello world!\")" "" {
+ -re -wrap $pass_re {
+ pass $gdb_test_name
+ }
+ -re -wrap $dwarf_kfail_re {
+ if {$scenario == "minimal"} {
+ setup_kfail "symbolic names in location batons" *-*-*
+ }
+ fail $gdb_test_name
+ set supported 0
+ }
+ -re -wrap $unsupported_re {
+ unsupported $gdb_test_name
+ set supported 0
+ }
}
-}
-if { $supported == 0 } {
- return 0
-}
+ if { $supported == 0 } {
+ return 0
+ }
-gdb_test "p get (\"Hello world!\")" \
- "= \\(n => 12, s => \"Hello world!\"\\)"
+ gdb_test "p get (\"Hello world!\")" \
+ "= \\(n => 12, s => \"Hello world!\"\\)"
+}
# Now, make sure that the language doesn't get automatically switched
# if the current language is not "auto".
gdb_test "set lang c"
+# This gives different output with -fgnat-encodings=minimal and
+# -fgnat-encodings=all, but since we don't care so much about the
+# precise details here, we just accept anything.
gdb_test "bt" \
- ".*#1.*lang_switch\\.ada_procedure\\s*\\(msg=(@$hex: +)?{.*\\).*" \
+ ".*#1.*lang_switch\\.ada_procedure\\s*\\(msg=(@$hex: +)?.*\\).*" \
"backtrace with lang set to C"
standard_ada_testfile comp_bug
-foreach_with_prefix scenario {none all minimal} {
+# 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 {debug}
if {$scenario != "none"} {
lappend flags additional_flags=-fgnat-encodings=$scenario
set bp_location [gdb_get_line_number "STOP" ${testdir}/comp_bug.adb]
runto "comp_bug.adb:$bp_location"
- gdb_test "print x" \
+ set pass_re \
"= \\(exists => true, value => 10\\)"
+ # There is a compiler bug that causes this output.
+ set kfail_re \
+ "= \\(exists => true\\)"
- gdb_test "ptype x" \
+ gdb_test_multiple "print x" "" {
+ -re -wrap $pass_re {
+ pass $gdb_test_name
+ }
+ -re -wrap $kfail_re {
+ if {$scenario == "minimal"} {
+ setup_kfail "gnat compiler bug" *-*-*
+ }
+ fail $gdb_test_name
+ }
+ }
+
+ set pass_re \
[multi_line "type = record" \
" exists: (boolean|range false \\.\\. true);" \
" case exists is" \
" when others => null;" \
" end case;" \
"end record" ]
+ # There is a compiler bug that causes this output.
+ set kfail_re \
+ [multi_line "type = record" \
+ " exists: (boolean|range false \\.\\. true);" \
+ " case \\? is" \
+ " when others =>" \
+ " value: range 0 \\.\\. 255;" \
+ " when others => null;" \
+ " end case;" \
+ "end record" ]
+
+ gdb_test_multiple "ptype x" "" {
+ -re -wrap $pass_re {
+ pass $gdb_test_name
+ }
+ -re -wrap $kfail_re {
+ if {$scenario == "minimal"} {
+ setup_kfail "gnat compiler bug" *-*-*
+ }
+ fail $gdb_test_name
+ }
+ }
}
standard_ada_testfile foo_na09_042
-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]
+
+ 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_na09_042.adb]
-runto "foo_na09_042.adb:$bp_location"
+ set bp_location [gdb_get_line_number "STOP" ${testdir}/foo_na09_042.adb]
+ runto "foo_na09_042.adb:$bp_location"
-gdb_test "print a1" \
- " = \\(\\(i => 0, s => \"\"\\), \\(i => 1, s => \"A\"\\), \\(i => 2, s => \"AB\"\\)\\)"
+ gdb_test "print a1" \
+ " = \\(\\(i => 0, s => \"\"\\), \\(i => 1, s => \"A\"\\), \\(i => 2, s => \"AB\"\\)\\)"
-gdb_test "print a1(1)" \
- " = \\(i => 0, s => \"\"\\)"
+ gdb_test "print a1(1)" \
+ " = \\(i => 0, s => \"\"\\)"
-gdb_test "print a1(2)" \
- " = \\(i => 1, s => \"A\"\\)"
+ gdb_test "print a1(2)" \
+ " = \\(i => 1, s => \"A\"\\)"
-gdb_test "print a1(3)" \
- " = \\(i => 2, s => \"AB\"\\)"
+ gdb_test "print a1(3)" \
+ " = \\(i => 2, s => \"AB\"\\)"
-gdb_test "print a2" \
- " = \\(\\(i => 2, s => \"AB\"\\), \\(i => 1, s => \"A\"\\), \\(i => 0, s => \"\"\\)\\)"
+ gdb_test "print a2" \
+ " = \\(\\(i => 2, s => \"AB\"\\), \\(i => 1, s => \"A\"\\), \\(i => 0, s => \"\"\\)\\)"
-gdb_test "print a2(1)" \
- " = \\(i => 2, s => \"AB\"\\)"
+ gdb_test "print a2(1)" \
+ " = \\(i => 2, s => \"AB\"\\)"
-gdb_test "print a2(2)" \
- " = \\(i => 1, s => \"A\"\\)"
+ gdb_test "print a2(2)" \
+ " = \\(i => 1, s => \"A\"\\)"
-gdb_test "print a2(3)" \
- " = \\(i => 0, s => \"\"\\)"
+ gdb_test "print a2(3)" \
+ " = \\(i => 0, s => \"\"\\)"
-gdb_test "ptype a1(1)" \
- [multi_line "type = record" \
- " i: pck\\.small_type;" \
- " s: access array \\((<>|1 \\.\\. i)\\) of character;" \
- "end record"]
+ # Note that the "access" is only printed when the gnat encodings
+ # are used. This is due to how the encodings work -- the type
+ # doesn't actually have the "access", and so here the DWARF
+ # encoding is more correct.
+ if {$scenario == "all"} {
+ set ex [multi_line "type = record" \
+ " i: pck\\.small_type;" \
+ " s: access array \\((<>|1 \\.\\. i)\\) of character;" \
+ "end record"]
+ } else {
+ set ex [multi_line "type = record" \
+ " i: pck\\.small_type;" \
+ " s: array \\((<>|1 \\.\\. i)\\) of character;" \
+ "end record"]
+ }
+
+ gdb_test "ptype a1(1)" $ex
+}