gdb/testsuite/lib/gdb.exp

   1 # Copyright (C) 1992, 1994, 1995, 1997, 1999 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 TOOL_EXECUTABLE] {
  42     set GDB $TOOL_EXECUTABLE;
  43 }
  44 if ![info exists GDB] {
  45     if ![is_remote host] {
  46         set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]]
  47     } else {
  48         set GDB [transform gdb];
  49     }
  50 }
  51 verbose "using GDB = $GDB" 2
  52
  53 global GDBFLAGS
  54 if ![info exists GDBFLAGS] {
  55     set GDBFLAGS "-nx"
  56 }
  57 verbose "using GDBFLAGS = $GDBFLAGS" 2
  58
  59 # The variable gdb_prompt is a regexp which matches the gdb prompt.
  60 # Set it if it is not already set.
  61 global gdb_prompt
  62 if ![info exists gdb_prompt] then {
  63     set gdb_prompt "\[(\]gdb\[)\]"
  64 }
  65
  66 ### Only procedures should come after this point.
  67
  68 #
  69 # gdb_version -- extract and print the version number of GDB
  70 #
  71 proc default_gdb_version {} {
  72     global GDB
  73     global GDBFLAGS
  74     global gdb_prompt
  75     set fileid [open "gdb_cmd" w];
  76     puts $fileid "q";
  77     close $fileid;
  78     set cmdfile [remote_download host "gdb_cmd"];
  79     set output [remote_exec host "$GDB -nw --command $cmdfile"]
  80     remote_file build delete "gdb_cmd";
  81     remote_file host delete "$cmdfile";
  82     set tmp [lindex $output 1];
  83     set version ""
  84     regexp " \[0-9\]\[^ \t\n\r\]+" "$tmp" version
  85     if ![is_remote host] {
  86         clone_output "[which $GDB] version $version $GDBFLAGS\n"
  87     } else {
  88         clone_output "$GDB on remote host version $version $GDBFLAGS\n"
  89     }
  90 }
  91
  92 proc gdb_version { } {
  93     return [default_gdb_version];
  94 }
  95
  96 #
  97 # gdb_unload -- unload a file if one is loaded
  98 #
  99
 100 proc gdb_unload {} {
 101     global verbose
 102     global GDB
 103     global gdb_prompt
 104     send_gdb "file\n"
 105     gdb_expect 60 {
 106         -re "No executable file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 107         -re "No symbol file now\[^\r\n\]*\[\r\n\]" { exp_continue }
 108         -re "A program is being debugged already..*Kill it.*y or n. $"\
 109             { send_gdb "y\n"
 110                 verbose "\t\tKilling previous program being debugged"
 111             exp_continue
 112         }
 113         -re "Discard symbol table from .*y or n.*$" {
 114             send_gdb "y\n"
 115             exp_continue
 116         }
 117         -re "$gdb_prompt $" {}
 118         timeout {
 119             perror "couldn't unload file in $GDB (timed out)."
 120             return -1
 121         }
 122     }
 123 }
 124
 125 # Many of the tests depend on setting breakpoints at various places and
 126 # running until that breakpoint is reached.  At times, we want to start
 127 # with a clean-slate with respect to breakpoints, so this utility proc
 128 # lets us do this without duplicating this code everywhere.
 129 #
 130
 131 proc delete_breakpoints {} {
 132     global gdb_prompt
 133
 134     # we need a larger timeout value here or this thing just confuses
 135     # itself.  May need a better implementation if possible. - guo
 136     #
 137     send_gdb "delete breakpoints\n"
 138     gdb_expect 100 {
 139          -re "Delete all breakpoints.*y or n.*$" {
 140             send_gdb "y\n";
 141             exp_continue
 142         }
 143          -re "$gdb_prompt $" { # This happens if there were no breakpoints
 144             }
 145          timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
 146     }
 147     send_gdb "info breakpoints\n"
 148     gdb_expect 100 {
 149          -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
 150          -re "$gdb_prompt $" { perror "breakpoints not deleted" ; return }
 151          -re "Delete all breakpoints.*or n.*$" {
 152             send_gdb "y\n";
 153             exp_continue
 154         }
 155          timeout { perror "info breakpoints (timeout)" ; return }
 156     }
 157 }
 158
 159
 160 #
 161 # Generic run command.
 162 #
 163 # The second pattern below matches up to the first newline *only*.
 164 # Using ``.*$'' could swallow up output that we attempt to match
 165 # elsewhere.
 166 #
 167 proc gdb_run_cmd {args} {
 168     global gdb_prompt
 169
 170     if [target_info exists gdb_init_command] {
 171         send_gdb "[target_info gdb_init_command]\n";
 172         gdb_expect 30 {
 173             -re "$gdb_prompt $" { }
 174             default {
 175                 perror "gdb_init_command for target failed";
 176                 return;
 177             }
 178         }
 179     }
 180
 181     if [target_info exists use_gdb_stub] {
 182         if [target_info exists gdb,do_reload_on_run] {
 183             # According to Stu, this will always work.
 184             gdb_load "";
 185             send_gdb "continue\n";
 186             gdb_expect 60 {
 187                 -re "Continu\[^\r\n\]*\[\r\n\]" {}
 188                 default {}
 189             }
 190             return;
 191         }
 192
 193         if [target_info exists gdb,start_symbol] {
 194             set start [target_info gdb,start_symbol];
 195         } else {
 196             set start "start";
 197         }
 198         send_gdb  "jump *$start\n"
 199         gdb_expect 30 {
 200             -re "Continuing at \[^\r\n\]*\[\r\n\]" {
 201                 if ![target_info exists gdb_stub] {
 202                     return;
 203                 }
 204             }
 205             -re "No symbol \"start\" in current.*$gdb_prompt $" {
 206                 send_gdb "jump *_start\n";
 207                 exp_continue;
 208             }
 209             -re "No symbol \"_start\" in current.*$gdb_prompt $" {
 210                 perror "Can't find start symbol to run in gdb_run";
 211                 return;
 212             }
 213             -re "Line.* Jump anyway.*y or n. $" {
 214                 send_gdb "y\n"
 215                 exp_continue;
 216             }
 217             -re "No symbol.*context.*$gdb_prompt $" {}
 218             -re "The program is not being run.*$gdb_prompt $" {
 219                 gdb_load "";
 220                 send_gdb "jump *$start\n";
 221                 exp_continue;
 222             }
 223             timeout { perror "Jump to start() failed (timeout)"; return }
 224         }
 225         if [target_info exists gdb_stub] {
 226             gdb_expect 60 {
 227                 -re "$gdb_prompt $" {
 228                     send_gdb "continue\n"
 229                 }
 230             }
 231         }
 232         return
 233     }
 234     send_gdb "run $args\n"
 235 # This doesn't work quite right yet.
 236     gdb_expect 60 {
 237         -re "The program .* has been started already.*y or n. $" {
 238             send_gdb "y\n"
 239             exp_continue
 240         }
 241         -re "Starting program: \[^\r\n\]*" {}
 242     }
 243 }
 244
 245 proc gdb_breakpoint { function } {
 246     global gdb_prompt
 247     global decimal
 248
 249     send_gdb "break $function\n"
 250     # The first two regexps are what we get with -g, the third is without -g.
 251     gdb_expect 30 {
 252         -re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 253         -re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$gdb_prompt $" {}
 254         -re "Breakpoint \[0-9\]* at .*$gdb_prompt $" {}
 255         -re "$gdb_prompt $" { fail "setting breakpoint at $function" ; return 0 }
 256         timeout { fail "setting breakpoint at $function (timeout)" ; return 0 }
 257     }
 258     return 1;
 259 }
 260
 261 # Set breakpoint at function and run gdb until it breaks there.
 262 # Since this is the only breakpoint that will be set, if it stops
 263 # at a breakpoint, we will assume it is the one we want.  We can't
 264 # just compare to "function" because it might be a fully qualified,
 265 # single quoted C++ function specifier.
 266
 267 proc runto { function } {
 268     global gdb_prompt
 269     global decimal
 270
 271     delete_breakpoints
 272
 273     if ![gdb_breakpoint $function] {
 274         return 0;
 275     }
 276
 277     gdb_run_cmd
 278
 279     # the "at foo.c:36" output we get with -g.
 280     # the "in func" output we get without -g.
 281     gdb_expect 30 {
 282         -re "Break.* at .*:$decimal.*$gdb_prompt $" {
 283             return 1
 284         }
 285         -re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in .*$gdb_prompt $" {
 286             return 1
 287         }
 288         -re "$gdb_prompt $" {
 289             fail "running to $function in runto"
 290             return 0
 291         }
 292         timeout {
 293             fail "running to $function in runto (timeout)"
 294             return 0
 295         }
 296     }
 297     return 1
 298 }
 299
 300 #
 301 # runto_main -- ask gdb to run until we hit a breakpoint at main.
 302 #               The case where the target uses stubs has to be handled
 303 #               specially--if it uses stubs, assuming we hit
 304 #               breakpoint() and just step out of the function.
 305 #
 306 proc runto_main { } {
 307     global gdb_prompt
 308     global decimal
 309
 310     if ![target_info exists gdb_stub] {
 311         return [runto main]
 312     }
 313
 314     delete_breakpoints
 315
 316     gdb_step_for_stub;
 317
 318     return 1
 319 }
 320
 321
 322 # gdb_test COMMAND PATTERN MESSAGE -- send a command to gdb; test the result.
 323 #
 324 # COMMAND is the command to execute, send to GDB with send_gdb.  If
 325 #   this is the null string no command is sent.
 326 # PATTERN is the pattern to match for a PASS, and must NOT include
 327 #   the \r\n sequence immediately before the gdb prompt.
 328 # MESSAGE is an optional message to be printed.  If this is
 329 #   omitted, then the pass/fail messages use the command string as the
 330 #   message.  (If this is the empty string, then sometimes we don't
 331 #   call pass or fail at all; I don't understand this at all.)
 332 #
 333 # Returns:
 334 #    1 if the test failed,
 335 #    0 if the test passes,
 336 #   -1 if there was an internal error.
 337 #
 338 proc gdb_test { args } {
 339     global verbose
 340     global gdb_prompt
 341     global GDB
 342     upvar timeout timeout
 343
 344     if [llength $args]>2 then {
 345         set message [lindex $args 2]
 346     } else {
 347         set message [lindex $args 0]
 348     }
 349     set command [lindex $args 0]
 350     set pattern [lindex $args 1]
 351
 352     if [llength $args]==5 {
 353         set question_string [lindex $args 3];
 354         set response_string [lindex $args 4];
 355     } else {
 356         set question_string "^FOOBAR$"
 357     }
 358
 359     if $verbose>2 then {
 360         send_user "Sending \"$command\" to gdb\n"
 361         send_user "Looking to match \"$pattern\"\n"
 362         send_user "Message is \"$message\"\n"
 363     }
 364
 365     set result -1
 366     set string "${command}\n";
 367     if { $command != "" } {
 368         while { "$string" != "" } {
 369             set foo [string first "\n" "$string"];
 370             set len [string length "$string"];
 371             if { $foo < [expr $len - 1] } {
 372                 set str [string range "$string" 0 $foo];
 373                 if { [send_gdb "$str"] != "" } {
 374                     global suppress_flag;
 375
 376                     if { ! $suppress_flag } {
 377                         perror "Couldn't send $command to GDB.";
 378                     }
 379                     fail "$message";
 380                     return $result;
 381                 }
 382                 # since we're checking if each line of the multi-line
 383                 # command are 'accepted' by GDB here,
 384                 # we need to set -notransfer expect option so that
 385                 # command output is not lost for pattern matching
 386                 # - guo
 387                 gdb_expect -notransfer 2 {
 388                     -re "\[\r\n\]" { }
 389                     timeout { }
 390                 }
 391                 set string [string range "$string" [expr $foo + 1] end];
 392             } else {
 393                 break;
 394             }
 395         }
 396         if { "$string" != "" } {
 397             if { [send_gdb "$string"] != "" } {
 398                 global suppress_flag;
 399
 400                 if { ! $suppress_flag } {
 401                     perror "Couldn't send $command to GDB.";
 402                 }
 403                 fail "$message";
 404                 return $result;
 405             }
 406         }
 407     }
 408
 409     if [info exists timeout] {
 410         set tmt $timeout;
 411     } else {
 412         global timeout;
 413         if [info exists timeout] {
 414             set tmt $timeout;
 415         } else {
 416             set tmt 60;
 417         }
 418     }
 419     gdb_expect $tmt {
 420          -re "\\*\\*\\* DOSEXIT code.*" {
 421              if { $message != "" } {
 422                  fail "$message";
 423              }
 424              gdb_suppress_entire_file "GDB died";
 425              return -1;
 426          }
 427          -re "Ending remote debugging.*$gdb_prompt $" {
 428             if ![isnative] then {
 429                 warning "Can`t communicate to remote target."
 430             }
 431             gdb_exit
 432             gdb_start
 433             set result -1
 434         }
 435          -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
 436             if ![string match "" $message] then {
 437                 pass "$message"
 438             }
 439             set result 0
 440         }
 441          -re "(${question_string})$" {
 442             send_gdb "$response_string\n";
 443             exp_continue;
 444         }
 445          -re "Undefined\[a-z\]* command:.*$gdb_prompt $" {
 446             perror "Undefined command \"$command\"."
 447             fail "$message"
 448             set result 1
 449         }
 450          -re "Ambiguous command.*$gdb_prompt $" {
 451             perror "\"$command\" is not a unique command name."
 452             fail "$message"
 453             set result 1
 454         }
 455          -re "Program exited with code \[0-9\]+.*$gdb_prompt $" {
 456             if ![string match "" $message] then {
 457                 set errmsg "$message: the program exited"
 458             } else {
 459                 set errmsg "$command: the program exited"
 460             }
 461             fail "$errmsg"
 462             return -1
 463         }
 464          -re "The program is not being run.*$gdb_prompt $" {
 465             if ![string match "" $message] then {
 466                 set errmsg "$message: the program is no longer running"
 467             } else {
 468                 set errmsg "$command: the program is no longer running"
 469             }
 470             fail "$errmsg"
 471             return -1
 472         }
 473          -re ".*$gdb_prompt $" {
 474             if ![string match "" $message] then {
 475                 fail "$message"
 476             }
 477             set result 1
 478         }
 479          "<return>" {
 480             send_gdb "\n"
 481             perror "Window too small."
 482             fail "$message"
 483         }
 484          -re "\\(y or n\\) " {
 485             send_gdb "n\n"
 486             perror "Got interactive prompt."
 487             fail "$message"
 488         }
 489          eof {
 490              perror "Process no longer exists"
 491              if { $message != "" } {
 492                  fail "$message"
 493              }
 494              return -1
 495         }
 496          full_buffer {
 497             perror "internal buffer is full."
 498             fail "$message"
 499         }
 500         timeout {
 501             if ![string match "" $message] then {
 502                 fail "$message (timeout)"
 503             }
 504             set result 1
 505         }
 506     }
 507     return $result
 508 }
 509 \f
 510 # Test that a command gives an error.  For pass or fail, return
 511 # a 1 to indicate that more tests can proceed.  However a timeout
 512 # is a serious error, generates a special fail message, and causes
 513 # a 0 to be returned to indicate that more tests are likely to fail
 514 # as well.
 515
 516 proc test_print_reject { args } {
 517     global gdb_prompt
 518     global verbose
 519
 520     if [llength $args]==2 then {
 521         set expectthis [lindex $args 1]
 522     } else {
 523         set expectthis "should never match this bogus string"
 524     }
 525     set sendthis [lindex $args 0]
 526     if $verbose>2 then {
 527         send_user "Sending \"$sendthis\" to gdb\n"
 528         send_user "Looking to match \"$expectthis\"\n"
 529     }
 530     send_gdb "$sendthis\n"
 531     #FIXME: Should add timeout as parameter.
 532     gdb_expect {
 533         -re "A .* in expression.*\\.*$gdb_prompt $" {
 534             pass "reject $sendthis"
 535             return 1
 536         }
 537         -re "Invalid syntax in expression.*$gdb_prompt $" {
 538             pass "reject $sendthis"
 539             return 1
 540         }
 541         -re "Junk after end of expression.*$gdb_prompt $" {
 542             pass "reject $sendthis"
 543             return 1
 544         }
 545         -re "Invalid number.*$gdb_prompt $" {
 546             pass "reject $sendthis"
 547             return 1
 548         }
 549         -re "Invalid character constant.*$gdb_prompt $" {
 550             pass "reject $sendthis"
 551             return 1
 552         }
 553         -re "No symbol table is loaded.*$gdb_prompt $" {
 554             pass "reject $sendthis"
 555             return 1
 556         }
 557         -re "No symbol .* in current context.*$gdb_prompt $" {
 558             pass "reject $sendthis"
 559             return 1
 560         }
 561         -re "$expectthis.*$gdb_prompt $" {
 562             pass "reject $sendthis"
 563             return 1
 564         }
 565         -re ".*$gdb_prompt $" {
 566             fail "reject $sendthis"
 567             return 1
 568         }
 569         default {
 570             fail "reject $sendthis (eof or timeout)"
 571             return 0
 572         }
 573     }
 574 }
 575 \f
 576 # Given an input string, adds backslashes as needed to create a
 577 # regexp that will match the string.
 578
 579 proc string_to_regexp {str} {
 580     set result $str
 581     regsub -all {[]*+.|()^$\[]} $str {\\&} result
 582     return $result
 583 }
 584
 585 # Same as gdb_test, but the second parameter is not a regexp,
 586 # but a string that must match exactly.
 587
 588 proc gdb_test_exact { args } {
 589     upvar timeout timeout
 590
 591     set command [lindex $args 0]
 592
 593     # This applies a special meaning to a null string pattern.  Without
 594     # this, "$pattern\r\n$gdb_prompt $" will match anything, including error
 595     # messages from commands that should have no output except a new
 596     # prompt.  With this, only results of a null string will match a null
 597     # string pattern.
 598
 599     set pattern [lindex $args 1]
 600     if [string match $pattern ""] {
 601         set pattern [string_to_regexp [lindex $args 0]]
 602     } else {
 603         set pattern [string_to_regexp [lindex $args 1]]
 604     }
 605
 606     # It is most natural to write the pattern argument with only
 607     # embedded \n's, especially if you are trying to avoid Tcl quoting
 608     # problems.  But gdb_expect really wants to see \r\n in patterns.  So
 609     # transform the pattern here.  First transform \r\n back to \n, in
 610     # case some users of gdb_test_exact already do the right thing.
 611     regsub -all "\r\n" $pattern "\n" pattern
 612     regsub -all "\n" $pattern "\r\n" pattern
 613     if [llength $args]==3 then {
 614         set message [lindex $args 2]
 615     } else {
 616         set message $command
 617     }
 618
 619     return [gdb_test $command $pattern $message]
 620 }
 621 \f
 622 proc gdb_reinitialize_dir { subdir } {
 623     global gdb_prompt
 624
 625     if [is_remote host] {
 626         return "";
 627     }
 628     send_gdb "dir\n"
 629     gdb_expect 60 {
 630         -re "Reinitialize source path to empty.*y or n. " {
 631             send_gdb "y\n"
 632             gdb_expect 60 {
 633                 -re "Source directories searched.*$gdb_prompt $" {
 634                     send_gdb "dir $subdir\n"
 635                     gdb_expect 60 {
 636                         -re "Source directories searched.*$gdb_prompt $" {
 637                             verbose "Dir set to $subdir"
 638                         }
 639                         -re "$gdb_prompt $" {
 640                             perror "Dir \"$subdir\" failed."
 641                         }
 642                     }
 643                 }
 644                 -re "$gdb_prompt $" {
 645                     perror "Dir \"$subdir\" failed."
 646                 }
 647             }
 648         }
 649         -re "$gdb_prompt $" {
 650             perror "Dir \"$subdir\" failed."
 651         }
 652     }
 653 }
 654
 655 #
 656 # gdb_exit -- exit the GDB, killing the target program if necessary
 657 #
 658 proc default_gdb_exit {} {
 659     global GDB
 660     global GDBFLAGS
 661     global verbose
 662     global gdb_spawn_id;
 663
 664     gdb_stop_suppressing_tests;
 665
 666     if ![info exists gdb_spawn_id] {
 667         return;
 668     }
 669
 670     verbose "Quitting $GDB $GDBFLAGS"
 671
 672     if { [is_remote host] && [board_info host exists fileid] } {
 673         send_gdb "quit\n";
 674         gdb_expect 10 {
 675             -re "y or n" {
 676                 send_gdb "y\n";
 677                 exp_continue;
 678             }
 679             -re "DOSEXIT code" { }
 680             default { }
 681         }
 682     }
 683
 684     if ![is_remote host] {
 685         remote_close host;
 686     }
 687     unset gdb_spawn_id
 688 }
 689
 690 #
 691 # load a file into the debugger.
 692 # return a -1 if anything goes wrong.
 693 #
 694 proc gdb_file_cmd { arg } {
 695     global verbose
 696     global loadpath
 697     global loadfile
 698     global GDB
 699     global gdb_prompt
 700     upvar timeout timeout
 701
 702     if [is_remote host] {
 703         set arg [remote_download host $arg];
 704         if { $arg == "" } {
 705             error "download failed"
 706             return -1;
 707         }
 708     }
 709
 710     send_gdb "file $arg\n"
 711     gdb_expect 120 {
 712         -re "Reading symbols from.*done.*$gdb_prompt $" {
 713             verbose "\t\tLoaded $arg into the $GDB"
 714             return 0
 715         }
 716         -re "has no symbol-table.*$gdb_prompt $" {
 717             perror "$arg wasn't compiled with \"-g\""
 718             return -1
 719         }
 720         -re "A program is being debugged already.*Kill it.*y or n. $" {
 721             send_gdb "y\n"
 722                 verbose "\t\tKilling previous program being debugged"
 723             exp_continue
 724         }
 725         -re "Load new symbol table from \".*\".*y or n. $" {
 726             send_gdb "y\n"
 727             gdb_expect 120 {
 728                 -re "Reading symbols from.*done.*$gdb_prompt $" {
 729                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
 730                     return 0
 731                 }
 732                 timeout {
 733                     perror "(timeout) Couldn't load $arg, other program already loaded."
 734                     return -1
 735                 }
 736             }
 737         }
 738         -re "No such file or directory.*$gdb_prompt $" {
 739             perror "($arg) No such file or directory\n"
 740             return -1
 741         }
 742         -re "$gdb_prompt $" {
 743             perror "couldn't load $arg into $GDB."
 744             return -1
 745             }
 746         timeout {
 747             perror "couldn't load $arg into $GDB (timed out)."
 748             return -1
 749         }
 750         eof {
 751             # This is an attempt to detect a core dump, but seems not to
 752             # work.  Perhaps we need to match .* followed by eof, in which
 753             # gdb_expect does not seem to have a way to do that.
 754             perror "couldn't load $arg into $GDB (end of file)."
 755             return -1
 756         }
 757     }
 758 }
 759
 760 #
 761 # start gdb -- start gdb running, default procedure
 762 #
 763 # When running over NFS, particularly if running many simultaneous
 764 # tests on different hosts all using the same server, things can
 765 # get really slow.  Give gdb at least 3 minutes to start up.
 766 #
 767 proc default_gdb_start { } {
 768     global verbose
 769     global GDB
 770     global GDBFLAGS
 771     global gdb_prompt
 772     global timeout
 773     global gdb_spawn_id;
 774
 775     gdb_stop_suppressing_tests;
 776
 777     verbose "Spawning $GDB -nw $GDBFLAGS"
 778
 779     if [info exists gdb_spawn_id] {
 780         return 0;
 781     }
 782
 783     if ![is_remote host] {
 784         if { [which $GDB] == 0 } then {
 785             perror "$GDB does not exist."
 786             exit 1
 787         }
 788     }
 789     set res [remote_spawn host "$GDB -nw $GDBFLAGS [host_info gdb_opts]"];
 790     if { $res < 0 || $res == "" } {
 791         perror "Spawning $GDB failed."
 792         return 1;
 793     }
 794     gdb_expect 360 {
 795         -re "\[\r\n\]$gdb_prompt $" {
 796             verbose "GDB initialized."
 797         }
 798         -re "$gdb_prompt $"     {
 799             perror "GDB never initialized."
 800             return -1
 801         }
 802         timeout {
 803             perror "(timeout) GDB never initialized after 10 seconds."
 804             remote_close host;
 805             return -1
 806         }
 807     }
 808     set gdb_spawn_id -1;
 809     # force the height to "unlimited", so no pagers get used
 810
 811     send_gdb "set height 0\n"
 812     gdb_expect 10 {
 813         -re "$gdb_prompt $" {
 814             verbose "Setting height to 0." 2
 815         }
 816         timeout {
 817             warning "Couldn't set the height to 0"
 818         }
 819     }
 820     # force the width to "unlimited", so no wraparound occurs
 821     send_gdb "set width 0\n"
 822     gdb_expect 10 {
 823         -re "$gdb_prompt $" {
 824             verbose "Setting width to 0." 2
 825         }
 826         timeout {
 827             warning "Couldn't set the width to 0."
 828         }
 829     }
 830     return 0;
 831 }
 832
 833 # * For crosses, the CHILL runtime doesn't build because it can't find
 834 # setjmp.h, stdio.h, etc.
 835 # * For AIX (as of 16 Mar 95), (a) there is no language code for
 836 # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2
 837 # does not get along with AIX's too-clever linker.
 838 # * On Irix5, there is a bug whereby set of bool, etc., don't get
 839 # TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't
 840 # work with stub types.
 841 # Lots of things seem to fail on the PA, and since it's not a supported
 842 # chill target at the moment, don't run the chill tests.
 843
 844 proc skip_chill_tests {} {
 845     if ![info exists do_chill_tests] {
 846         return 1;
 847     }
 848     eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "*-*-irix6*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]]
 849     verbose "Skip chill tests is $skip_chill"
 850     return $skip_chill
 851 }
 852
 853 # Skip all the tests in the file if you are not on an hppa running
 854 # hpux target.
 855
 856 proc skip_hp_tests {} {
 857     eval set skip_hp [ expr ![isnative] || ![istarget "hppa*-*-hpux*"] ]
 858     verbose "Skip hp tests is $skip_hp"
 859     return $skip_hp
 860 }
 861
 862 proc get_compiler_info {binfile args} {
 863     # Create and source the file that provides information about the compiler
 864     # used to compile the test case.
 865     # Compiler_type can be null or c++. If null we assume c.
 866     global srcdir
 867     global subdir
 868     # These two come from compiler.c.
 869     global signed_keyword_not_used
 870     global gcc_compiled
 871
 872     if {![istarget "hppa*-*-hpux*"]} {
 873         if { [llength $args] > 0 } {
 874             if {$args == "c++"} {
 875         if { [gdb_compile "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci" preprocess {}] != "" } {
 876                     perror "Couldn't make ${binfile}.ci file"
 877                     return 1;
 878                 }
 879             }
 880         } else {
 881             if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
 882                 perror "Couldn't make ${binfile}.ci file"
 883                 return 1;
 884             }
 885         }
 886     } else {
 887         if { [llength $args] > 0 } {
 888             if {$args == "c++"} {
 889                 if { [eval gdb_preprocess \
 890                         [list "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci"] \
 891                         $args] != "" } {
 892                     perror "Couldn't make ${binfile}.ci file"
 893                     return 1;
 894                 }
 895             }
 896         } elseif { $args != "f77" } {
 897             if { [eval gdb_preprocess \
 898                     [list "${srcdir}/${subdir}/compiler.c" "${binfile}.ci"] \
 899                     $args] != "" } {
 900                 perror "Couldn't make ${binfile}.ci file"
 901                 return 1;
 902             }
 903         }
 904     }
 905
 906     uplevel \#0 { set gcc_compiled 0 }
 907
 908     if { [llength $args] == 0 || $args != "f77" } {
 909         source ${binfile}.ci
 910     }
 911
 912     # Most compilers will evaluate comparisons and other boolean
 913     # operations to 0 or 1.
 914     uplevel \#0 { set true 1 }
 915     uplevel \#0 { set false 0 }
 916
 917     uplevel \#0 { set hp_cc_compiler 0 }
 918     uplevel \#0 { set hp_aCC_compiler 0 }
 919     uplevel \#0 { set hp_f77_compiler 0 }
 920     uplevel \#0 { set hp_f90_compiler 0 }
 921     if { !$gcc_compiled && [istarget "hppa*-*-hpux*"] } {
 922         # Check for the HP compilers
 923         set compiler [lindex [split [get_compiler $args] " "] 0]
 924         catch "exec what $compiler" output
 925         if [regexp ".*HP aC\\+\\+.*" $output] {
 926             uplevel \#0 { set hp_aCC_compiler 1 }
 927             # Use of aCC results in boolean results being displayed as
 928             # "true" or "false"
 929             uplevel \#0 { set true true }
 930             uplevel \#0 { set false false }
 931         } elseif [regexp ".*HP C Compiler.*" $output] {
 932             uplevel \#0 { set hp_cc_compiler 1 }
 933         } elseif [regexp ".*HP-UX f77.*" $output] {
 934             uplevel \#0 { set hp_f77_compiler 1 }
 935         } elseif [regexp ".*HP-UX f90.*" $output] {
 936             uplevel \#0 { set hp_f90_compiler 1 }
 937         }
 938     }
 939
 940     return 0;
 941 }
 942
 943 proc get_compiler {args} {
 944     global CC CC_FOR_TARGET CXX CXX_FOR_TARGET F77_FOR_TARGET
 945
 946     if { [llength $args] == 0
 947          || ([llength $args] == 1 && [lindex $args 0] == "") } {
 948         set which_compiler "c"
 949     } else {
 950         if { $args =="c++" } {
 951             set which_compiler "c++"
 952         } elseif { $args =="f77" } {
 953             set which_compiler "f77"
 954         } else {
 955             perror "Unknown compiler type supplied to gdb_preprocess"
 956             return ""
 957         }
 958     }
 959
 960     if [info exists CC_FOR_TARGET] {
 961         if {$which_compiler == "c"} {
 962             set compiler $CC_FOR_TARGET
 963         }
 964     }
 965
 966     if [info exists CXX_FOR_TARGET] {
 967         if {$which_compiler == "c++"} {
 968             set compiler $CXX_FOR_TARGET
 969         }
 970     }
 971
 972     if [info exists F77_FOR_TARGET] {
 973         if {$which_compiler == "f77"} {
 974             set compiler $F77_FOR_TARGET
 975         }
 976     }
 977
 978     if { ![info exists compiler] } {
 979         if { $which_compiler == "c" } {
 980             if {[info exists CC]} {
 981                 set compiler $CC
 982             }
 983         }
 984         if { $which_compiler == "c++" } {
 985             if {[info exists CXX]} {
 986                 set compiler $CXX
 987             }
 988         }
 989         if {![info exists compiler]} {
 990             set compiler [board_info [target_info name] compiler];
 991             if { $compiler == "" } {
 992                 perror "get_compiler: No compiler found"
 993                 return ""
 994             }
 995         }
 996     }
 997
 998     return $compiler
 999 }
