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