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