1 # Copyright 2020-2021 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 3 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
18 if { [skip_ada_tests] } { return -1 }
20 standard_ada_testfile p
22 if [get_compiler_info] {
25 set old_gcc [expr [test_compiler_info {gcc-[0-7]-*}]]
27 proc gdb_test_with_xfail { cmd re re_xfail msg } {
28 global scenario old_gcc
29 set have_xfail [expr $old_gcc && [string equal "$scenario" "minimal"]]
31 gdb_test_multiple $cmd $msg {
45 foreach_with_prefix scenario {all minimal} {
46 set flags [list debug additional_flags=-fgnat-encodings=$scenario]
48 if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
52 clean_restart ${testfile}
54 set bp_location [gdb_get_line_number "START" ${testdir}/p.adb]
55 runto "p.adb:$bp_location"
57 set v1 "(tag => object, values => (2, 2, 2, 2, 2))"
58 set v1_xfail "(tag => object, values => ())"
59 set v2 "(tag => unused)"
61 set re [string_to_regexp " = ($v1, $v2)"]
62 set re_xfail [string_to_regexp " = ($v1_xfail, $v2)"]
63 gdb_test_with_xfail "print objects" $re $re_xfail "print entire array"
65 set re [string_to_regexp " = $v1"]
66 set re_xfail [string_to_regexp " = $v1_xfail"]
67 gdb_test_with_xfail "print objects(1)" $re $re_xfail \
68 "print first array element"
70 set re [string_to_regexp " = ($v1)"]
71 set re_xfail [string_to_regexp " = ($v1_xfail)"]
72 gdb_test_with_xfail "print objects(1 .. 1)" $re $re_xfail \
73 "print first array slice"
75 gdb_test "print objects(2)" \
76 [string_to_regexp " = $v2"] \
77 "print second array element"
78 gdb_test "print objects(2 .. 2)" \
79 [string_to_regexp " = (2 => $v2)"] \
80 "print second array slice"