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