gdb/testsuite/lib/gdb.exp

   1 # Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc.
   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 # [email protected]
  19
  20 # This file was written by Fred Fish. ([email protected])
  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
  26 load_lib libgloss.exp
  27
  28 global GDB
  29 global CHILL_LIB
  30 global CHILL_RT0
  31
  32 if ![info exists CHILL_LIB] {
  33     set CHILL_LIB [findfile $base_dir/../../gcc/ch/runtime/libchill.a "$base_dir/../../gcc/ch/runtime/libchill.a" [transform -lchill]]
  34 }
  35 verbose "using CHILL_LIB = $CHILL_LIB" 2
  36 if ![info exists CHILL_RT0] {
  37     set CHILL_RT0 [findfile $base_dir/../../gcc/ch/runtime/chillrt0.o "$base_dir/../../gcc/ch/runtime/chillrt0.o" ""]
  38 }
  39 verbose "using CHILL_RT0 = $CHILL_RT0" 2
  40
  41 if ![info exists GDB] {
  42     if ![is_remote host] {
  43         set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]]
  44     } else {
  45         set GDB gdb
  46     }
  47 }
  48 verbose "using GDB = $GDB" 2
  49
  50 global GDBFLAGS
  51 if ![info exists GDBFLAGS] {
  52     set GDBFLAGS "-nx"
  53 }
  54 verbose "using GDBFLAGS = $GDBFLAGS" 2
  55
  56 # The variable prompt is a regexp which matches the gdb prompt.  Set it if it
  57 # is not already set.
  58 global gdb_prompt
  59 if ![info exists prompt] then {
  60     set gdb_prompt "\[(\]gdb\[)\]"
  61 }
  62
  63 if ![info exists noargs] then {
  64     set noargs 0
  65 }
  66
  67 if ![info exists nosignals] then {
  68     set nosignals 0
  69 }
  70
  71 if ![info exists noinferiorio] then {
  72     set noinferiorio 0
  73 }
  74
  75 if ![info exists noresults] then {
  76     set noresults 0
  77 }
  78
  79 #
  80 # gdb_version -- extract and print the version number of GDB
  81 #
  82 proc default_gdb_version {} {
  83     global GDB
  84     global GDBFLAGS
  85     global gdb_prompt
  86     set fileid [open "gdb_cmd" w];
  87     puts $fileid "q";
  88     close $fileid;
  89     set cmdfile [remote_download host "gdb_cmd"];
  90     set output [remote_exec host "$GDB -nw --command $cmdfile"]
  91     remote_file build delete "gdb_cmd";
  92     remote_file host delete "$cmdfile";
  93     set tmp [lindex $output 1];
  94     set version ""
  95     regexp " \[0-9\]\[^ \t\n\r\]+" "$tmp" version
  96     if ![is_remote host] {
  97         clone_output "[which $GDB] version $version $GDBFLAGS\n"
  98     } else {
  99         clone_output "$GDB on remote host version $version $GDBFLAGS\n"
 100     }
 101 }
 102
 103 proc gdb_version { } {
 104     return [default_gdb_version];
 105 }
 106
 107 #
 108 # gdb_unload -- unload a file if one is loaded
 109 #
 110
 111 proc gdb_unload {} {
 112     global verbose
 113     global GDB
 114     global gdb_prompt
 115     send_gdb "file\n"
 116     expect {
 117         -re "No exec file now.*\r" { exp_continue }
 118         -re "No symbol file now.*\r" { exp_continue }
 119         -re "A program is being debugged already..*Kill it.*y or n. $"\
 120             { send_gdb "y\n"
 121                 verbose "\t\tKilling previous program being debugged"
 122             exp_continue
 123         }
 124         -re "Discard symbol table from .*y or n. $" {
 125             send_gdb "y\n"
 126             exp_continue
 127         }
 128         -re "$gdb_prompt $" {}
 129         timeout {
 130             perror "couldn't unload file in $GDB (timed out)."
 131             return -1
 132         }
 133     }
 134 }
 135
 136 # Many of the tests depend on setting breakpoints at various places and
 137 # running until that breakpoint is reached.  At times, we want to start
 138 # with a clean-slate with respect to breakpoints, so this utility proc
 139 # lets us do this without duplicating this code everywhere.
 140 #
 141
 142 proc delete_breakpoints {} {
 143     global gdb_prompt
 144     global gdb_spawn_id
 145
 146     send_gdb "delete breakpoints\n"
 147     expect {
 148         -i $gdb_spawn_id -re ".*Delete all breakpoints.*y or n.*$" {
 149             send_gdb "y\n";
 150             exp_continue
 151         }
 152         -i $gdb_spawn_id -re ".*$gdb_prompt $" { # This happens if there were no breakpoints
 153             }
 154         -i $gdb_spawn_id timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
 155     }
 156     send_gdb "info breakpoints\n"
 157     expect {
 158         -i $gdb_spawn_id -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
 159         -i $gdb_spawn_id -re ".*$gdb_prompt $" { perror "breakpoints not deleted" ; return }
 160         -i $gdb_spawn_id -re "Delete all breakpoints.*or n.*$" {
 161             send_gdb "y\n";
 162             exp_continue
 163         }
 164         -i $gdb_spawn_id timeout { perror "info breakpoints (timeout)" ; return }
 165     }
 166 }
 167
 168
 169 #
 170 # Generic run command.
 171 #
 172 # The second pattern below matches up to the first newline *only*.
 173 # Using ``.*$'' could swallow up output that we attempt to match
 174 # elsewhere.
 175 #
 176 proc gdb_run_cmd {args} {
 177     global gdb_prompt
 178     global gdb_spawn_id
 179
 180     set spawn_id $gdb_spawn_id
 181
 182     if [target_info exists use_gdb_stub] {
 183         send_gdb  "jump *start\n"
 184         expect {
 185             -re "Continuing at \[^\r\n\]*\[\r\n\]" {
 186                 if ![target_info exists gdb_stub] {
 187                     return;
 188                 }
 189             }
 190             -re "Line.* Jump anyway.*y or n. $" {
 191                 send_gdb "y\n"
 192                 exp_continue;
 193             }
 194             -re "No symbol.*context.*$gdb_prompt $" {}
 195             -re "The program is not being run.*$gdb_prompt $" {
 196                 gdb_load "";
 197             }
 198             timeout { perror "Jump to start() failed (timeout)"; return }
 199         }
 200         if [target_info exists gdb_stub] {
 201             expect {
 202                 -re ".*$gdb_prompt $" {
 203                     send_gdb "continue\n"
 204                 }
 205             }
 206         }
 207         return
 208     }
 209     send_gdb "run $args\n"
 210 # This doesn't work quite right yet.
 211     expect {
 212         -re "The program .* has been started already.*y or n. $" {
 213             send_gdb "y\n"
 214             exp_continue
 215         }
 216         -re "Starting program: \[^\n\]*" {}
 217     }
 218 }
 219
 220 proc gdb_breakpoint { function } {
 221     global gdb_prompt
 222     global decimal
 223     global gdb_spawn_id
 224
 225     set spawn_id $gdb_spawn_id
 226
 227     send_gdb "break $function\n"
 228     # The first two regexps are what we get with -g, the third is without -g.
 229     expect {
 230         -re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 231         -re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 232         -re "Breakpoint \[0-9\]* at .*$gdb_prompt $" {}
 233         -re "$gdb_prompt $" { fail "setting breakpoint at $function" ; return 0 }
 234         timeout { fail "setting breakpoint at $function (timeout)" ; return 0 }
 235     }
 236     return 1;
 237 }
 238
 239 # Set breakpoint at function and run gdb until it breaks there.
 240 # Since this is the only breakpoint that will be set, if it stops
 241 # at a breakpoint, we will assume it is the one we want.  We can't
 242 # just compare to "function" because it might be a fully qualified,
 243 # single quoted C++ function specifier.
 244
 245 proc runto { function } {
 246     global gdb_prompt
 247     global decimal
 248     global gdb_spawn_id
 249
 250     set spawn_id $gdb_spawn_id
 251
 252     delete_breakpoints
 253
 254     if ![gdb_breakpoint $function] {
 255         return 0;
 256     }
 257
 258     gdb_run_cmd
 259
 260     # the "at foo.c:36" output we get with -g.
 261     # the "in func" output we get without -g.
 262     expect {
 263         -re "Break.* at .*:$decimal.*$gdb_prompt $" {
 264             return 1
 265         }
 266         -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in .*$gdb_prompt $" {
 267             return 1
 268         }
 269         -re "$gdb_prompt $" {
 270             fail "running to $function in runto"
 271             return 0
 272         }
 273         timeout {
 274             fail "running to $function in runto (timeout)"
 275             return 0
 276         }
 277     }
 278     return 1
 279 }
 280
 281 #
 282 # runto_main -- ask gdb to run until we hit a breakpoint at main.
 283 #               The case where the target uses stubs has to be handled
 284 #               specially--if it uses stubs, assuming we hit
 285 #               breakpoint() and just step out of the function.
 286 #
 287 proc runto_main {} {
 288     global gdb_prompt
 289     global decimal
 290
 291     if ![target_info exists gdb_stub] {
 292         return [runto main]
 293     }
 294
 295     delete_breakpoints
 296
 297     send_gdb "step\n"
 298     # if use stubs step out of the breakpoint() function.
 299     expect {
 300         -re "main.* at .*$gdb_prompt $" {}
 301         -re "_start.*$gdb_prompt $" {}
 302         timeout { fail "single step at breakpoint() (timeout)" ; return 0 }
 303     }
 304     return 1
 305 }
 306
 307 #
 308 # gdb_test -- send_gdb a command to gdb and test the result.
 309 #             Takes three parameters.
 310 #             Parameters:
 311 #                First one is the command to execute.  If this is the null string
 312 #                  then no command is sent.
 313 #                Second one is the pattern to match for a PASS, and must NOT include
 314 #                  the \r\n sequence immediately before the gdb prompt.
 315 #                Third one is an optional message to be printed. If this
 316 #                  a null string "", then the pass/fail messages use the command
 317 #                  string as the message.
 318 #             Returns:
 319 #                1 if the test failed,
 320 #                0 if the test passes,
 321 #               -1 if there was an internal error.
 322 #
 323 proc gdb_test { args } {
 324     global verbose
 325     global gdb_prompt
 326     global GDB
 327     global expect_out
 328     upvar timeout timeout
 329
 330     if [llength $args]>2 then {
 331         set message [lindex $args 2]
 332     } else {
 333         set message [lindex $args 0]
 334     }
 335     set command [lindex $args 0]
 336     set pattern [lindex $args 1]
 337
 338     if [llength $args]==5 {
 339         set question_string [lindex $args 3];
 340         set response_string [lindex $args 4];
 341     } else {
 342         set question_string "^FOOBAR$"
 343     }
 344
 345     if $verbose>2 then {
 346         send_user "Sending \"$command\" to gdb\n"
 347         send_user "Looking to match \"$pattern\"\n"
 348         send_user "Message is \"$message\"\n"
 349     }
 350
 351     set result -1
 352     if ![string match $command ""] {
 353         send_gdb "$command\n"
 354     }
 355
 356     expect {
 357         -re ".*Ending remote debugging.*$gdb_prompt$" {
 358             if ![isnative] then {
 359                 warning "Can`t communicate to remote target."
 360             }
 361             gdb_exit
 362             gdb_start
 363             set result -1
 364         }
 365         -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
 366             if ![string match "" $message] then {
 367                 pass "$message"
 368             }
 369             set result 0
 370         }
 371         -re "(${question_string})$" {
 372             send_gdb "$response_string\n";
 373             exp_continue;
 374         }
 375         -re "Undefined command:.*$gdb_prompt" {
 376             perror "Undefined command \"$command\"."
 377             set result 1
 378         }
 379         -re "Ambiguous command.*$gdb_prompt $" {
 380             perror "\"$command\" is not a unique command name."
 381             set result 1
 382         }
 383         -re ".*Program exited with code \[0-9\]+.*$gdb_prompt $" {
 384             if ![string match "" $message] then {
 385                 set errmsg "$message: the program exited"
 386             } else {
 387                 set errmsg "$command: the program exited"
 388             }
 389             fail "$errmsg"
 390             return -1
 391         }
 392         -re "The program is not being run.*$gdb_prompt $" {
 393             if ![string match "" $message] then {
 394                 set errmsg "$message: the program is no longer running"
 395             } else {
 396                 set errmsg "$command: the program is no longer running"
 397             }
 398             fail "$errmsg"
 399             return -1
 400         }
 401         -re ".*$gdb_prompt $" {
 402             if ![string match "" $message] then {
 403                 fail "$message"
 404             }
 405             set result 1
 406         }
 407         "<return>" {
 408             send_gdb "\n"
 409             perror "Window too small."
 410         }
 411         -re "\\(y or n\\) " {
 412             send_gdb "n\n"
 413             perror "Got interactive prompt."
 414         }
 415         eof {
 416             perror "Process no longer exists"
 417             return -1
 418         }
 419         full_buffer {
 420             perror "internal buffer is full."
 421         }
 422         timeout {
 423             if ![string match "" $message] then {
 424                 fail "(timeout) $message"
 425             }
 426             set result 1
 427         }
 428     }
 429     return $result
 430 }
 431 \f
 432 # Test that a command gives an error.  For pass or fail, return
 433 # a 1 to indicate that more tests can proceed.  However a timeout
 434 # is a serious error, generates a special fail message, and causes
 435 # a 0 to be returned to indicate that more tests are likely to fail
 436 # as well.
 437
 438 proc test_print_reject { args } {
 439     global gdb_prompt
 440     global verbose
 441
 442     if [llength $args]==2 then {
 443         set expectthis [lindex $args 1]
 444     } else {
 445         set expectthis "should never match this bogus string"
 446     }
 447     set sendthis [lindex $args 0]
 448     if $verbose>2 then {
 449         send_user "Sending \"$sendthis\" to gdb\n"
 450         send_user "Looking to match \"$expectthis\"\n"
 451     }
 452     send_gdb "$sendthis\n"
 453     expect {
 454         -re ".*A .* in expression.*\\.*$gdb_prompt $" {
 455             pass "reject $sendthis"
 456             return 1
 457         }
 458         -re ".*Invalid syntax in expression.*$gdb_prompt $" {
 459             pass "reject $sendthis"
 460             return 1
 461         }
 462         -re ".*Junk after end of expression.*$gdb_prompt $" {
 463             pass "reject $sendthis"
 464             return 1
 465         }
 466         -re ".*Invalid number.*$gdb_prompt $" {
 467             pass "reject $sendthis"
 468             return 1
 469         }
 470         -re ".*Invalid character constant.*$gdb_prompt $" {
 471             pass "reject $sendthis"
 472             return 1
 473         }
 474         -re ".*No symbol table is loaded.*$gdb_prompt $" {
 475             pass "reject $sendthis"
 476             return 1
 477         }
 478         -re ".*No symbol .* in current context.*$gdb_prompt $" {
 479             pass "reject $sendthis"
 480             return 1
 481         }
 482         -re ".*$expectthis.*$gdb_prompt $" {
 483             pass "reject $sendthis"
 484             return 1
 485         }
 486         -re ".*$gdb_prompt $" {
 487             fail "reject $sendthis"
 488             return 1
 489         }
 490         default {
 491             fail "reject $sendthis (eof or timeout)"
 492             return 0
 493         }
 494     }
 495 }
 496 \f
 497 # Given an input string, adds backslashes as needed to create a
 498 # regexp that will match the string.
 499
 500 proc string_to_regexp {str} {
 501     set result $str
 502     regsub -all {[]*+.|()^$\[]} $str {\\&} result
 503     return $result
 504 }
 505
 506 # Same as gdb_test, but the second parameter is not a regexp,
 507 # but a string that must match exactly.
 508
 509 proc gdb_test_exact { args } {
 510     upvar timeout timeout
 511
 512     set command [lindex $args 0]
 513
 514     # This applies a special meaning to a null string pattern.  Without
 515     # this, "$pattern\r\n$gdb_prompt $" will match anything, including error
 516     # messages from commands that should have no output except a new
 517     # prompt.  With this, only results of a null string will match a null
 518     # string pattern.
 519
 520     set pattern [lindex $args 1]
 521     if [string match $pattern ""] {
 522         set pattern [string_to_regexp [lindex $args 0]]
 523     } else {
 524         set pattern [string_to_regexp [lindex $args 1]]
 525     }
 526
 527     # It is most natural to write the pattern argument with only
 528     # embedded \n's, especially if you are trying to avoid Tcl quoting
 529     # problems.  But expect really wants to see \r\n in patterns.  So
 530     # transform the pattern here.  First transform \r\n back to \n, in
 531     # case some users of gdb_test_exact already do the right thing.
 532     regsub -all "\r\n" $pattern "\n" pattern
 533     regsub -all "\n" $pattern "\r\n" pattern
 534     if [llength $args]==3 then {
 535         set message [lindex $args 2]
 536     } else {
 537         set message $command
 538     }
 539
 540     return [gdb_test $command $pattern $message]
 541 }
 542 \f
 543 proc gdb_reinitialize_dir { subdir } {
 544     global gdb_prompt
 545     global gdb_spawn_id
 546     set spawn_id $gdb_spawn_id
 547
 548     if [is_remote host] {
 549         return "";
 550     }
 551     send_gdb "dir\n"
 552     expect {
 553         -re "Reinitialize source path to empty.*y or n. " {
 554             send_gdb "y\n"
 555             expect {
 556                 -re "Source directories searched.*$gdb_prompt $" {
 557                     send_gdb "dir $subdir\n"
 558                     expect {
 559                         -re "Source directories searched.*$gdb_prompt $" {
 560                             verbose "Dir set to $subdir"
 561                         }
 562                         -re ".*$gdb_prompt $" {
 563                             perror "Dir \"$subdir\" failed."
 564                         }
 565                     }
 566                 }
 567                 -re ".*$gdb_prompt $" {
 568                     perror "Dir \"$subdir\" failed."
 569                 }
 570             }
 571         }
 572         -re ".*$gdb_prompt $" {
 573             perror "Dir \"$subdir\" failed."
 574         }
 575     }
 576 }
 577
 578 #
 579 # gdb_exit -- exit the GDB, killing the target program if necessary
 580 #
 581 proc default_gdb_exit {} {
 582     global GDB
 583     global GDBFLAGS
 584     global verbose
 585     global gdb_spawn_id
 586
 587     if ![info exists gdb_spawn_id] {
 588         return;
 589     }
 590
 591     verbose "Quitting $GDB $GDBFLAGS"
 592
 593     # This used to be 1 for unix-gdb.exp
 594     set timeout 5
 595     verbose "Timeout is now $timeout seconds" 2
 596
 597     if [is_remote host] {
 598         send_gdb "quit\n";
 599         expect {
 600             -i $gdb_spawn_id -re ".*and kill it.*y or n. " {
 601                 send_gdb "y\n";
 602                 exp_continue;
 603             }
 604             -i $gdb_spawn_id timeout { }
 605         }
 606     } else {
 607         # We used to try to send_gdb "quit" to GDB, and wait for it to die.
 608         # Dealing with all the cases and errors got pretty hairy.  Just close it,
 609         # that is simpler.
 610         catch "close -i $gdb_spawn_id"
 611
 612         # Omitting this probably would cause strange timing-dependent failures.
 613         catch "wait -i $gdb_spawn_id"
 614     }
 615
 616     remote_close host;
 617     unset gdb_spawn_id
 618 }
 619
 620 #
 621 # load a file into the debugger.
 622 # return a -1 if anything goes wrong.
 623 #
 624 proc gdb_file_cmd { arg } {
 625     global verbose
 626     global loadpath
 627     global loadfile
 628     global GDB
 629     global gdb_prompt
 630     upvar timeout timeout
 631     global gdb_spawn_id
 632     set spawn_id $gdb_spawn_id
 633
 634     if [is_remote host] {
 635         set arg [remote_download host $arg];
 636         if { $arg == "" } {
 637             error "download failed"
 638             return -1;
 639         }
 640     }
 641
 642     send_gdb "file $arg\n"
 643     expect {
 644         -re "Reading symbols from.*done.*$gdb_prompt $" {
 645             verbose "\t\tLoaded $arg into the $GDB"
 646             return 0
 647         }
 648         -re "has no symbol-table.*$gdb_prompt $" {
 649             perror "$arg wasn't compiled with \"-g\""
 650             return -1
 651         }
 652         -re "A program is being debugged already.*Kill it.*y or n. $" {
 653             send_gdb "y\n"
 654                 verbose "\t\tKilling previous program being debugged"
 655             exp_continue
 656         }
 657         -re "Load new symbol table from \".*\".*y or n. $" {
 658             send_gdb "y\n"
 659             expect {
 660                 -re "Reading symbols from.*done.*$gdb_prompt $" {
 661                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
 662                     return 0
 663                 }
 664                 timeout {
 665                     perror "(timeout) Couldn't load $arg, other program already loaded."
 666                     return -1
 667                 }
 668             }
 669         }
 670         -re ".*No such file or directory.*$gdb_prompt $" {
 671             perror "($arg) No such file or directory\n"
 672             return -1
 673         }
 674         -re "$gdb_prompt $" {
 675             perror "couldn't load $arg into $GDB."
 676             return -1
 677             }
 678         timeout {
 679             perror "couldn't load $arg into $GDB (timed out)."
 680             return -1
 681         }
 682         eof {
 683             # This is an attempt to detect a core dump, but seems not to
 684             # work.  Perhaps we need to match .* followed by eof, in which
 685             # expect does not seem to have a way to do that.
 686             perror "couldn't load $arg into $GDB (end of file)."
 687             return -1
 688         }
 689     }
 690 }
 691
 692 #
 693 # start gdb -- start gdb running, default procedure
 694 #
 695 # When running over NFS, particularly if running many simultaneous
 696 # tests on different hosts all using the same server, things can
 697 # get really slow.  Give gdb at least 3 minutes to start up.
 698 #
 699 proc default_gdb_start { } {
 700     global verbose
 701     global GDB
 702     global GDBFLAGS
 703     global gdb_prompt
 704     global timeout
 705     global gdb_spawn_id
 706     global spawn_id
 707     verbose "Spawning $GDB -nw $GDBFLAGS"
 708
 709     if [info exists gdb_spawn_id] {
 710         return 0;
 711     }
 712
 713     set oldtimeout $timeout
 714     set timeout [expr "$timeout + 180"]
 715     if [is_remote host] {
 716         set shell_id [remote_spawn host "$GDB -nw $GDBFLAGS --command gdbinit"]
 717     } else {
 718         if { [which $GDB] == 0 } then {
 719             perror "$GDB does not exist."
 720             exit 1
 721         }
 722
 723         set shell_id [remote_spawn host "$GDB -nw $GDBFLAGS"]
 724     }
 725     verbose $shell_id
 726     set timeout 10
 727     expect {
 728         -i $shell_id -re ".*\[\r\n\]$gdb_prompt $" {
 729             verbose "GDB initialized."
 730         }
 731         -i $shell_id -re "$gdb_prompt $"        {
 732             perror "GDB never initialized."
 733             set timeout $oldtimeout
 734             verbose "Timeout restored to $timeout seconds" 2
 735             return -1
 736         }
 737         -i $shell_id timeout            {
 738             perror "(timeout) GDB never initialized after $timeout seconds."
 739             set timeout $oldtimeout
 740             verbose "Timeout restored to $timeout seconds" 2
 741             return -1
 742         }
 743     }
 744     set timeout $oldtimeout
 745     verbose "Timeout restored to $timeout seconds" 2
 746     set gdb_spawn_id $shell_id
 747     set spawn_id $gdb_spawn_id
 748     # force the height to "unlimited", so no pagers get used
 749     send_gdb "set height 0\n"
 750     expect {
 751         -i $shell_id -re ".*$gdb_prompt $" {
 752             verbose "Setting height to 0." 2
 753         }
 754         -i $shell_id timeout {
 755             warning "Couldn't set the height to 0"
 756         }
 757     }
 758     # force the width to "unlimited", so no wraparound occurs
 759     send_gdb "set width 0\n"
 760     expect {
 761         -i $shell_id -re ".*$gdb_prompt $" {
 762             verbose "Setting width to 0." 2
 763         }
 764         -i $shell_id timeout {
 765             warning "Couldn't set the width to 0."
 766         }
 767     }
 768     return 0;
 769 }
 770
 771 #
 772 # FIXME: this is a copy of the new library procedure, but it's here too
 773 # till the new dejagnu gets installed everywhere. I'd hate to break the
 774 # gdb testsuite.
 775 #
 776 global argv0
 777 if ![info exists argv0] then {
 778     proc exp_continue { } {
 779         continue -expect
 780     }
 781 }
 782
 783 # * For crosses, the CHILL runtime doesn't build because it can't find
 784 # setjmp.h, stdio.h, etc.
 785 # * For AIX (as of 16 Mar 95), (a) there is no language code for
 786 # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2
 787 # does not get along with AIX's too-clever linker.
 788 # * On Irix5, there is a bug whereby set of bool, etc., don't get
 789 # TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't
 790 # work with stub types.
 791 # Lots of things seem to fail on the PA, and since it's not a supported
 792 # chill target at the moment, don't run the chill tests.
 793
 794 proc skip_chill_tests {} {
 795     if ![info exists do_chill_tests] {
 796         return 1;
 797     }
 798     eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "*-*-irix6*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]]
 799     verbose "Skip chill tests is $skip_chill"
 800     return $skip_chill
 801 }
 802
 803 proc get_compiler_info {binfile} {
 804     # Create and source the file that provides information about the compiler
 805     # used to compile the test case.
 806     global srcdir
 807     global subdir
 808     # These two come from compiler.c.
 809     global signed_keyword_not_used
 810     global gcc_compiled
 811
 812     if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
 813         perror "Couldn't make ${binfile}.ci file"
 814         return 1;
 815     }
 816     source ${binfile}.ci
 817     return 0;
 818 }
 819
 820 proc gdb_compile {source dest type options} {
 821     if [target_info exists gdb_stub] {
 822         set options2 { "additional_flags=-Dusestubs" }
 823         lappend options "libs=[target_info gdb_stub]";
 824         set options [concat $options2 $options]
 825     }
 826     verbose "options are $options"
 827     verbose "source is $source $dest $type $options"
 828     set result [target_compile $source $dest $type $options];
 829     regsub "\[\r\n\]*$" "$result" "" result;
 830     regsub "^\[\r\n\]*" "$result" "" result;
 831     if { $result != "" } {
 832         clone_output "gdb compile failed, $result"
 833     }
 834     return $result;
 835 }
 836
 837 proc send_gdb { string } {
 838     return [remote_send host "$string"];
 839 }
 840
 841 proc gdb_start { } {
 842     default_gdb_start
 843 }
 844
 845 proc gdb_exit { } {
 846     catch default_gdb_exit
 847 }
 848
 849 #
 850 # gdb_load -- load a file into the debugger.
 851 #             return a -1 if anything goes wrong.
 852 #
 853 proc gdb_load { arg } {
 854     return [gdb_file_cmd $arg]
 855 }
 856
 857 proc gdb_continue { function } {
 858     global decimal
 859
 860     return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"];
 861 }
 862
 863 proc gdb_finish { } {
 864     gdb_exit;
 865 }