]>
Commit | Line | Data |
---|---|---|
1d506c26 | 1 | # Copyright 2007-2024 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 | ||
74dcf082 | 29 | require allow_ada_tests |
7a82e903 | 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 | 47 | return "" |
8d04f9f0 JB |
48 | } |
49 | ||
50 | proc test_p_x { var val addr } { | |
51 | global gdb_prompt | |
52 | ||
53 | set test "print/x $var" | |
54 | gdb_test_multiple "$test" $test { | |
55 | -re "\\$\[0-9\]+ = [string_to_regexp $val].*$gdb_prompt $" { | |
56 | pass $test | |
57 | } | |
58 | -re "\\$\[0-9\]+ = $addr.*$gdb_prompt $" { | |
59 | fail "$test (prints just address)" | |
60 | } | |
61 | -re "\\$\[0-9\]+ = 0x\[a-f0-9\]+.*$gdb_prompt $" { | |
62 | fail "$test (prints unexpected address)" | |
63 | } | |
64 | } | |
65 | return 0 | |
66 | } | |
67 | ||
68 | proc test_p_x_addr { var addr } { | |
69 | global gdb_prompt | |
70 | ||
4268ec18 | 71 | foreach attr {access unchecked_access unrestricted_access} { |
45016746 TT |
72 | foreach space {"" " "} { |
73 | set test "print/x $var'$space$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 | } | |
4268ec18 TT |
81 | } |
82 | } | |
8d04f9f0 | 83 | } |
c66ed94a TT |
84 | |
85 | gdb_test "complete print/x $var'unres" "print/x $var'unrestricted_access" | |
86 | gdb_test_no_output "complete print/x $var'abcd" | |
87 | gdb_test "complete print $var'f" "print $var'first" | |
88 | ||
8d04f9f0 JB |
89 | return 0 |
90 | } | |
91 | ||
c332165e JG |
92 | proc test_p_op1_equals_op2 {op1 op2} { |
93 | set test "print $op1 = $op2" | |
94 | gdb_test $test "\\$\[0-9\]+ = true" | |
95 | } | |
96 | ||
09050809 | 97 | clean_restart ${testfile} |
8d04f9f0 | 98 | |
f8788362 TV |
99 | set bp_location \ |
100 | defs.adb:[gdb_get_line_number "marker here" ${testdir}/defs.adb] | |
101 | ||
102 | # Workaround gcc PR101575. | |
103 | #runto $bp_location | |
104 | gdb_breakpoint "$bp_location" | |
105 | gdb_run_cmd | |
106 | set re "Breakpoint $decimal, defs.f1 \\(.*\\) at .*:$decimal.*" | |
107 | set re_xfail "Breakpoint $decimal, defs__struct1IP \\(\\) at .*:$decimal.*" | |
108 | set ok 1 | |
109 | gdb_test_multiple "" "Runto to $bp_location" { | |
110 | -re -wrap $re { | |
111 | if { $ok } { | |
112 | pass $gdb_test_name | |
113 | } else { | |
114 | xfail $gdb_test_name | |
115 | } | |
116 | } | |
117 | -re -wrap $re_xfail { | |
118 | set ok 0 | |
119 | send_gdb "continue\n" | |
120 | exp_continue | |
121 | } | |
122 | } | |
8d04f9f0 JB |
123 | |
124 | set s1_address [get_address "s1"] | |
125 | ||
126 | test_p_x "s" "(x => 0xd, y => 0x13)" $s1_address | |
127 | ||
128 | test_p_x_addr "s" $s1_address | |
c332165e JG |
129 | |
130 | test_p_op1_equals_op2 "s.x" "13" |