Commit | Line | Data |
---|---|---|
f34c8766 | 1 | # Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc. |
19fa4a0a MW |
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., 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
16 | ||
17 | # Please email any bugs, comments, and/or additions to this file to: | |
c79f61db | 18 | # bug-gdb@prep.ai.mit.edu |
19fa4a0a MW |
19 | |
20 | # This file was written by Fred Fish. (fnf@cygnus.com) | |
21 | ||
22 | # Generic gdb subroutines that should work for any target. If these | |
23 | # need to be modified for any target, it can be done with a variable | |
24 | # or by passing arguments. | |
25 | ||
9bcc6c3f RS |
26 | global GDB |
27 | if ![info exists GDB] then { | |
f7ef65ff JK |
28 | if [file exists $base_dir/../gdb] then { |
29 | set GDB $base_dir/../gdb | |
30 | } else { | |
31 | set GDB [transform gdb] | |
32 | } | |
9bcc6c3f RS |
33 | } |
34 | ||
35 | global GDBFLAGS | |
85174909 | 36 | if ![info exists GDBFLAGS] then { |
65424cda | 37 | set GDBFLAGS "-nx" |
85174909 RS |
38 | } |
39 | ||
90fba5fa BC |
40 | # set the prompt if it doesn't exist |
41 | global prompt | |
42 | if ![info exists prompt] then { | |
43 | set prompt "\[(\]gdb\[)\]" | |
44 | } | |
45 | ||
5019a275 | 46 | # |
f34c8766 | 47 | # gdb_version -- extract and print the version number of GDB |
5019a275 RS |
48 | # |
49 | proc default_gdb_version {} { | |
50 | global GDB | |
51 | global GDBFLAGS | |
52 | if {[which $GDB] != 0} then { | |
4081daa1 | 53 | set tmp [exec echo "q" | $GDB -nw $GDBFLAGS] |
85174909 | 54 | regexp " \[0-9\.\]+" $tmp version |
f34c8766 | 55 | clone_output "[which $GDB] version$version -nw $GDBFLAGS \n" |
5019a275 RS |
56 | } else { |
57 | warning "$GDB does not exist" | |
58 | } | |
59 | } | |
60 | ||
19fa4a0a MW |
61 | # |
62 | # gdb_unload -- unload a file if one is loaded | |
63 | # | |
64 | ||
65 | proc gdb_unload {} { | |
66 | global verbose | |
67 | global GDB | |
68 | global prompt | |
69 | send "file\n" | |
70 | expect { | |
9bcc6c3f RS |
71 | -re "No exec file now.*\r" { exp_continue } |
72 | -re "No symbol file now.*\r" { exp_continue } | |
73 | -re "A program is being debugged already..*Kill it.*y or n. $"\ | |
19fa4a0a | 74 | { send "y\n" |
85174909 | 75 | verbose "\t\tKilling previous program being debugged" |
9bcc6c3f | 76 | exp_continue |
19fa4a0a | 77 | } |
9bcc6c3f | 78 | -re "Discard symbol table from .*y or n. $" { |
19fa4a0a | 79 | send "y\n" |
9bcc6c3f | 80 | exp_continue |
19fa4a0a MW |
81 | } |
82 | -re "$prompt $" {} | |
83 | timeout { | |
85174909 | 84 | perror "couldn't unload file in $GDB (timed out)." |
c79f61db | 85 | return -1 |
19fa4a0a MW |
86 | } |
87 | } | |
88 | } | |
89 | ||
90 | # Many of the tests depend on setting breakpoints at various places and | |
91 | # running until that breakpoint is reached. At times, we want to start | |
92 | # with a clean-slate with respect to breakpoints, so this utility proc | |
93 | # lets us do this without duplicating this code everywhere. | |
94 | # | |
95 | ||
96 | proc delete_breakpoints {} { | |
97 | global prompt | |
98 | ||
99 | send "delete breakpoints\n" | |
100 | expect { | |
9bcc6c3f | 101 | -re "Delete all breakpoints.*y or n. $" { |
19fa4a0a | 102 | send "y\n" |
9bcc6c3f | 103 | exp_continue |
19fa4a0a MW |
104 | } |
105 | -re "y\r\n$prompt $" {} | |
31711c69 JK |
106 | -re ".*$prompt $" { # This happens if there were no breakpoints |
107 | } | |
8f07e537 | 108 | timeout { perror "Delete all breakpoints (timeout)" ; return } |
19fa4a0a MW |
109 | } |
110 | send "info breakpoints\n" | |
111 | expect { | |
112 | -re "No breakpoints or watchpoints..*$prompt $" {} | |
9bcc6c3f | 113 | -re ".*$prompt $" { perror "breakpoints not deleted" ; return } |
8f07e537 | 114 | timeout { perror "info breakpoints (timeout)" ; return } |
19fa4a0a MW |
115 | } |
116 | } | |
117 | ||
118 | ||
119 | # | |
70bcd4bc | 120 | # Generic run command. |
809943cf | 121 | # |
70bcd4bc SS |
122 | # The second pattern below matches up to the first newline *only*. |
123 | # Using ``.*$'' could swallow up output that we attempt to match | |
124 | # elsewhere. | |
809943cf C |
125 | # |
126 | proc gdb_run_cmd {} { | |
127 | send "run\n" | |
128 | expect { | |
129 | -re "The program .* has been started already.*y or n. $" { | |
130 | send "y\n" | |
131 | exp_continue | |
132 | } | |
959fea03 | 133 | -re "Starting program: \[^\n\]*" {} |
809943cf C |
134 | } |
135 | } | |
136 | ||
137 | ||
19fa4a0a MW |
138 | # Set breakpoint at function and run gdb until it breaks there. |
139 | # Since this is the only breakpoint that will be set, if it stops | |
140 | # at a breakpoint, we will assume it is the one we want. We can't | |
141 | # just compare to "function" because it might be a fully qualified, | |
142 | # single quoted C++ function specifier. | |
19fa4a0a MW |
143 | |
144 | proc runto { function } { | |
145 | global prompt | |
146 | global decimal | |
147 | ||
148 | send "delete\n" | |
149 | expect { | |
9bcc6c3f | 150 | -re "delete.*Delete all breakpoints.*y or n. $" { |
19fa4a0a MW |
151 | send "y\n" |
152 | expect { | |
153 | -re "$prompt $" {} | |
154 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
155 | } | |
156 | } | |
157 | -re ".*$prompt $" {} | |
158 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
159 | } | |
160 | ||
161 | send "break $function\n" | |
3e304ddf | 162 | # The first two regexps are what we get with -g, the third is without -g. |
19fa4a0a | 163 | expect { |
f34c8766 | 164 | -re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$prompt $" {} |
3e304ddf | 165 | -re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$prompt $" {} |
f34c8766 | 166 | -re "Breakpoint \[0-9\]* at .*$prompt $" {} |
19fa4a0a MW |
167 | -re "$prompt $" { fail "setting breakpoint at $function" ; return 0 } |
168 | timeout { fail "setting breakpoint at $function (timeout)" ; return 0 } | |
169 | } | |
170 | ||
4f2ec2ee C |
171 | gdb_run_cmd |
172 | ||
c79f61db RS |
173 | # the "at foo.c:36" output we get with -g. |
174 | # the "in func" output we get without -g. | |
412c988b | 175 | expect { |
4f2ec2ee C |
176 | -re "Break.* at .*:$decimal.*$prompt $" { |
177 | return 1 | |
412c988b | 178 | } |
c79f61db RS |
179 | -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in $function.*$prompt $" { |
180 | return 1 | |
181 | } | |
4f2ec2ee C |
182 | -re "$prompt $" { |
183 | fail "running to $function" | |
184 | return 0 | |
185 | } | |
186 | timeout { | |
187 | fail "running to $function (timeout)" | |
188 | return 0 | |
189 | } | |
19fa4a0a MW |
190 | } |
191 | } | |
192 | ||
193 | # | |
194 | # gdb_test -- send a command to gdb and test the result. | |
195 | # Takes three parameters. | |
196 | # Parameters: | |
197 | # First one is the command to execute, | |
198 | # Second one is the pattern to match for a PASS, | |
199 | # Third one is an optional message to be printed. If this | |
200 | # a null string "", then the pass/fail messages are not printed. | |
201 | # Returns: | |
202 | # 1 if the test failed, | |
203 | # 0 if the test passes, | |
204 | # -1 if there was an internal error. | |
205 | # | |
206 | proc gdb_test { args } { | |
207 | global verbose | |
208 | global prompt | |
209 | global GDB | |
210 | global spawn_id | |
211 | ||
212 | if [llength $args]==3 then { | |
213 | set message [lindex $args 2] | |
214 | } else { | |
215 | set message [lindex $args 0] | |
216 | } | |
217 | set command [lindex $args 0] | |
218 | set pattern [lindex $args 1] | |
219 | ||
220 | if $verbose>2 then { | |
221 | send_user "Sending \"$command\" to gdb\n" | |
222 | send_user "Looking to match \"$pattern\"\n" | |
223 | send_user "Message is \"$message\"\n" | |
224 | } | |
225 | ||
226 | set result -1 | |
70bcd4bc | 227 | if ![string match $command ""] { |
65424cda | 228 | send "$command\n" |
19fa4a0a MW |
229 | } |
230 | ||
231 | expect { | |
232 | -re ".*Ending remote debugging.*$prompt$" { | |
233 | if ![isnative] then { | |
234 | warning "Can`t communicate to remote target." | |
235 | } | |
236 | gdb_exit | |
237 | gdb_start | |
238 | set result -1 | |
239 | } | |
4081daa1 | 240 | -re "$pattern\r\n$prompt $" { |
19fa4a0a MW |
241 | if ![string match "" $message] then { |
242 | pass "$message" | |
243 | } | |
244 | set result 0 | |
245 | } | |
246 | -re "Undefined command:.*$prompt" { | |
85174909 | 247 | perror "Undefined command \"$command\"." |
c79f61db | 248 | set result 1 |
19fa4a0a MW |
249 | } |
250 | -re "Ambiguous command.*$prompt $" { | |
85174909 | 251 | perror "\"$command\" is not a unique command name." |
c79f61db | 252 | set result 1 |
19fa4a0a MW |
253 | } |
254 | -re ".*$prompt $" { | |
255 | if ![string match "" $message] then { | |
256 | fail "$message" | |
257 | } | |
258 | set result 1 | |
259 | } | |
260 | "<return>" { | |
261 | send "\n" | |
85174909 | 262 | perror "Window too small." |
19fa4a0a | 263 | } |
9bcc6c3f | 264 | -re "\[(\]+y or n\[)\]+ " { |
19fa4a0a | 265 | send "n\n" |
85174909 | 266 | perror "Got interactive prompt." |
19fa4a0a | 267 | } |
c79f61db | 268 | eof { |
85174909 | 269 | perror "Process no longer exists" |
c79f61db RS |
270 | return -1 |
271 | } | |
19fa4a0a | 272 | buffer_full { |
85174909 | 273 | perror "internal buffer is full." |
19fa4a0a | 274 | } |
19fa4a0a | 275 | timeout { |
3e304ddf C |
276 | if ![string match "" $message] then { |
277 | fail "(timeout) $message" | |
278 | } | |
19fa4a0a MW |
279 | set result 1 |
280 | } | |
281 | } | |
282 | return $result | |
283 | } | |
f34c8766 | 284 | \f |
a59f104e | 285 | # Test that a command gives an error. For pass or fail, return |
f34c8766 JK |
286 | # a 1 to indicate that more tests can proceed. However a timeout |
287 | # is a serious error, generates a special fail message, and causes | |
288 | # a 0 to be returned to indicate that more tests are likely to fail | |
289 | # as well. | |
290 | ||
291 | proc test_print_reject { args } { | |
292 | global prompt | |
293 | global verbose | |
294 | ||
295 | if [llength $args]==2 then { | |
296 | set expectthis [lindex $args 1] | |
297 | } else { | |
298 | set expectthis "should never match this bogus string" | |
299 | } | |
300 | set sendthis [lindex $args 0] | |
301 | if $verbose>2 then { | |
302 | send_user "Sending \"$sendthis\" to gdb\n" | |
303 | send_user "Looking to match \"$expectthis\"\n" | |
304 | } | |
305 | send "$sendthis\n" | |
306 | expect { | |
307 | -re ".*A .* in expression.*\\.*$prompt $" { | |
308 | pass "reject $sendthis" | |
309 | return 1 | |
310 | } | |
311 | -re ".*Invalid syntax in expression.*$prompt $" { | |
312 | pass "reject $sendthis" | |
313 | return 1 | |
314 | } | |
315 | -re ".*Junk after end of expression.*$prompt $" { | |
316 | pass "reject $sendthis" | |
317 | return 1 | |
318 | } | |
319 | -re ".*Invalid number.*$prompt $" { | |
320 | pass "reject $sendthis" | |
321 | return 1 | |
322 | } | |
323 | -re ".*Invalid character constant.*$prompt $" { | |
324 | pass "reject $sendthis" | |
325 | return 1 | |
326 | } | |
327 | -re ".*No symbol table is loaded.*$prompt $" { | |
328 | pass "reject $sendthis" | |
329 | return 1 | |
330 | } | |
331 | -re ".*No symbol .* in current context.*$prompt $" { | |
332 | pass "reject $sendthis" | |
333 | return 1 | |
334 | } | |
335 | -re ".*$expectthis.*$prompt $" { | |
336 | pass "reject $sendthis" | |
337 | return 1 | |
338 | } | |
339 | -re ".*$prompt $" { | |
340 | fail "reject $sendthis" | |
341 | return 1 | |
342 | } | |
343 | default { | |
344 | fail "reject $sendthis (eof or timeout)" | |
345 | return 0 | |
346 | } | |
347 | } | |
348 | } | |
349 | \f | |
faa15770 PB |
350 | # Given an input string, adds backslashes as needed to create a |
351 | # regexp that will match the string. | |
3e304ddf | 352 | |
faa15770 | 353 | proc string_to_regexp {str} { |
3e304ddf C |
354 | set result $str |
355 | regsub -all {[]*+.|()^$\[]} $str {\\&} result | |
faa15770 PB |
356 | return $result |
357 | } | |
358 | ||
359 | # Same as gdb_test, but the second parameter is not a regexp, | |
360 | # but a string that must match exactly. | |
361 | ||
362 | proc gdb_test_exact { args } { | |
363 | set command [lindex $args 0] | |
68361314 | 364 | set pattern [string_to_regexp [lindex $args 1]] |
faa15770 PB |
365 | if [llength $args]==3 then { |
366 | set message [lindex $args 2] | |
367 | } else { | |
368 | set message $command | |
369 | } | |
370 | return [gdb_test $command $pattern $message] | |
371 | } | |
f34c8766 | 372 | \f |
19fa4a0a MW |
373 | proc gdb_reinitialize_dir { subdir } { |
374 | global prompt | |
19fa4a0a | 375 | |
85174909 | 376 | send "dir\n" |
19fa4a0a MW |
377 | expect { |
378 | -re "Reinitialize source path to empty.*" { | |
379 | send "y\n" | |
380 | expect { | |
381 | -re "Source directories searched.*$prompt $" { | |
382 | send "dir $subdir\n" | |
383 | expect { | |
384 | -re "Source directories searched.*$prompt $" { | |
85174909 | 385 | verbose "Dir set to $subdir" |
19fa4a0a MW |
386 | } |
387 | -re ".*$prompt $" { | |
85174909 | 388 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
389 | } |
390 | } | |
391 | } | |
392 | -re ".*$prompt $" { | |
85174909 | 393 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
394 | } |
395 | } | |
396 | } | |
397 | -re ".*$prompt $" { | |
85174909 | 398 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
399 | } |
400 | } | |
401 | } | |
c79f61db | 402 | |
c79f61db RS |
403 | # |
404 | # gdb_exit -- exit the GDB, killing the target program if necessary | |
405 | # | |
406 | proc default_gdb_exit {} { | |
407 | global GDB | |
408 | global GDBFLAGS | |
409 | global verbose | |
410 | ||
002cc99f | 411 | verbose "Quitting $GDB $GDBFLAGS" |
c79f61db RS |
412 | |
413 | # This used to be 1 for unix-gdb.exp | |
414 | set timeout 5 | |
415 | ||
90fba5fa BC |
416 | # We used to try to send "quit" to GDB, and wait for it to die. |
417 | # Dealing with all the cases and errors got pretty hairy. Just close it, | |
418 | # that is simpler. | |
419 | close | |
420 | ||
421 | # Omitting this probably would cause strange timing-dependent failures. | |
c79f61db RS |
422 | wait |
423 | } | |
424 | ||
85174909 RS |
425 | # |
426 | # gdb_load -- load a file into the debugger. | |
427 | # return a -1 if anything goes wrong. | |
428 | # | |
429 | proc gdb_file_cmd { arg } { | |
430 | global verbose | |
431 | global loadpath | |
432 | global loadfile | |
433 | global GDB | |
434 | global prompt | |
9bcc6c3f | 435 | global spawn_id |
85174909 RS |
436 | |
437 | send "file $arg\n" | |
438 | expect { | |
439 | -re "Reading symbols from.*done.*$prompt $" { | |
440 | verbose "\t\tLoaded $arg into the $GDB" | |
441 | return 0 | |
442 | } | |
443 | -re "has no symbol-table.*$prompt $" { | |
444 | perror "$arg wasn't compiled with \"-g\"" | |
445 | return -1 | |
446 | } | |
9bcc6c3f | 447 | -re "A program is being debugged already.*Kill it.*y or n. $" { |
85174909 RS |
448 | send "y\n" |
449 | verbose "\t\tKilling previous program being debugged" | |
9bcc6c3f | 450 | exp_continue |
85174909 | 451 | } |
9bcc6c3f | 452 | -re "Load new symbol table from \".*\".*y or n. $" { |
85174909 RS |
453 | send "y\n" |
454 | expect { | |
455 | -re "Reading symbols from.*done.*$prompt $" { | |
456 | verbose "\t\tLoaded $arg with new symbol table into $GDB" | |
457 | return 0 | |
458 | } | |
459 | timeout { | |
460 | perror "(timeout) Couldn't load $arg, other program already l | |
461 | oaded." | |
462 | return -1 | |
463 | } | |
464 | } | |
465 | } | |
466 | -re ".*No such file or directory.*$prompt $" { | |
467 | perror "($arg) No such file or directory\n" | |
468 | return -1 | |
469 | } | |
470 | -re "$prompt $" { | |
471 | perror "couldn't load $arg into $GDB." | |
472 | return -1 | |
473 | } | |
474 | timeout { | |
9bcc6c3f | 475 | perror "couldn't load $arg into $GDB (timed out)." |
85174909 RS |
476 | return -1 |
477 | } | |
478 | eof { | |
479 | # This is an attempt to detect a core dump, but seems not to | |
480 | # work. Perhaps we need to match .* followed by eof, in which | |
481 | # expect does not seem to have a way to do that. | |
8f07e537 | 482 | perror "couldn't load $arg into $GDB (end of file)." |
85174909 RS |
483 | return -1 |
484 | } | |
485 | } | |
486 | } | |
c79f61db | 487 | |
0fba9aa2 SS |
488 | # |
489 | # start gdb -- start gdb running, default procedure | |
490 | # | |
491 | proc default_gdb_start { } { | |
492 | global verbose | |
493 | global GDB | |
494 | global GDBFLAGS | |
495 | global prompt | |
496 | global spawn_id | |
497 | global timeout | |
f34c8766 | 498 | verbose "Spawning $GDB -nw $GDBFLAGS" |
3e304ddf C |
499 | |
500 | if { [which $GDB] == 0 } then { | |
501 | perror "$GDB does not exist." | |
502 | exit 1 | |
503 | } | |
0fba9aa2 SS |
504 | |
505 | set oldtimeout $timeout | |
506 | set timeout [expr "$timeout + 60"] | |
f34c8766 | 507 | eval "spawn $GDB -nw $GDBFLAGS" |
0fba9aa2 SS |
508 | expect { |
509 | -re ".*\r\n$prompt $" { | |
3e304ddf | 510 | verbose "GDB initialized." |
0fba9aa2 SS |
511 | } |
512 | -re "$prompt $" { | |
513 | perror "GDB never initialized." | |
514 | return -1 | |
515 | } | |
516 | timeout { | |
517 | perror "(timeout) GDB never initialized." | |
518 | return -1 | |
519 | } | |
520 | } | |
521 | set timeout $oldtimeout | |
522 | # force the height to "unlimited", so no pagers get used | |
523 | send "set height 0\n" | |
524 | expect { | |
525 | -re ".*$prompt $" { | |
526 | verbose "Setting height to 0." 2 | |
527 | } | |
528 | timeout { | |
529 | warning "Couldn't set the height to 0." | |
530 | } | |
531 | } | |
532 | # force the width to "unlimited", so no wraparound occurs | |
533 | send "set width 0\n" | |
534 | expect { | |
535 | -re ".*$prompt $" { | |
536 | verbose "Seting width to 0." 2 | |
537 | } | |
538 | timeout { | |
539 | warning "Couldn't set the width to 0." | |
540 | } | |
541 | } | |
542 | } | |
543 | ||
9bcc6c3f RS |
544 | # |
545 | # FIXME: this is a copy of the new library procedure, but it's here too | |
546 | # till the new dejagnu gets installed everywhere. I'd hate to break the | |
547 | # gdb tests suite. | |
548 | # | |
002cc99f RS |
549 | global argv0 |
550 | if ![info exists argv0] then { | |
9bcc6c3f RS |
551 | proc exp_continue { } { |
552 | continue -expect | |
553 | } | |
554 | } | |
c79f61db | 555 | |
4081daa1 | 556 | proc skip_chill_tests {} { |
96528ad5 JK |
557 | # For crosses, the CHILL runtime doesn't build because it can't find |
558 | # setjmp.h, stdio.h, etc. | |
559 | # For AIX (as of 16 Mar 95), (a) there is no language code for | |
560 | # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2 | |
561 | # does not get along with AIX's too-clever linker. | |
f2ee99a4 JK |
562 | # On Solaris, static constructors are broken. |
563 | return {![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-solaris2*"]} | |
4081daa1 | 564 | } |