Commit | Line | Data |
---|---|---|
88b9d363 | 1 | # Copyright 2007-2022 Free Software Foundation, Inc. |
8d04f9f0 JB |
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 | # Author: P. N. Hilfinger, AdaCore Inc. | |
17 | ||
18 | # Note: This test is essentially a transcription of gdb.cp/formatted-ref.exp, | |
19 | # and is thus much more wordy than it needs to be. There are fewer | |
20 | # tests because only a few parameter types in Ada are required to be | |
21 | # passed by reference, and there is no equivalent of &(&x) for reference | |
22 | # values. | |
c332165e JG |
23 | # This also tests that some other arithmetic operations on references |
24 | # work properly: condition expression using a reference object as one of its | |
25 | # operand. | |
8d04f9f0 | 26 | |
8d04f9f0 JB |
27 | load_lib "ada.exp" |
28 | ||
7a82e903 PA |
29 | if { [skip_ada_tests] } { return -1 } |
30 | ||
8223e12c | 31 | standard_ada_testfile formatted_ref |
8d04f9f0 | 32 | |
8d04f9f0 JB |
33 | if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
34 | untested formatted-ref.exp | |
35 | return -1 | |
36 | } | |
37 | ||
38 | proc get_address { var } { | |
39 | global expect_out | |
40 | global gdb_prompt | |
41 | ||
6acb16a2 | 42 | gdb_test_multiple "print $var'access" "address of $var" { |
8d04f9f0 JB |
43 | -re "\\$\[0-9\]+ = \\(.*\\) (0x\[0-9a-f\]+).*$gdb_prompt $" { |
44 | return $expect_out(1,string) | |
8d04f9f0 JB |
45 | } |
46 | } | |
6acb16a2 MS |
47 | perror "couldn't find address of $var" |
48 | return "" | |
8d04f9f0 JB |
49 | } |
50 | ||
51 | proc test_p_x { var val addr } { | |
52 | global gdb_prompt | |
53 | ||
54 | set test "print/x $var" | |
55 | gdb_test_multiple "$test" $test { | |
56 | -re "\\$\[0-9\]+ = [string_to_regexp $val].*$gdb_prompt $" { | |
57 | pass $test | |
58 | } | |
59 | -re "\\$\[0-9\]+ = $addr.*$gdb_prompt $" { | |
60 | fail "$test (prints just address)" | |
61 | } | |
62 | -re "\\$\[0-9\]+ = 0x\[a-f0-9\]+.*$gdb_prompt $" { | |
63 | fail "$test (prints unexpected address)" | |
64 | } | |
65 | } | |
66 | return 0 | |
67 | } | |
68 | ||
69 | proc test_p_x_addr { var addr } { | |
70 | global gdb_prompt | |
71 | ||
4268ec18 TT |
72 | foreach attr {access unchecked_access unrestricted_access} { |
73 | set test "print/x $var'$attr" | |
74 | gdb_test_multiple $test $test { | |
75 | -re "\\$\[0-9\]+ = $addr.*$gdb_prompt $" { | |
76 | pass $test | |
77 | } | |
78 | -re "\\$\[0-9\]+ = 0x\[a-f0-9+\]+.*$gdb_prompt $" { | |
79 | fail "$test (prints unexpected address)" | |
80 | } | |
81 | } | |
8d04f9f0 JB |
82 | } |
83 | return 0 | |
84 | } | |
85 | ||
c332165e JG |
86 | proc test_p_op1_equals_op2 {op1 op2} { |
87 | set test "print $op1 = $op2" | |
88 | gdb_test $test "\\$\[0-9\]+ = true" | |
89 | } | |
90 | ||
09050809 | 91 | clean_restart ${testfile} |
8d04f9f0 | 92 | |
5924fafa TV |
93 | set bp_location \ |
94 | defs.adb:[gdb_get_line_number "marker here" ${testdir}/defs.adb] | |
95 | ||
96 | # Workaround gcc PR101575. | |
97 | #runto $bp_location | |
98 | gdb_breakpoint "$bp_location" | |
99 | gdb_run_cmd | |
100 | set re "Breakpoint $decimal, defs.f1 \\(.*\\) at .*:$decimal.*" | |
101 | set re_xfail "Breakpoint $decimal, defs__struct1IP \\(\\) at .*:$decimal.*" | |
102 | set ok 1 | |
103 | gdb_test_multiple "" "Runto to $bp_location" { | |
104 | -re -wrap $re { | |
105 | if { $ok } { | |
106 | pass $gdb_test_name | |
107 | } else { | |
108 | xfail $gdb_test_name | |
109 | } | |
110 | } | |
111 | -re -wrap $re_xfail { | |
112 | set ok 0 | |
113 | send_gdb "continue\n" | |
114 | exp_continue | |
115 | } | |
116 | } | |
8d04f9f0 JB |
117 | |
118 | set s1_address [get_address "s1"] | |
119 | ||
120 | test_p_x "s" "(x => 0xd, y => 0x13)" $s1_address | |
121 | ||
122 | test_p_x_addr "s" $s1_address | |
c332165e JG |
123 | |
124 | test_p_op1_equals_op2 "s.x" "13" |