]>
Commit | Line | Data |
---|---|---|
4a94e368 | 1 | # Copyright 2020-2022 Free Software Foundation, Inc. |
7ff5b937 TT |
2 | # |
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. | |
7 | # | |
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. | |
12 | # | |
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/>. | |
15 | ||
16 | load_lib "ada.exp" | |
cc9d6997 | 17 | load_lib "gdb-python.exp" |
7ff5b937 TT |
18 | |
19 | if { [skip_ada_tests] } { return -1 } | |
20 | ||
21 | standard_ada_testfile p | |
22 | ||
af2b87e6 TV |
23 | set old_gcc [expr [test_compiler_info {gcc-[0-7]-*}]] |
24 | ||
25 | proc gdb_test_with_xfail { cmd re re_xfail msg } { | |
26 | global scenario old_gcc | |
27 | set have_xfail [expr $old_gcc && [string equal "$scenario" "minimal"]] | |
28 | ||
29 | gdb_test_multiple $cmd $msg { | |
30 | -re -wrap $re { | |
31 | pass $gdb_test_name | |
32 | } | |
33 | -re -wrap $re_xfail { | |
34 | if { $have_xfail } { | |
35 | # gcc/101633 | |
36 | setup_xfail *-*-* | |
37 | } | |
38 | fail $gdb_test_name | |
39 | } | |
40 | } | |
41 | } | |
42 | ||
7ff5b937 TT |
43 | foreach_with_prefix scenario {all minimal} { |
44 | set flags [list debug additional_flags=-fgnat-encodings=$scenario] | |
45 | ||
5ae3df22 | 46 | if {[gdb_compile_ada "${srcfile}" "${binfile}-${scenario}" executable $flags] != ""} { |
7ff5b937 TT |
47 | return -1 |
48 | } | |
49 | ||
5ae3df22 | 50 | clean_restart ${testfile}-${scenario} |
7ff5b937 TT |
51 | |
52 | set bp_location [gdb_get_line_number "START" ${testdir}/p.adb] | |
53 | runto "p.adb:$bp_location" | |
54 | ||
55 | set v1 "(tag => object, values => (2, 2, 2, 2, 2))" | |
af2b87e6 | 56 | set v1_xfail "(tag => object, values => ())" |
7ff5b937 TT |
57 | set v2 "(tag => unused)" |
58 | ||
af2b87e6 TV |
59 | set re [string_to_regexp " = ($v1, $v2)"] |
60 | set re_xfail [string_to_regexp " = ($v1_xfail, $v2)"] | |
61 | gdb_test_with_xfail "print objects" $re $re_xfail "print entire array" | |
62 | ||
63 | set re [string_to_regexp " = $v1"] | |
64 | set re_xfail [string_to_regexp " = $v1_xfail"] | |
65 | gdb_test_with_xfail "print objects(1)" $re $re_xfail \ | |
7ff5b937 | 66 | "print first array element" |
af2b87e6 TV |
67 | |
68 | set re [string_to_regexp " = ($v1)"] | |
69 | set re_xfail [string_to_regexp " = ($v1_xfail)"] | |
70 | gdb_test_with_xfail "print objects(1 .. 1)" $re $re_xfail \ | |
7ff5b937 | 71 | "print first array slice" |
af2b87e6 | 72 | |
7ff5b937 TT |
73 | gdb_test "print objects(2)" \ |
74 | [string_to_regexp " = $v2"] \ | |
75 | "print second array element" | |
76 | gdb_test "print objects(2 .. 2)" \ | |
77 | [string_to_regexp " = (2 => $v2)"] \ | |
78 | "print second array slice" | |
cc9d6997 TT |
79 | |
80 | # This is only supported for the DWARF encoding. | |
81 | if {$scenario == "minimal" && ![skip_python_tests]} { | |
82 | gdb_test_no_output \ | |
83 | "python o = gdb.parse_and_eval('objects')" \ | |
84 | "fetch value for python" | |
af2b87e6 TV |
85 | set re [string_to_regexp "($v1, $v2)"] |
86 | set re_xfail [string_to_regexp "($v1_xfail, $v2)"] | |
87 | gdb_test_with_xfail "python print(o)" $re $re_xfail \ | |
cc9d6997 | 88 | "python print array" |
af2b87e6 TV |
89 | set re [string_to_regexp "$v1"] |
90 | set re_xfail [string_to_regexp "$v1_xfail"] | |
91 | gdb_test_with_xfail "python print(o\[1\])" $re $re_xfail \ | |
cc9d6997 TT |
92 | "python print first array element" |
93 | gdb_test "python print(o\[2\])" \ | |
94 | [string_to_regexp "$v2"] \ | |
95 | "python print second array element" | |
96 | } | |
05fb05a9 TT |
97 | |
98 | set av1 "(initial => 0, rest => (tag => unused, cval => 88 'X'))" | |
99 | set av2 "(initial => 0, rest => (tag => object, ival => 88))" | |
100 | set full "($av1, $av2)" | |
101 | ||
102 | gdb_test "print another_array(1)" " = [string_to_regexp $av1]" \ | |
103 | "print first element of another_array" | |
104 | gdb_test "print another_array(2)" " = [string_to_regexp $av2]" \ | |
105 | "print second element of another_array" | |
106 | gdb_test "print another_array" " = [string_to_regexp $full]" \ | |
107 | "print another_array" | |
7ff5b937 | 108 | } |