Commit | Line | Data |
---|---|---|
7b6bb8da JB |
1 | # Copyright (C) 1998, 2007, 2008, 2009, 2010, 2011 |
2 | # Free Software Foundation, Inc. | |
c906108c SS |
3 | |
4 | # This program is free software; you can redistribute it and/or modify | |
5 | # it under the terms of the GNU General Public License as published by | |
e22f8b7c | 6 | # the Free Software Foundation; either version 3 of the License, or |
c906108c | 7 | # (at your option) any later version. |
e22f8b7c | 8 | # |
c906108c SS |
9 | # This program is distributed in the hope that it will be useful, |
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | # GNU General Public License for more details. | |
e22f8b7c | 13 | # |
c906108c | 14 | # You should have received a copy of the GNU General Public License |
e22f8b7c | 15 | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
c906108c | 16 | |
c906108c SS |
17 | |
18 | # | |
19 | # Support procedures for trace testing | |
20 | # | |
21 | ||
22 | ||
23 | # | |
24 | # Procedure: gdb_target_supports_trace | |
25 | # Returns true if GDB is connected to a target that supports tracing. | |
26 | # Allows tests to abort early if not running on a trace-aware target. | |
27 | # | |
28 | ||
29 | proc gdb_target_supports_trace { } { | |
30 | global gdb_prompt | |
31 | ||
32 | send_gdb "tstatus\n" | |
33 | gdb_expect { | |
34 | -re "\[Tt\]race can only be run on.*$gdb_prompt $" { | |
35 | return 0 | |
36 | } | |
37 | -re "\[Tt\]race can not be run on.*$gdb_prompt $" { | |
38 | return 0 | |
39 | } | |
40 | -re "\[Tt\]arget does not support.*$gdb_prompt $" { | |
41 | return 0 | |
42 | } | |
43 | -re ".*\[Ee\]rror.*$gdb_prompt $" { | |
44 | return 0 | |
45 | } | |
46 | -re ".*\[Ww\]arning.*$gdb_prompt $" { | |
47 | return 0 | |
48 | } | |
49 | -re ".*$gdb_prompt $" { | |
50 | return 1 | |
51 | } | |
52 | timeout { | |
53 | return 0 | |
54 | } | |
55 | } | |
56 | } | |
57 | ||
58 | ||
59 | # | |
60 | # Procedure: gdb_delete_tracepoints | |
61 | # Many of the tests depend on setting tracepoints at various places and | |
62 | # running until that tracepoint is reached. At times, we want to start | |
63 | # with a clean slate with respect to tracepoints, so this utility proc | |
64 | # lets us do this without duplicating this code everywhere. | |
65 | # | |
66 | ||
67 | proc gdb_delete_tracepoints {} { | |
68 | global gdb_prompt | |
69 | ||
70 | send_gdb "delete tracepoints\n" | |
71 | gdb_expect 30 { | |
72 | -re "Delete all tracepoints.*y or n.*$" { | |
73 | send_gdb "y\n"; | |
74 | exp_continue | |
75 | } | |
76 | -re ".*$gdb_prompt $" { # This happens if there were no tracepoints } | |
77 | timeout { | |
78 | perror "Delete all tracepoints in delete_tracepoints (timeout)" | |
79 | return | |
80 | } | |
81 | } | |
82 | send_gdb "info tracepoints\n" | |
83 | gdb_expect 30 { | |
84 | -re "No tracepoints.*$gdb_prompt $" {} | |
85 | -re "$gdb_prompt $" { perror "tracepoints not deleted" ; return } | |
86 | timeout { perror "info tracepoints (timeout)" ; return } | |
87 | } | |
88 | } | |
89 | ||
90 | # | |
91 | # Procedure: gdb_trace_setactions | |
92 | # Define actions for a tracepoint. | |
93 | # Arguments: | |
94 | # testname -- identifying string for pass/fail output | |
95 | # tracepoint -- to which tracepoint do these actions apply? (optional) | |
96 | # args -- list of actions to be defined. | |
97 | # Returns: | |
98 | # zero -- success | |
99 | # non-zero -- failure | |
100 | ||
101 | proc gdb_trace_setactions { testname tracepoint args } { | |
102 | global gdb_prompt; | |
103 | ||
104 | set state 0; | |
105 | set passfail "pass"; | |
106 | send_gdb "actions $tracepoint\n"; | |
107 | set expected_result ""; | |
108 | gdb_expect 5 { | |
109 | -re "No tracepoint number .*$gdb_prompt $" { | |
110 | fail $testname | |
111 | return 1; | |
112 | } | |
113 | -re "Enter actions for tracepoint $tracepoint.*>" { | |
114 | if { [llength $args] > 0 } { | |
115 | set lastcommand "[lindex $args $state]"; | |
116 | send_gdb "[lindex $args $state]\n"; | |
117 | incr state; | |
118 | set expected_result [lindex $args $state]; | |
119 | incr state; | |
120 | } else { | |
121 | send_gdb "end\n"; | |
122 | } | |
123 | exp_continue; | |
124 | } | |
a7bdde9e | 125 | -re "\(.*\)\[\r\n\]+\[ \t]*>$" { |
c906108c SS |
126 | if { $expected_result != "" } { |
127 | regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out; | |
128 | if ![regexp $expected_result $out] { | |
129 | set passfail "fail"; | |
130 | } | |
131 | set expected_result ""; | |
132 | } | |
133 | if { $state < [llength $args] } { | |
134 | send_gdb "[lindex $args $state]\n"; | |
135 | incr state; | |
136 | set expected_result [lindex $args $state]; | |
137 | incr state; | |
138 | } else { | |
139 | send_gdb "end\n"; | |
140 | set expected_result ""; | |
141 | } | |
142 | exp_continue; | |
143 | } | |
144 | -re "\(.*\)$gdb_prompt $" { | |
145 | if { $expected_result != "" } { | |
146 | if ![regexp $expected_result $expect_out(1,string)] { | |
147 | set passfail "fail"; | |
148 | } | |
149 | set expected_result ""; | |
150 | } | |
151 | if { [llength $args] < $state } { | |
152 | set passfail "fail"; | |
153 | } | |
154 | } | |
155 | default { | |
156 | set passfail "fail"; | |
157 | } | |
158 | } | |
159 | if { $testname != "" } { | |
160 | $passfail $testname; | |
161 | } | |
162 | if { $passfail == "pass" } then { | |
163 | return 0; | |
164 | } else { | |
165 | return 1; | |
166 | } | |
167 | } | |
168 | ||
169 | # | |
170 | # Procedure: gdb_tfind_test | |
171 | # Find a specified trace frame. | |
172 | # Arguments: | |
173 | # testname -- identifying string for pass/fail output | |
174 | # tfind_arg -- frame (line, PC, etc.) identifier | |
175 | # exp_res -- Expected result of frame test | |
176 | # args -- Test expression | |
177 | # Returns: | |
178 | # zero -- success | |
179 | # non-zero -- failure | |
180 | # | |
181 | ||
182 | proc gdb_tfind_test { testname tfind_arg exp_res args } { | |
183 | global gdb_prompt; | |
184 | ||
185 | if { "$args" != "" } { | |
186 | set expr "$exp_res"; | |
187 | set exp_res "$args"; | |
188 | } else { | |
189 | set expr "(int) \$trace_frame"; | |
190 | } | |
191 | set passfail "fail"; | |
192 | ||
193 | gdb_test "tfind $tfind_arg" "" "" | |
194 | send_gdb "printf \"x \%d x\\n\", $expr\n"; | |
195 | gdb_expect 10 { | |
196 | -re "x (-*\[0-9\]+) x" { | |
197 | if { $expect_out(1,string) == $exp_res } { | |
198 | set passfail "pass"; | |
199 | } | |
200 | exp_continue; | |
201 | } | |
202 | -re "$gdb_prompt $" { } | |
203 | } | |
204 | $passfail "$testname"; | |
205 | if { $passfail == "pass" } then { | |
206 | return 0; | |
207 | } else { | |
208 | return 1; | |
209 | } | |
210 | } | |
211 | ||
212 | # | |
213 | # Procedure: gdb_readexpr | |
214 | # Arguments: | |
215 | # gdb_expr -- the expression whose value is desired | |
216 | # Returns: | |
217 | # the value of gdb_expr, as evaluated by gdb. | |
218 | # [FIXME: returns -1 on error, which is sometimes a legit value] | |
219 | # | |
220 | ||
221 | proc gdb_readexpr { gdb_expr } { | |
222 | global gdb_prompt; | |
223 | ||
224 | set result -1; | |
225 | send_gdb "print $gdb_expr\n" | |
226 | gdb_expect 5 { | |
227 | -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" { | |
228 | set result $expect_out(1,string); | |
229 | } | |
230 | -re "$gdb_prompt $" { } | |
231 | default { } | |
232 | } | |
233 | return $result; | |
234 | } | |
235 | ||
236 | # | |
237 | # Procedure: gdb_gettpnum | |
238 | # Arguments: | |
239 | # tracepoint (optional): if supplied, set a tracepoint here. | |
240 | # Returns: | |
241 | # the tracepoint ID of the most recently set tracepoint. | |
242 | # | |
243 | ||
244 | proc gdb_gettpnum { tracepoint } { | |
245 | global gdb_prompt; | |
246 | ||
247 | if { $tracepoint != "" } { | |
248 | gdb_test "trace $tracepoint" "" "" | |
249 | } | |
250 | return [gdb_readexpr "\$tpnum"]; | |
251 | } | |
252 | ||
253 | ||
254 | # | |
255 | # Procedure: gdb_find_function_baseline | |
256 | # Arguments: | |
257 | # func_name -- name of source function | |
258 | # Returns: | |
259 | # Sourcefile line of function definition (open curly brace), | |
260 | # or -1 on failure. Caller must check return value. | |
261 | # Note: | |
262 | # Works only for open curly brace at beginning of source line! | |
263 | # | |
264 | ||
265 | proc gdb_find_function_baseline { func_name } { | |
266 | global gdb_prompt; | |
267 | ||
268 | set baseline -1; | |
269 | ||
270 | send_gdb "list $func_name\n" | |
271 | # gdb_expect { | |
272 | # -re "\[\r\n\]\[\{\].*$gdb_prompt $" { | |
273 | # set baseline 1 | |
274 | # } | |
275 | # } | |
276 | } | |
277 | ||
278 | # | |
279 | # Procedure: gdb_find_function_baseline | |
280 | # Arguments: | |
281 | # filename: name of source file of desired function. | |
282 | # Returns: | |
283 | # Sourcefile line of function definition (open curly brace), | |
284 | # or -1 on failure. Caller must check return value. | |
285 | # Note: | |
286 | # Works only for open curly brace at beginning of source line! | |
287 | # | |
288 | ||
289 | proc gdb_find_recursion_test_baseline { filename } { | |
290 | global gdb_prompt; | |
291 | ||
292 | set baseline -1; | |
293 | ||
294 | gdb_test "list $filename:1" "" "" | |
295 | send_gdb "search gdb_recursion_test line 0\n" | |
296 | gdb_expect { | |
297 | -re "(\[0-9\]+)\[\t \]+\{.*line 0.*$gdb_prompt $" { | |
298 | set baseline $expect_out(1,string); | |
299 | } | |
300 | -re "$gdb_prompt $" { } | |
301 | default { } | |
302 | } | |
303 | return $baseline; | |
304 | } |