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 | |
4771fe15 | 15 | # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ |
19fa4a0a MW |
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 | ||
4771fe15 JL |
26 | load_lib libgloss.exp |
27 | ||
9bcc6c3f | 28 | global GDB |
4771fe15 JL |
29 | global CC |
30 | global CXX | |
31 | global CFLAGS | |
32 | global CXXFLAGS | |
33 | global CHILL_LIB | |
34 | global CHILL_RT0 | |
35 | ||
36 | if ![info exists CC] { | |
37 | set CC [findfile $base_dir/../../gcc/xgcc "$base_dir/../../gcc/xgcc -B$base_dir/../../gcc/" [transform gcc]] | |
4771fe15 | 38 | } |
a26fa899 | 39 | verbose "using CC = $CC" 2 |
4771fe15 JL |
40 | if ![info exists CXX] { |
41 | set CXX [findfile $base_dir/../../gcc/xgcc "$base_dir/../../gcc/xgcc -B$base_dir/../../gcc/" [transform g++]] | |
4771fe15 | 42 | } |
a26fa899 | 43 | verbose "using CXX = $CXX" 2 |
4771fe15 JL |
44 | if ![info exists CHILL_LIB] { |
45 | set CHILL_LIB [findfile $base_dir/../../gcc/ch/runtime/libchill.a "$base_dir/../../gcc/ch/runtime/libchill.a" [transform -lchill]] | |
4771fe15 | 46 | } |
a26fa899 | 47 | verbose "using CHILL_LIB = $CHILL_LIB" 2 |
4771fe15 JL |
48 | if ![info exists CHILL_RT0] { |
49 | set CHILL_RT0 [findfile $base_dir/../../gcc/ch/runtime/chillrt0.o "$base_dir/../../gcc/ch/runtime/chillrt0.o" ""] | |
4771fe15 | 50 | } |
a26fa899 | 51 | verbose "using CHILL_RT0 = $CHILL_RT0" 2 |
4771fe15 JL |
52 | |
53 | if ![info exists LDFLAGS] { | |
54 | if [is3way] { | |
55 | append LDFLAGS " [libgloss_flags] [newlib_flags]" | |
f7ef65ff | 56 | } |
4771fe15 | 57 | set LDFLAGS "" |
4771fe15 | 58 | } |
a26fa899 | 59 | verbose "using LDFLAGS = $LDFLAGS" 2 |
4771fe15 JL |
60 | |
61 | if ![info exists GDB] then { | |
62 | set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]] | |
9bcc6c3f | 63 | } |
a26fa899 | 64 | verbose "using GDB = $GDB" 2 |
4771fe15 | 65 | |
9bcc6c3f | 66 | global GDBFLAGS |
85174909 | 67 | if ![info exists GDBFLAGS] then { |
65424cda | 68 | set GDBFLAGS "-nx" |
85174909 | 69 | } |
a26fa899 | 70 | verbose "using GDBFLAGS = $GDBFLAGS" 2 |
85174909 | 71 | |
8c7ab5da JK |
72 | # The variable prompt is a regexp which matches the gdb prompt. Set it if it |
73 | # is not already set. | |
90fba5fa BC |
74 | global prompt |
75 | if ![info exists prompt] then { | |
8c7ab5da | 76 | set prompt "\\(gdb\\)" |
90fba5fa BC |
77 | } |
78 | ||
120edc2f KH |
79 | global usestubs |
80 | if [istarget "sparclite-*-*"] then { | |
81 | set usestubs 1 | |
82 | } else { | |
83 | set usestubs 0 | |
84 | } | |
85 | ||
86 | if ![info exists noargs] then { | |
87 | set noargs 0 | |
88 | } | |
89 | ||
4771fe15 JL |
90 | if ![info exists nosignals] then { |
91 | set nosignals 0 | |
92 | } | |
93 | ||
94 | if ![info exists noinferiorio] then { | |
95 | set noinferiorio 0 | |
96 | } | |
97 | ||
a26fa899 FF |
98 | if ![info exists noresults] then { |
99 | set noresults 0 | |
100 | } | |
101 | ||
5019a275 | 102 | # |
f34c8766 | 103 | # gdb_version -- extract and print the version number of GDB |
5019a275 RS |
104 | # |
105 | proc default_gdb_version {} { | |
106 | global GDB | |
107 | global GDBFLAGS | |
108 | if {[which $GDB] != 0} then { | |
4081daa1 | 109 | set tmp [exec echo "q" | $GDB -nw $GDBFLAGS] |
b34b32e7 | 110 | regexp " \[0-9\]\[^ \t\n\]+" $tmp version |
f34c8766 | 111 | clone_output "[which $GDB] version$version -nw $GDBFLAGS \n" |
5019a275 RS |
112 | } else { |
113 | warning "$GDB does not exist" | |
114 | } | |
115 | } | |
116 | ||
19fa4a0a MW |
117 | # |
118 | # gdb_unload -- unload a file if one is loaded | |
119 | # | |
120 | ||
121 | proc gdb_unload {} { | |
122 | global verbose | |
123 | global GDB | |
124 | global prompt | |
125 | send "file\n" | |
126 | expect { | |
9bcc6c3f RS |
127 | -re "No exec file now.*\r" { exp_continue } |
128 | -re "No symbol file now.*\r" { exp_continue } | |
129 | -re "A program is being debugged already..*Kill it.*y or n. $"\ | |
19fa4a0a | 130 | { send "y\n" |
85174909 | 131 | verbose "\t\tKilling previous program being debugged" |
9bcc6c3f | 132 | exp_continue |
19fa4a0a | 133 | } |
9bcc6c3f | 134 | -re "Discard symbol table from .*y or n. $" { |
19fa4a0a | 135 | send "y\n" |
9bcc6c3f | 136 | exp_continue |
19fa4a0a MW |
137 | } |
138 | -re "$prompt $" {} | |
139 | timeout { | |
85174909 | 140 | perror "couldn't unload file in $GDB (timed out)." |
c79f61db | 141 | return -1 |
19fa4a0a MW |
142 | } |
143 | } | |
144 | } | |
145 | ||
146 | # Many of the tests depend on setting breakpoints at various places and | |
147 | # running until that breakpoint is reached. At times, we want to start | |
148 | # with a clean-slate with respect to breakpoints, so this utility proc | |
149 | # lets us do this without duplicating this code everywhere. | |
150 | # | |
151 | ||
152 | proc delete_breakpoints {} { | |
153 | global prompt | |
154 | ||
155 | send "delete breakpoints\n" | |
156 | expect { | |
9bcc6c3f | 157 | -re "Delete all breakpoints.*y or n. $" { |
19fa4a0a | 158 | send "y\n" |
9bcc6c3f | 159 | exp_continue |
19fa4a0a MW |
160 | } |
161 | -re "y\r\n$prompt $" {} | |
31711c69 JK |
162 | -re ".*$prompt $" { # This happens if there were no breakpoints |
163 | } | |
8f07e537 | 164 | timeout { perror "Delete all breakpoints (timeout)" ; return } |
19fa4a0a MW |
165 | } |
166 | send "info breakpoints\n" | |
167 | expect { | |
168 | -re "No breakpoints or watchpoints..*$prompt $" {} | |
9bcc6c3f | 169 | -re ".*$prompt $" { perror "breakpoints not deleted" ; return } |
8f07e537 | 170 | timeout { perror "info breakpoints (timeout)" ; return } |
19fa4a0a MW |
171 | } |
172 | } | |
173 | ||
174 | ||
175 | # | |
70bcd4bc | 176 | # Generic run command. |
809943cf | 177 | # |
70bcd4bc SS |
178 | # The second pattern below matches up to the first newline *only*. |
179 | # Using ``.*$'' could swallow up output that we attempt to match | |
180 | # elsewhere. | |
809943cf C |
181 | # |
182 | proc gdb_run_cmd {} { | |
065924f7 KH |
183 | global usestubs |
184 | global prompt | |
185 | ||
186 | if $usestubs!=0 { | |
187 | send "jump *start\n" | |
188 | expect { | |
189 | -re "Line.* Jump anyway.*y or n. $" { | |
190 | send "y\n" | |
191 | expect { | |
192 | -re "Continuing.*$prompt $" {} | |
a26fa899 | 193 | timeout { perror "Jump to start() failed (timeout)"; return } |
065924f7 KH |
194 | } |
195 | } | |
196 | timeout { perror "Jump to start() failed (timeout)"; return } | |
197 | } | |
198 | send "continue\n" | |
199 | return | |
200 | } | |
809943cf C |
201 | send "run\n" |
202 | expect { | |
203 | -re "The program .* has been started already.*y or n. $" { | |
204 | send "y\n" | |
205 | exp_continue | |
206 | } | |
959fea03 | 207 | -re "Starting program: \[^\n\]*" {} |
809943cf C |
208 | } |
209 | } | |
210 | ||
211 | ||
19fa4a0a MW |
212 | # Set breakpoint at function and run gdb until it breaks there. |
213 | # Since this is the only breakpoint that will be set, if it stops | |
214 | # at a breakpoint, we will assume it is the one we want. We can't | |
215 | # just compare to "function" because it might be a fully qualified, | |
216 | # single quoted C++ function specifier. | |
19fa4a0a MW |
217 | |
218 | proc runto { function } { | |
219 | global prompt | |
220 | global decimal | |
221 | ||
222 | send "delete\n" | |
223 | expect { | |
9bcc6c3f | 224 | -re "delete.*Delete all breakpoints.*y or n. $" { |
19fa4a0a MW |
225 | send "y\n" |
226 | expect { | |
227 | -re "$prompt $" {} | |
228 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
229 | } | |
230 | } | |
231 | -re ".*$prompt $" {} | |
232 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
233 | } | |
234 | ||
235 | send "break $function\n" | |
3e304ddf | 236 | # The first two regexps are what we get with -g, the third is without -g. |
19fa4a0a | 237 | expect { |
f34c8766 | 238 | -re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$prompt $" {} |
3e304ddf | 239 | -re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$prompt $" {} |
f34c8766 | 240 | -re "Breakpoint \[0-9\]* at .*$prompt $" {} |
19fa4a0a MW |
241 | -re "$prompt $" { fail "setting breakpoint at $function" ; return 0 } |
242 | timeout { fail "setting breakpoint at $function (timeout)" ; return 0 } | |
243 | } | |
244 | ||
4f2ec2ee C |
245 | gdb_run_cmd |
246 | ||
c79f61db RS |
247 | # the "at foo.c:36" output we get with -g. |
248 | # the "in func" output we get without -g. | |
412c988b | 249 | expect { |
4f2ec2ee C |
250 | -re "Break.* at .*:$decimal.*$prompt $" { |
251 | return 1 | |
412c988b | 252 | } |
c79f61db RS |
253 | -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in $function.*$prompt $" { |
254 | return 1 | |
255 | } | |
4f2ec2ee C |
256 | -re "$prompt $" { |
257 | fail "running to $function" | |
258 | return 0 | |
259 | } | |
260 | timeout { | |
261 | fail "running to $function (timeout)" | |
262 | return 0 | |
263 | } | |
19fa4a0a MW |
264 | } |
265 | } | |
266 | ||
120edc2f KH |
267 | # |
268 | # runto_main -- ask gdb to run and untill hit break point at main. | |
269 | # if it uses stubs, assuming we hit breakpoint() and just | |
270 | # step out of the function. | |
271 | # | |
272 | proc runto_main {} { | |
273 | global prompt | |
274 | global decimal | |
275 | global usestubs | |
276 | ||
277 | if $usestubs==0 { | |
278 | runto main | |
279 | return 1 | |
280 | } | |
281 | ||
282 | send "delete\n" | |
283 | expect { | |
284 | -re "delete.*Delete all breakpoints.*y or n. $" { | |
285 | send "y\n" | |
286 | expect { | |
287 | -re "$prompt $" {} | |
288 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
289 | } | |
290 | } | |
291 | -re ".*$prompt $" {} | |
292 | timeout { fail "deleting breakpoints (timeout)" ; return 0 } | |
293 | } | |
294 | ||
295 | send "step\n" | |
296 | # if use stubs step out of the breakpoint() function. | |
297 | expect { | |
3c23a941 | 298 | -re "main.* at .*$prompt $" {} |
120edc2f KH |
299 | timeout { fail "single step at breakpoint() (timeout)" ; return 0 } |
300 | } | |
3c23a941 | 301 | return 1 |
120edc2f KH |
302 | } |
303 | ||
19fa4a0a MW |
304 | # |
305 | # gdb_test -- send a command to gdb and test the result. | |
306 | # Takes three parameters. | |
307 | # Parameters: | |
308 | # First one is the command to execute, | |
5fac6a39 FF |
309 | # Second one is the pattern to match for a PASS, and must NOT include |
310 | # the \r\n sequence immediately before the gdb prompt. | |
19fa4a0a MW |
311 | # Third one is an optional message to be printed. If this |
312 | # a null string "", then the pass/fail messages are not printed. | |
313 | # Returns: | |
314 | # 1 if the test failed, | |
315 | # 0 if the test passes, | |
316 | # -1 if there was an internal error. | |
317 | # | |
318 | proc gdb_test { args } { | |
319 | global verbose | |
320 | global prompt | |
321 | global GDB | |
322 | global spawn_id | |
4771fe15 | 323 | upvar timeout timeout |
19fa4a0a MW |
324 | |
325 | if [llength $args]==3 then { | |
326 | set message [lindex $args 2] | |
327 | } else { | |
328 | set message [lindex $args 0] | |
329 | } | |
330 | set command [lindex $args 0] | |
331 | set pattern [lindex $args 1] | |
332 | ||
333 | if $verbose>2 then { | |
334 | send_user "Sending \"$command\" to gdb\n" | |
335 | send_user "Looking to match \"$pattern\"\n" | |
336 | send_user "Message is \"$message\"\n" | |
337 | } | |
338 | ||
339 | set result -1 | |
70bcd4bc | 340 | if ![string match $command ""] { |
65424cda | 341 | send "$command\n" |
19fa4a0a MW |
342 | } |
343 | ||
344 | expect { | |
345 | -re ".*Ending remote debugging.*$prompt$" { | |
346 | if ![isnative] then { | |
347 | warning "Can`t communicate to remote target." | |
348 | } | |
349 | gdb_exit | |
350 | gdb_start | |
351 | set result -1 | |
352 | } | |
4081daa1 | 353 | -re "$pattern\r\n$prompt $" { |
19fa4a0a MW |
354 | if ![string match "" $message] then { |
355 | pass "$message" | |
356 | } | |
357 | set result 0 | |
358 | } | |
359 | -re "Undefined command:.*$prompt" { | |
85174909 | 360 | perror "Undefined command \"$command\"." |
c79f61db | 361 | set result 1 |
19fa4a0a MW |
362 | } |
363 | -re "Ambiguous command.*$prompt $" { | |
85174909 | 364 | perror "\"$command\" is not a unique command name." |
c79f61db | 365 | set result 1 |
19fa4a0a MW |
366 | } |
367 | -re ".*$prompt $" { | |
368 | if ![string match "" $message] then { | |
369 | fail "$message" | |
370 | } | |
371 | set result 1 | |
372 | } | |
373 | "<return>" { | |
374 | send "\n" | |
85174909 | 375 | perror "Window too small." |
19fa4a0a | 376 | } |
8c7ab5da | 377 | -re "\\(y or n\\) " { |
19fa4a0a | 378 | send "n\n" |
85174909 | 379 | perror "Got interactive prompt." |
19fa4a0a | 380 | } |
c79f61db | 381 | eof { |
85174909 | 382 | perror "Process no longer exists" |
c79f61db RS |
383 | return -1 |
384 | } | |
19fa4a0a | 385 | buffer_full { |
85174909 | 386 | perror "internal buffer is full." |
19fa4a0a | 387 | } |
19fa4a0a | 388 | timeout { |
3e304ddf C |
389 | if ![string match "" $message] then { |
390 | fail "(timeout) $message" | |
391 | } | |
19fa4a0a MW |
392 | set result 1 |
393 | } | |
394 | } | |
395 | return $result | |
396 | } | |
f34c8766 | 397 | \f |
a59f104e | 398 | # Test that a command gives an error. For pass or fail, return |
f34c8766 JK |
399 | # a 1 to indicate that more tests can proceed. However a timeout |
400 | # is a serious error, generates a special fail message, and causes | |
401 | # a 0 to be returned to indicate that more tests are likely to fail | |
402 | # as well. | |
403 | ||
404 | proc test_print_reject { args } { | |
405 | global prompt | |
406 | global verbose | |
407 | ||
408 | if [llength $args]==2 then { | |
409 | set expectthis [lindex $args 1] | |
410 | } else { | |
411 | set expectthis "should never match this bogus string" | |
412 | } | |
413 | set sendthis [lindex $args 0] | |
414 | if $verbose>2 then { | |
415 | send_user "Sending \"$sendthis\" to gdb\n" | |
416 | send_user "Looking to match \"$expectthis\"\n" | |
417 | } | |
418 | send "$sendthis\n" | |
419 | expect { | |
420 | -re ".*A .* in expression.*\\.*$prompt $" { | |
421 | pass "reject $sendthis" | |
422 | return 1 | |
423 | } | |
424 | -re ".*Invalid syntax in expression.*$prompt $" { | |
425 | pass "reject $sendthis" | |
426 | return 1 | |
427 | } | |
428 | -re ".*Junk after end of expression.*$prompt $" { | |
429 | pass "reject $sendthis" | |
430 | return 1 | |
431 | } | |
432 | -re ".*Invalid number.*$prompt $" { | |
433 | pass "reject $sendthis" | |
434 | return 1 | |
435 | } | |
436 | -re ".*Invalid character constant.*$prompt $" { | |
437 | pass "reject $sendthis" | |
438 | return 1 | |
439 | } | |
440 | -re ".*No symbol table is loaded.*$prompt $" { | |
441 | pass "reject $sendthis" | |
442 | return 1 | |
443 | } | |
444 | -re ".*No symbol .* in current context.*$prompt $" { | |
445 | pass "reject $sendthis" | |
446 | return 1 | |
447 | } | |
448 | -re ".*$expectthis.*$prompt $" { | |
449 | pass "reject $sendthis" | |
450 | return 1 | |
451 | } | |
452 | -re ".*$prompt $" { | |
453 | fail "reject $sendthis" | |
454 | return 1 | |
455 | } | |
456 | default { | |
457 | fail "reject $sendthis (eof or timeout)" | |
458 | return 0 | |
459 | } | |
460 | } | |
461 | } | |
462 | \f | |
faa15770 PB |
463 | # Given an input string, adds backslashes as needed to create a |
464 | # regexp that will match the string. | |
3e304ddf | 465 | |
faa15770 | 466 | proc string_to_regexp {str} { |
3e304ddf C |
467 | set result $str |
468 | regsub -all {[]*+.|()^$\[]} $str {\\&} result | |
faa15770 PB |
469 | return $result |
470 | } | |
471 | ||
472 | # Same as gdb_test, but the second parameter is not a regexp, | |
473 | # but a string that must match exactly. | |
474 | ||
475 | proc gdb_test_exact { args } { | |
4771fe15 JL |
476 | upvar timeout timeout |
477 | ||
faa15770 | 478 | set command [lindex $args 0] |
68361314 | 479 | set pattern [string_to_regexp [lindex $args 1]] |
e7dc69ff FF |
480 | # It is most natural to write the pattern argument with only |
481 | # embedded \n's, especially if you are trying to avoid Tcl quoting | |
482 | # problems. But expect really wants to see \r\n in patterns. So | |
483 | # transform the pattern here. First transform \r\n back to \n, in | |
484 | # case some users of gdb_test_exact already do the right thing. | |
485 | regsub -all "\r\n" $pattern "\n" pattern | |
486 | regsub -all "\n" $pattern "\r\n" pattern | |
faa15770 PB |
487 | if [llength $args]==3 then { |
488 | set message [lindex $args 2] | |
489 | } else { | |
490 | set message $command | |
491 | } | |
492 | return [gdb_test $command $pattern $message] | |
493 | } | |
f34c8766 | 494 | \f |
19fa4a0a MW |
495 | proc gdb_reinitialize_dir { subdir } { |
496 | global prompt | |
19fa4a0a | 497 | |
85174909 | 498 | send "dir\n" |
19fa4a0a | 499 | expect { |
4771fe15 | 500 | -re "Reinitialize source path to empty.*y or n. " { |
19fa4a0a MW |
501 | send "y\n" |
502 | expect { | |
503 | -re "Source directories searched.*$prompt $" { | |
504 | send "dir $subdir\n" | |
505 | expect { | |
506 | -re "Source directories searched.*$prompt $" { | |
85174909 | 507 | verbose "Dir set to $subdir" |
19fa4a0a MW |
508 | } |
509 | -re ".*$prompt $" { | |
85174909 | 510 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
511 | } |
512 | } | |
513 | } | |
514 | -re ".*$prompt $" { | |
85174909 | 515 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
516 | } |
517 | } | |
518 | } | |
519 | -re ".*$prompt $" { | |
85174909 | 520 | perror "Dir \"$subdir\" failed." |
19fa4a0a MW |
521 | } |
522 | } | |
523 | } | |
c79f61db | 524 | |
c79f61db RS |
525 | # |
526 | # gdb_exit -- exit the GDB, killing the target program if necessary | |
527 | # | |
528 | proc default_gdb_exit {} { | |
529 | global GDB | |
530 | global GDBFLAGS | |
531 | global verbose | |
532 | ||
002cc99f | 533 | verbose "Quitting $GDB $GDBFLAGS" |
c79f61db RS |
534 | |
535 | # This used to be 1 for unix-gdb.exp | |
536 | set timeout 5 | |
a26fa899 | 537 | verbose "Timeout is now $timeout seconds" 2 |
c79f61db | 538 | |
90fba5fa BC |
539 | # We used to try to send "quit" to GDB, and wait for it to die. |
540 | # Dealing with all the cases and errors got pretty hairy. Just close it, | |
541 | # that is simpler. | |
542 | close | |
543 | ||
544 | # Omitting this probably would cause strange timing-dependent failures. | |
c79f61db RS |
545 | wait |
546 | } | |
547 | ||
85174909 | 548 | # |
4771fe15 JL |
549 | # load a file into the debugger. |
550 | # return a -1 if anything goes wrong. | |
85174909 RS |
551 | # |
552 | proc gdb_file_cmd { arg } { | |
553 | global verbose | |
554 | global loadpath | |
555 | global loadfile | |
556 | global GDB | |
557 | global prompt | |
9bcc6c3f | 558 | global spawn_id |
4771fe15 | 559 | upvar timeout timeout |
85174909 RS |
560 | |
561 | send "file $arg\n" | |
562 | expect { | |
563 | -re "Reading symbols from.*done.*$prompt $" { | |
564 | verbose "\t\tLoaded $arg into the $GDB" | |
565 | return 0 | |
566 | } | |
567 | -re "has no symbol-table.*$prompt $" { | |
568 | perror "$arg wasn't compiled with \"-g\"" | |
569 | return -1 | |
570 | } | |
9bcc6c3f | 571 | -re "A program is being debugged already.*Kill it.*y or n. $" { |
85174909 RS |
572 | send "y\n" |
573 | verbose "\t\tKilling previous program being debugged" | |
9bcc6c3f | 574 | exp_continue |
85174909 | 575 | } |
9bcc6c3f | 576 | -re "Load new symbol table from \".*\".*y or n. $" { |
85174909 RS |
577 | send "y\n" |
578 | expect { | |
579 | -re "Reading symbols from.*done.*$prompt $" { | |
580 | verbose "\t\tLoaded $arg with new symbol table into $GDB" | |
581 | return 0 | |
582 | } | |
583 | timeout { | |
584 | perror "(timeout) Couldn't load $arg, other program already l | |
585 | oaded." | |
586 | return -1 | |
587 | } | |
588 | } | |
589 | } | |
590 | -re ".*No such file or directory.*$prompt $" { | |
591 | perror "($arg) No such file or directory\n" | |
592 | return -1 | |
593 | } | |
594 | -re "$prompt $" { | |
595 | perror "couldn't load $arg into $GDB." | |
596 | return -1 | |
597 | } | |
598 | timeout { | |
9bcc6c3f | 599 | perror "couldn't load $arg into $GDB (timed out)." |
85174909 RS |
600 | return -1 |
601 | } | |
602 | eof { | |
603 | # This is an attempt to detect a core dump, but seems not to | |
604 | # work. Perhaps we need to match .* followed by eof, in which | |
605 | # expect does not seem to have a way to do that. | |
8f07e537 | 606 | perror "couldn't load $arg into $GDB (end of file)." |
85174909 RS |
607 | return -1 |
608 | } | |
609 | } | |
610 | } | |
c79f61db | 611 | |
0fba9aa2 SS |
612 | # |
613 | # start gdb -- start gdb running, default procedure | |
614 | # | |
302fcffb FF |
615 | # When running over NFS, particularly if running many simultaneous |
616 | # tests on different hosts all using the same server, things can | |
617 | # get really slow. Give gdb at least 3 minutes to start up. | |
618 | # | |
0fba9aa2 SS |
619 | proc default_gdb_start { } { |
620 | global verbose | |
621 | global GDB | |
622 | global GDBFLAGS | |
623 | global prompt | |
624 | global spawn_id | |
625 | global timeout | |
f34c8766 | 626 | verbose "Spawning $GDB -nw $GDBFLAGS" |
3e304ddf C |
627 | |
628 | if { [which $GDB] == 0 } then { | |
629 | perror "$GDB does not exist." | |
630 | exit 1 | |
631 | } | |
0fba9aa2 SS |
632 | |
633 | set oldtimeout $timeout | |
302fcffb FF |
634 | set timeout [expr "$timeout + 180"] |
635 | verbose "Timeout increased to $timeout seconds" 2 | |
f34c8766 | 636 | eval "spawn $GDB -nw $GDBFLAGS" |
0fba9aa2 SS |
637 | expect { |
638 | -re ".*\r\n$prompt $" { | |
3e304ddf | 639 | verbose "GDB initialized." |
0fba9aa2 SS |
640 | } |
641 | -re "$prompt $" { | |
642 | perror "GDB never initialized." | |
302fcffb FF |
643 | set timeout $oldtimeout |
644 | verbose "Timeout restored to $timeout seconds" 2 | |
0fba9aa2 SS |
645 | return -1 |
646 | } | |
647 | timeout { | |
302fcffb FF |
648 | perror "(timeout) GDB never initialized after $timeout seconds." |
649 | set timeout $oldtimeout | |
650 | verbose "Timeout restored to $timeout seconds" 2 | |
0fba9aa2 SS |
651 | return -1 |
652 | } | |
653 | } | |
654 | set timeout $oldtimeout | |
302fcffb | 655 | verbose "Timeout restored to $timeout seconds" 2 |
0fba9aa2 SS |
656 | # force the height to "unlimited", so no pagers get used |
657 | send "set height 0\n" | |
658 | expect { | |
659 | -re ".*$prompt $" { | |
660 | verbose "Setting height to 0." 2 | |
661 | } | |
662 | timeout { | |
663 | warning "Couldn't set the height to 0." | |
664 | } | |
665 | } | |
666 | # force the width to "unlimited", so no wraparound occurs | |
667 | send "set width 0\n" | |
668 | expect { | |
669 | -re ".*$prompt $" { | |
4771fe15 | 670 | verbose "Setting width to 0." 2 |
0fba9aa2 SS |
671 | } |
672 | timeout { | |
673 | warning "Couldn't set the width to 0." | |
674 | } | |
675 | } | |
676 | } | |
677 | ||
9bcc6c3f RS |
678 | # |
679 | # FIXME: this is a copy of the new library procedure, but it's here too | |
680 | # till the new dejagnu gets installed everywhere. I'd hate to break the | |
681 | # gdb tests suite. | |
682 | # | |
002cc99f RS |
683 | global argv0 |
684 | if ![info exists argv0] then { | |
9bcc6c3f RS |
685 | proc exp_continue { } { |
686 | continue -expect | |
687 | } | |
688 | } | |
c79f61db | 689 | |
4771fe15 JL |
690 | # * For crosses, the CHILL runtime doesn't build because it can't find |
691 | # setjmp.h, stdio.h, etc. | |
692 | # * For AIX (as of 16 Mar 95), (a) there is no language code for | |
693 | # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2 | |
694 | # does not get along with AIX's too-clever linker. | |
695 | # * On Irix5, there is a bug whereby set of bool, etc., don't get | |
696 | # TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't | |
697 | # work with stub types. | |
698 | # Lots of things seem to fail on the PA, and since it's not a supported | |
699 | # chill target at the moment, don't run the chill tests. | |
700 | ||
4081daa1 | 701 | proc skip_chill_tests {} { |
4771fe15 JL |
702 | eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]] |
703 | verbose "Skip chill tests is $skip_chill" | |
704 | return $skip_chill | |
4081daa1 | 705 | } |