1000
1001 proc gdb_preprocess {source dest args} {
1002     set compiler [get_compiler "$args"]
1003     if { $compiler == "" } {
1004         return 1
1005     }
1006
1007     set cmdline "$compiler -E $source > $dest"
1008
1009     verbose "Invoking $compiler -E $source > $dest"
1010     verbose -log "Executing on local host: $cmdline" 2
1011     set status [catch "exec ${cmdline}" exec_output]
1012
1013     set result [prune_warnings $exec_output]
1014     regsub "\[\r\n\]*$" "$result" "" result;
1015     regsub "^\[\r\n\]*" "$result" "" result;
1016     if { $result != "" } {
1017         clone_output "gdb compile failed, $result"
1018     }
1019     return $result;
1020 }
1021
1022 proc gdb_compile {source dest type options} {
1023     global GDB_TESTCASE_OPTIONS;
1024
1025     if [target_info exists gdb_stub] {
1026         set options2 { "additional_flags=-Dusestubs" }
1027         lappend options "libs=[target_info gdb_stub]";
1028         set options [concat $options2 $options]
1029     }
1030     if [target_info exists is_vxworks] {
1031         set options2 { "additional_flags=-Dvxworks" }
1032         lappend options "libs=[target_info gdb_stub]";
1033         set options [concat $options2 $options]
1034     }
1035     if [info exists GDB_TESTCASE_OPTIONS] {
1036         lappend options "additional_flags=$GDB_TESTCASE_OPTIONS";
1037     }
1038     verbose "options are $options"
1039     verbose "source is $source $dest $type $options"
1040
1041     set result [target_compile $source $dest $type $options];
1042     regsub "\[\r\n\]*$" "$result" "" result;
1043     regsub "^\[\r\n\]*" "$result" "" result;
1044     if { $result != "" } {
1045         clone_output "gdb compile failed, $result"
1046     }
1047     return $result;
1048 }
1049
1050 proc send_gdb { string } {
1051     global suppress_flag;
1052     if { $suppress_flag } {
1053         return "suppressed";
1054     }
1055     return [remote_send host "$string"];
1056 }
1057
1058 #
1059 #
1060
1061 proc gdb_expect { args } {
1062     # allow -notransfer expect flag specification,
1063     # used by gdb_test routine for multi-line commands.
1064     # packed with gtimeout when fed to remote_expect routine,
1065     # which is a hack but due to what looks like a res and orig
1066     # parsing problem in remote_expect routine (dejagnu/lib/remote.exp):
1067     # what's fed into res is not removed from orig.
1068     # - guo
1069     if { [lindex $args 0] == "-notransfer" } {
1070         set notransfer -notransfer;
1071         set args [lrange $args 1 end];
1072     } else {
1073         set notransfer "";
1074     }
1075
1076     if { [llength $args] == 2  && [lindex $args 0] != "-re" } {
1077         set gtimeout [lindex $args 0];
1078         set expcode [list [lindex $args 1]];
1079     } else {
1080         upvar timeout timeout;
1081
1082         set expcode $args;
1083         if [target_info exists gdb,timeout] {
1084             if [info exists timeout] {
1085                 if { $timeout < [target_info gdb,timeout] } {
1086                     set gtimeout [target_info gdb,timeout];
1087                 } else {
1088                     set gtimeout $timeout;
1089                 }
1090             } else {
1091                 set gtimeout [target_info gdb,timeout];
1092             }
1093         }
1094
1095         if ![info exists gtimeout] {
1096             global timeout;
1097             if [info exists timeout] {
1098                 set gtimeout $timeout;
1099             } else {
1100                 # Eeeeew.
1101                 set gtimeout 60;
1102             }
1103         }
1104     }
1105     global suppress_flag;
1106     global remote_suppress_flag;
1107     if [info exists remote_suppress_flag] {
1108         set old_val $remote_suppress_flag;
1109     }
1110     if [info exists suppress_flag] {
1111         if { $suppress_flag } {
1112             set remote_suppress_flag 1;
1113         }
1114     }
1115     set code [catch \
1116         {uplevel remote_expect host "$gtimeout $notransfer" $expcode} string];
1117     if [info exists old_val] {
1118         set remote_suppress_flag $old_val;
1119     } else {
1120         if [info exists remote_suppress_flag] {
1121             unset remote_suppress_flag;
1122         }
1123     }
1124
1125     if {$code == 1} {
1126         global errorInfo errorCode;
1127
1128         return -code error -errorinfo $errorInfo -errorcode $errorCode $string
1129     } elseif {$code == 2} {
1130         return -code return $string
1131     } elseif {$code == 3} {
1132         return
1133     } elseif {$code > 4} {
1134         return -code $code $string
1135     }
1136 }
1137
1138 #
1139 # Check for long sequence of output by parts.
1140 # TEST: is the test message.
1141 # SENTINEL: Is the terminal pattern indicating that output has finished.
1142 # LIST: is the sequence of outputs to match.
1143 # If the sentinel is recognized early, it is considered an error.
1144 #
1145 proc gdb_expect_list {test sentinal list} {
1146     global gdb_prompt
1147     set index 0
1148     set ok 1
1149     while { ${index} < [llength ${list}] } {
1150         set pattern [lindex ${list} ${index}]
1151         set index [expr ${index} + 1]
1152         if { ${index} == [llength ${list}] } {
1153             if { ${ok} } {
1154                 gdb_expect {
1155                     -re "${pattern}${sentinal}" {
1156                         pass "${test}, pattern ${index} + sentinal"
1157                     }
1158                     timeout {
1159                         fail "${test}, pattern ${index} + sentinal (timeout)"
1160                         set ok 0
1161                     }
1162                 }
1163             } else {
1164                 fail "${test}, pattern ${index} + sentinal"
1165             }
1166         } else {
1167             if { ${ok} } {
1168                 gdb_expect {
1169                     -re "${pattern}" {
1170                         pass "${test}, pattern ${index}"
1171                     }
1172                     -re "${sentinal}" {
1173                         fail "${test}, pattern ${index}"
1174                         set ok 0
1175                     }
1176                     timeout {
1177                         fail "${test}, pattern ${index} (timeout)"
1178                         set ok 0
1179                     }
1180                 }
1181             } else {
1182                 fail "${test}, pattern ${index}"
1183             }
1184         }
1185     }
1186 }
1187
1188 #
1189 #
1190 proc gdb_suppress_entire_file { reason } {
1191     global suppress_flag;
1192
1193     warning "$reason\n";
1194     set suppress_flag -1;
1195 }
1196
1197 #
1198 # Set suppress_flag, which will cause all subsequent calls to send_gdb and
1199 # gdb_expect to fail immediately (until the next call to
1200 # gdb_stop_suppressing_tests).
1201 #
1202 proc gdb_suppress_tests { args } {
1203     global suppress_flag;
1204
1205     return;  # fnf - disable pending review of results where
1206              # testsuite ran better without this
1207     incr suppress_flag;
1208
1209     if { $suppress_flag == 1 } {
1210         if { [llength $args] > 0 } {
1211             warning "[lindex $args 0]\n";
1212         } else {
1213             warning "Because of previous failure, all subsequent tests in this group will automatically fail.\n";
1214         }
1215     }
1216 }
1217
1218 #
1219 # Clear suppress_flag.
1220 #
1221 proc gdb_stop_suppressing_tests { } {
1222     global suppress_flag;
1223
1224     if [info exists suppress_flag] {
1225         if { $suppress_flag > 0 } {
1226             set suppress_flag 0;
1227             clone_output "Tests restarted.\n";
1228         }
1229     } else {
1230         set suppress_flag 0;
1231     }
1232 }
1233
1234 proc gdb_clear_suppressed { } {
1235     global suppress_flag;
1236
1237     set suppress_flag 0;
1238 }
1239
1240 proc gdb_start { } {
1241     default_gdb_start
1242 }
1243
1244 proc gdb_exit { } {
1245     catch default_gdb_exit
1246 }
1247
1248 #
1249 # gdb_load -- load a file into the debugger.
1250 #             return a -1 if anything goes wrong.
1251 #
1252 proc gdb_load { arg } {
1253     return [gdb_file_cmd $arg]
1254 }
1255
1256 proc gdb_continue { function } {
1257     global decimal
1258
1259     return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"];
1260 }
1261
1262 proc default_gdb_init { args } {
1263     gdb_clear_suppressed;
1264
1265     # Uh, this is lame. Really, really, really lame. But there's this *one*
1266     # testcase that will fail in random places if we don't increase this.
1267     match_max -d 20000
1268
1269     # We want to add the name of the TCL testcase to the PASS/FAIL messages.
1270     if { [llength $args] > 0 } {
1271         global pf_prefix
1272
1273         set file [lindex $args 0];
1274
1275         set pf_prefix "[file tail [file dirname $file]]/[file tail $file]:";
1276     }
1277     global gdb_prompt;
1278     if [target_info exists gdb_prompt] {
1279         set gdb_prompt [target_info gdb_prompt];
1280     } else {
1281         set gdb_prompt "\\(gdb\\)"
1282     }
1283 }
1284
1285 proc gdb_init { args } {
1286     return [eval default_gdb_init $args];
1287 }
1288
1289 proc gdb_finish { } {
1290     gdb_exit;
1291 }
1292
1293 global debug_format
1294 set debug_format "unknown"
1295
1296 # Run the gdb command "info source" and extract the debugging format
1297 # information from the output and save it in debug_format.
1298
1299 proc get_debug_format { } {
1300     global gdb_prompt
1301     global verbose
1302     global expect_out
1303     global debug_format
1304
1305     set debug_format "unknown"
1306     send_gdb "info source\n"
1307     gdb_expect 10 {
1308         -re "Compiled with (.*) debugging format.\r\n$gdb_prompt $" {
1309             set debug_format $expect_out(1,string)
1310             verbose "debug format is $debug_format"
1311             return 1;
1312         }
1313         -re "No current source file.\r\n$gdb_prompt $" {
1314             perror "get_debug_format used when no current source file"
1315             return 0;
1316         }
1317         -re "$gdb_prompt $" {
1318             warning "couldn't check debug format (no valid response)."
1319             return 1;
1320         }
1321         timeout {
1322             warning "couldn't check debug format (timed out)."
1323             return 1;
1324         }
1325     }
1326 }
1327
1328 # Like setup_xfail, but takes the name of a debug format (DWARF 1,
1329 # COFF, stabs, etc).  If that format matches the format that the
1330 # current test was compiled with, then the next test is expected to
1331 # fail for any target.  Returns 1 if the next test or set of tests is
1332 # expected to fail, 0 otherwise (or if it is unknown).  Must have
1333 # previously called get_debug_format.
1334
1335 proc setup_xfail_format { format } {
1336     global debug_format
1337
1338     if [string match $debug_format $format] then {
1339         setup_xfail "*-*-*"
1340         return 1;
1341     }
1342     return 0
1343 }
1344
1345 proc gdb_step_for_stub { } {
1346     global gdb_prompt;
1347
1348     if ![target_info exists gdb,use_breakpoint_for_stub] {
1349         if [target_info exists gdb_stub_step_command] {
1350             set command [target_info gdb_stub_step_command];
1351         } else {
1352             set command "step";
1353         }
1354         send_gdb "${command}\n";
1355         set tries 0;
1356         gdb_expect 60 {
1357             -re "(main.* at |.*in .*start).*$gdb_prompt" {
1358                 return;
1359             }
1360             -re ".*$gdb_prompt" {
1361                 incr tries;
1362                 if { $tries == 5 } {
1363                     fail "stepping out of breakpoint function";
1364                     return;
1365                 }
1366                 send_gdb "${command}\n";
1367                 exp_continue;
1368             }
1369             default {
1370                 fail "stepping out of breakpoint function";
1371                 return;
1372             }
1373         }
1374     }
1375     send_gdb "where\n";
1376     gdb_expect {
1377         -re "main\[^\r\n\]*at \(\[^:]+\):\(\[0-9\]+\)" {
1378             set file $expect_out(1,string);
1379             set linenum [expr $expect_out(2,string) + 1];
1380             set breakplace "${file}:${linenum}";
1381         }
1382         default {}
1383     }
1384     send_gdb "break ${breakplace}\n";
1385     gdb_expect 60 {
1386         -re "Breakpoint (\[0-9\]+) at.*$gdb_prompt" {
1387             set breakpoint $expect_out(1,string);
1388         }
1389         -re "Breakpoint (\[0-9\]+): file.*$gdb_prompt" {
1390             set breakpoint $expect_out(1,string);
1391         }
1392         default {}
1393     }
1394     send_gdb "continue\n";
1395     gdb_expect 60 {
1396         -re "Breakpoint ${breakpoint},.*$gdb_prompt" {
1397             gdb_test "delete $breakpoint" ".*" "";
1398             return;
1399         }
1400         default {}
1401     }
1402 }
1403
1404 ### gdb_get_line_number TEXT [FILE]
1405 ###
1406 ### Search the source file FILE, and return the line number of a line
1407 ### containing TEXT.  Use this function instead of hard-coding line
1408 ### numbers into your test script.
1409 ###
1410 ### Specifically, this function uses GDB's "search" command to search
1411 ### FILE for the first line containing TEXT, and returns its line
1412 ### number.  Thus, FILE must be a source file, compiled into the
1413 ### executable you are running.  If omitted, FILE defaults to the
1414 ### value of the global variable `srcfile'; most test scripts set
1415 ### `srcfile' appropriately at the top anyway.
1416 ###
1417 ### Use this function to keep your test scripts independent of the
1418 ### exact line numbering of the source file.  Don't write:
1419 ###
1420 ###   send_gdb "break 20"
1421 ###
1422 ### This means that if anyone ever edits your test's source file,
1423 ### your test could break.  Instead, put a comment like this on the
1424 ### source file line you want to break at:
1425 ###
1426 ###   /* breakpoint spot: frotz.exp: test name */
1427 ###
1428 ### and then write, in your test script (which we assume is named
1429 ### frotz.exp):
1430 ###
1431 ###   send_gdb "break [gdb_get_line_number "frotz.exp: test name"]\n"
1432 ###
1433 ### (Yes, Tcl knows how to handle the nested quotes and brackets.
1434 ### Try this:
1435 ###     $ tclsh
1436 ###     % puts "foo [lindex "bar baz" 1]"
1437 ###     foo baz
1438 ###     %
1439 ### Tcl is quite clever, for a little stringy language.)
1440
1441 proc gdb_get_line_number {text {file /omitted/}} {
1442     global gdb_prompt;
1443     global srcfile;
1444
1445     if {! [string compare $file /omitted/]} {
1446         set file $srcfile
1447     }
1448
1449     set result -1;
1450     gdb_test "list ${file}:1,1" ".*" ""
1451     send_gdb "search ${text}\n"
1452     gdb_expect {
1453         -re "\[\r\n\]+(\[0-9\]+)\[ \t\].*${text}.*$gdb_prompt $" {
1454             set result $expect_out(1,string)
1455         }
1456         -re ".*$gdb_prompt $" {
1457             fail "find line number containing \"${text}\""
1458         }
1459         timeout {
1460             fail "find line number containing \"${text}\" (timeout)"
1461         }
1462     }
1463     return $result;
1464 }
1465
1466 # gdb_continue_to_end:
1467 #       The case where the target uses stubs has to be handled specially. If a
1468 #       stub is used, we set a breakpoint at exit because we cannot rely on
1469 #       exit() behavior of a remote target.
1470 #
1471 # mssg is the error message that gets printed.
1472
1473 proc gdb_continue_to_end {mssg} {
1474   if [target_info exists use_gdb_stub] {
1475     if {![gdb_breakpoint "exit"]} {
1476       return 0
1477     }
1478     gdb_test "continue" "Continuing..*Breakpoint .*exit.*" \
1479       "continue until exit at $mssg"
1480   } else {
1481     # Continue until we exit.  Should not stop again.
1482     # Don't bother to check the output of the program, that may be
1483     # extremely tough for some remote systems.
1484     gdb_test "continue"\
1485       "Continuing.\[\r\n0-9\]+Program exited normally\\..*"\
1486       "continue until exit at $mssg"
1487   }
1488 }
1489
1490 proc rerun_to_main {} {
1491   global gdb_prompt
1492
1493   if [target_info exists use_gdb_stub] {
1494     gdb_run_cmd
1495     gdb_expect {
1496       -re ".*Breakpoint .*main .*$gdb_prompt $"\
1497               {pass "rerun to main" ; return 0}
1498       -re "$gdb_prompt $"\
1499               {fail "rerun to main" ; return 0}
1500       timeout {fail "(timeout) rerun to main" ; return 0}
1501     }
1502   } else {
1503     send_gdb "run\n"
1504     gdb_expect {
1505       -re "Starting program.*$gdb_prompt $"\
1506               {pass "rerun to main" ; return 0}
1507       -re "$gdb_prompt $"\
1508               {fail "rerun to main" ; return 0}
1509       timeout {fail "(timeout) rerun to main" ; return 0}
1510     }
1511   }
1512 }
1513