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 # Return a 1 for configurations for which we don't even want to try to
 834 # test C++.
 835
 836 proc skip_cplus_tests {} {
 837     if { [istarget "d10v-*-*"] } {
 838         return 1
 839     }
 840     if { [istarget "h8300-*-*"] } {
 841         return 1
 842     }
 843     return 0
 844 }
 845
 846 # * For crosses, the CHILL runtime doesn't build because it can't find
 847 # setjmp.h, stdio.h, etc.
 848 # * For AIX (as of 16 Mar 95), (a) there is no language code for
 849 # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2
 850 # does not get along with AIX's too-clever linker.
 851 # * On Irix5, there is a bug whereby set of bool, etc., don't get
 852 # TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't
 853 # work with stub types.
 854 # Lots of things seem to fail on the PA, and since it's not a supported
 855 # chill target at the moment, don't run the chill tests.
 856
 857 proc skip_chill_tests {} {
 858     if ![info exists do_chill_tests] {
 859         return 1;
 860     }
 861     eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "*-*-irix6*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]]
 862     verbose "Skip chill tests is $skip_chill"
 863     return $skip_chill
 864 }
 865
 866 # Skip all the tests in the file if you are not on an hppa running
 867 # hpux target.
 868
 869 proc skip_hp_tests {} {
 870     eval set skip_hp [ expr ![isnative] || ![istarget "hppa*-*-hpux*"] ]
 871     verbose "Skip hp tests is $skip_hp"
 872     return $skip_hp
 873 }
 874
 875 proc get_compiler_info {binfile args} {
 876     # Create and source the file that provides information about the compiler
 877     # used to compile the test case.
 878     # Compiler_type can be null or c++. If null we assume c.
 879     global srcdir
 880     global subdir
 881     # These two come from compiler.c.
 882     global signed_keyword_not_used
 883     global gcc_compiled
 884
 885     if {![istarget "hppa*-*-hpux*"]} {
 886         if { [llength $args] > 0 } {
 887             if {$args == "c++"} {
 888                 if { [gdb_compile "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci" preprocess {}] != "" } {
 889                     perror "Couldn't make ${binfile}.ci file"
 890                     return 1;
 891                 }
 892             }
 893         } else {
 894             if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
 895                 perror "Couldn't make ${binfile}.ci file"
 896                 return 1;
 897             }
 898         }
 899     } else {
 900         if { [llength $args] > 0 } {
 901             if {$args == "c++"} {
 902                 if { [eval gdb_preprocess \
 903                         [list "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci"] \
 904                         $args] != "" } {
 905                     perror "Couldn't make ${binfile}.ci file"
 906                     return 1;
 907                 }
 908             }
 909         } elseif { $args != "f77" } {
 910             if { [eval gdb_preprocess \
 911                     [list "${srcdir}/${subdir}/compiler.c" "${binfile}.ci"] \
 912                     $args] != "" } {
 913                 perror "Couldn't make ${binfile}.ci file"
 914                 return 1;
 915             }
 916         }
 917     }
 918
 919     uplevel \#0 { set gcc_compiled 0 }
 920
 921     if { [llength $args] == 0 || $args != "f77" } {
 922         source ${binfile}.ci
 923     }
 924
 925     # Most compilers will evaluate comparisons and other boolean
 926     # operations to 0 or 1.
 927     uplevel \#0 { set true 1 }
 928     uplevel \#0 { set false 0 }
 929
 930     uplevel \#0 { set hp_cc_compiler 0 }
 931     uplevel \#0 { set hp_aCC_compiler 0 }
 932     uplevel \#0 { set hp_f77_compiler 0 }
 933     uplevel \#0 { set hp_f90_compiler 0 }
 934     if { !$gcc_compiled && [istarget "hppa*-*-hpux*"] } {
 935         # Check for the HP compilers
 936         set compiler [lindex [split [get_compiler $args] " "] 0]
 937         catch "exec what $compiler" output
 938         if [regexp ".*HP aC\\+\\+.*" $output] {
 939             uplevel \#0 { set hp_aCC_compiler 1 }
 940             # Use of aCC results in boolean results being displayed as
 941             # "true" or "false"
 942             uplevel \#0 { set true true }
 943             uplevel \#0 { set false false }
 944         } elseif [regexp ".*HP C Compiler.*" $output] {
 945             uplevel \#0 { set hp_cc_compiler 1 }
 946         } elseif [regexp ".*HP-UX f77.*" $output] {
 947             uplevel \#0 { set hp_f77_compiler 1 }
 948         } elseif [regexp ".*HP-UX f90.*" $output] {
 949             uplevel \#0 { set hp_f90_compiler 1 }
 950         }
 951     }
 952
 953     return 0;
 954 }
 955
 956 proc get_compiler {args} {
 957     global CC CC_FOR_TARGET CXX CXX_FOR_TARGET F77_FOR_TARGET
 958
 959     if { [llength $args] == 0
 960          || ([llength $args] == 1 && [lindex $args 0] == "") } {
 961         set which_compiler "c"
 962     } else {
 963         if { $args =="c++" } {
 964             set which_compiler "c++"
 965         } elseif { $args =="f77" } {
 966             set which_compiler "f77"
 967         } else {
 968             perror "Unknown compiler type supplied to gdb_preprocess"
 969             return ""
 970         }
 971     }
 972
 973     if [info exists CC_FOR_TARGET] {
 974         if {$which_compiler == "c"} {
 975             set compiler $CC_FOR_TARGET
 976         }
 977     }
 978
 979     if [info exists CXX_FOR_TARGET] {
 980         if {$which_compiler == "c++"} {
 981             set compiler $CXX_FOR_TARGET
 982         }
 983     }
 984
 985     if [info exists F77_FOR_TARGET] {
 986         if {$which_compiler == "f77"} {
 987             set compiler $F77_FOR_TARGET
 988         }
 989     }
 990
 991     if { ![info exists compiler] } {
 992         if { $which_compiler == "c" } {
 993             if {[info exists CC]} {
 994                 set compiler $CC
 995             }
 996         }
 997         if { $which_compiler == "c++" } {
 998             if {[info exists CXX]} {
 999                 set compiler $CXX
1000             }
1001         }
1002         if {![info exists compiler]} {
1003             set compiler [board_info [target_info name] compiler];
1004             if { $compiler == "" } {
1005                 perror "get_compiler: No compiler found"
1006                 return ""
1007             }
1008         }
1009     }
1010
1011     return $compiler
1012 }
1013
1014 proc gdb_preprocess {source dest args} {
1015     set compiler [get_compiler "$args"]
1016     if { $compiler == "" } {
1017         return 1
1018     }
1019
1020     set cmdline "$compiler -E $source > $dest"
1021
1022     verbose "Invoking $compiler -E $source > $dest"
1023     verbose -log "Executing on local host: $cmdline" 2
1024     set status [catch "exec ${cmdline}" exec_output]
1025
1026     set result [prune_warnings $exec_output]
1027     regsub "\[\r\n\]*$" "$result" "" result;
1028     regsub "^\[\r\n\]*" "$result" "" result;
1029     if { $result != "" } {
1030         clone_output "gdb compile failed, $result"
1031     }
1032     return $result;
1033 }
1034
1035 proc gdb_compile {source dest type options} {
1036     global GDB_TESTCASE_OPTIONS;
1037
1038     if [target_info exists gdb_stub] {
1039         set options2 { "additional_flags=-Dusestubs" }
1040         lappend options "libs=[target_info gdb_stub]";
1041         set options [concat $options2 $options]
1042     }
1043     if [target_info exists is_vxworks] {
1044         set options2 { "additional_flags=-Dvxworks" }
1045         lappend options "libs=[target_info gdb_stub]";
1046         set options [concat $options2 $options]
1047     }
1048     if [info exists GDB_TESTCASE_OPTIONS] {
1049         lappend options "additional_flags=$GDB_TESTCASE_OPTIONS";
1050     }
1051     verbose "options are $options"
1052     verbose "source is $source $dest $type $options"
1053
1054     set result [target_compile $source $dest $type $options];
1055     regsub "\[\r\n\]*$" "$result" "" result;
1056     regsub "^\[\r\n\]*" "$result" "" result;
1057     if { $result != "" } {
1058         clone_output "gdb compile failed, $result"
1059     }
1060     return $result;
1061 }
1062
1063 proc send_gdb { string } {
1064     global suppress_flag;
1065     if { $suppress_flag } {
1066         return "suppressed";
1067     }
1068     return [remote_send host "$string"];
1069 }
1070
1071 #
1072 #
1073
1074 proc gdb_expect { args } {
1075     # allow -notransfer expect flag specification,
1076     # used by gdb_test routine for multi-line commands.
1077     # packed with gtimeout when fed to remote_expect routine,
1078     # which is a hack but due to what looks like a res and orig
1079     # parsing problem in remote_expect routine (dejagnu/lib/remote.exp):
1080     # what's fed into res is not removed from orig.
1081     # - guo
1082     if { [lindex $args 0] == "-notransfer" } {
1083         set notransfer -notransfer;
1084         set args [lrange $args 1 end];
1085     } else {
1086         set notransfer "";
1087     }
1088
1089     if { [llength $args] == 2  && [lindex $args 0] != "-re" } {
1090         set gtimeout [lindex $args 0];
1091         set expcode [list [lindex $args 1]];
1092     } else {
1093         upvar timeout timeout;
1094
1095         set expcode $args;
1096         if [target_info exists gdb,timeout] {
1097             if [info exists timeout] {
1098                 if { $timeout < [target_info gdb,timeout] } {
1099                     set gtimeout [target_info gdb,timeout];
1100                 } else {
1101                     set gtimeout $timeout;
1102                 }
1103             } else {
1104                 set gtimeout [target_info gdb,timeout];
1105             }
1106         }
1107
1108         if ![info exists gtimeout] {
1109             global timeout;
1110             if [info exists timeout] {
1111                 set gtimeout $timeout;
1112             } else {
1113                 # Eeeeew.
1114                 set gtimeout 60;
1115             }
1116         }
1117     }
1118     global suppress_flag;
1119     global remote_suppress_flag;
1120     if [info exists remote_suppress_flag] {
1121         set old_val $remote_suppress_flag;
1122     }
1123     if [info exists suppress_flag] {
1124         if { $suppress_flag } {
1125             set remote_suppress_flag 1;
1126         }
1127     }
1128     set code [catch \
1129         {uplevel remote_expect host "$gtimeout $notransfer" $expcode} string];
1130     if [info exists old_val] {
1131         set remote_suppress_flag $old_val;
1132     } else {
1133         if [info exists remote_suppress_flag] {
1134             unset remote_suppress_flag;
1135         }
1136     }
1137
1138     if {$code == 1} {
1139         global errorInfo errorCode;
1140
1141         return -code error -errorinfo $errorInfo -errorcode $errorCode $string
1142     } elseif {$code == 2} {
1143         return -code return $string
1144     } elseif {$code == 3} {
1145         return
1146     } elseif {$code > 4} {
1147         return -code $code $string
1148     }
1149 }
1150
1151 #
1152 # Check for long sequence of output by parts.
1153 # TEST: is the test message.
1154 # SENTINEL: Is the terminal pattern indicating that output has finished.
1155 # LIST: is the sequence of outputs to match.
1156 # If the sentinel is recognized early, it is considered an error.
1157 #
1158 proc gdb_expect_list {test sentinal list} {
1159     global gdb_prompt
1160     set index 0
1161     set ok 1
1162     while { ${index} < [llength ${list}] } {
1163         set pattern [lindex ${list} ${index}]
1164         set index [expr ${index} + 1]
1165         if { ${index} == [llength ${list}] } {
1166             if { ${ok} } {
1167                 gdb_expect {
1168                     -re "${pattern}${sentinal}" {
1169                         pass "${test}, pattern ${index} + sentinal"
1170                     }
1171                     timeout {
1172                         fail "${test}, pattern ${index} + sentinal (timeout)"
1173                         set ok 0
1174                     }
1175                 }
1176             } else {
1177                 fail "${test}, pattern ${index} + sentinal"
1178             }
1179         } else {
1180             if { ${ok} } {
1181                 gdb_expect {
1182                     -re "${pattern}" {
1183                         pass "${test}, pattern ${index}"
1184                     }
1185                     -re "${sentinal}" {
1186                         fail "${test}, pattern ${index}"
1187                         set ok 0
1188                     }
1189                     timeout {
1190                         fail "${test}, pattern ${index} (timeout)"
1191                         set ok 0
1192                     }
1193                 }
1194             } else {
1195                 fail "${test}, pattern ${index}"
1196             }
1197         }
1198     }
1199 }
1200
1201 #
1202 #
1203 proc gdb_suppress_entire_file { reason } {
1204     global suppress_flag;
1205
1206     warning "$reason\n";
1207     set suppress_flag -1;
1208 }
1209
1210 #
1211 # Set suppress_flag, which will cause all subsequent calls to send_gdb and
1212 # gdb_expect to fail immediately (until the next call to
1213 # gdb_stop_suppressing_tests).
1214 #
1215 proc gdb_suppress_tests { args } {
1216     global suppress_flag;
1217
1218     return;  # fnf - disable pending review of results where
1219              # testsuite ran better without this
1220     incr suppress_flag;
1221
1222     if { $suppress_flag == 1 } {
1223         if { [llength $args] > 0 } {
1224             warning "[lindex $args 0]\n";
1225         } else {
1226             warning "Because of previous failure, all subsequent tests in this group will automatically fail.\n";
1227         }
1228     }
1229 }
1230
1231 #
1232 # Clear suppress_flag.
1233 #
1234 proc gdb_stop_suppressing_tests { } {
1235     global suppress_flag;
1236
1237     if [info exists suppress_flag] {
1238         if { $suppress_flag > 0 } {
1239             set suppress_flag 0;
1240             clone_output "Tests restarted.\n";
1241         }
1242     } else {
1243         set suppress_flag 0;
1244     }
1245 }
1246
1247 proc gdb_clear_suppressed { } {
1248     global suppress_flag;
1249
1250     set suppress_flag 0;
1251 }
1252
1253 proc gdb_start { } {
1254     default_gdb_start
1255 }
1256
1257 proc gdb_exit { } {
1258     catch default_gdb_exit
1259 }
1260
1261 #
1262 # gdb_load -- load a file into the debugger.
1263 #             return a -1 if anything goes wrong.
1264 #
1265 proc gdb_load { arg } {
1266     return [gdb_file_cmd $arg]
1267 }
1268
1269 proc gdb_continue { function } {
1270     global decimal
1271
1272     return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"];
1273 }
1274
1275 proc default_gdb_init { args } {
1276     gdb_clear_suppressed;
1277
1278     # Uh, this is lame. Really, really, really lame. But there's this *one*
1279     # testcase that will fail in random places if we don't increase this.
1280     match_max -d 20000
1281
1282     # We want to add the name of the TCL testcase to the PASS/FAIL messages.
1283     if { [llength $args] > 0 } {
1284         global pf_prefix
1285
1286         set file [lindex $args 0];
1287
1288         set pf_prefix "[file tail [file dirname $file]]/[file tail $file]:";
1289     }
1290     global gdb_prompt;
1291     if [target_info exists gdb_prompt] {
1292         set gdb_prompt [target_info gdb_prompt];
1293     } else {
1294         set gdb_prompt "\\(gdb\\)"
1295     }
1296 }
1297
1298 proc gdb_init { args } {
1299     return [eval default_gdb_init $args];
1300 }
1301
1302 proc gdb_finish { } {
1303     gdb_exit;
1304 }
1305
1306 global debug_format
1307 set debug_format "unknown"
1308
1309 # Run the gdb command "info source" and extract the debugging format
1310 # information from the output and save it in debug_format.
1311
1312 proc get_debug_format { } {
1313     global gdb_prompt
1314     global verbose
1315     global expect_out
1316     global debug_format
1317
1318     set debug_format "unknown"
1319     send_gdb "info source\n"
1320     gdb_expect 10 {
1321         -re "Compiled with (.*) debugging format.\r\n$gdb_prompt $" {
1322             set debug_format $expect_out(1,string)
1323             verbose "debug format is $debug_format"
1324             return 1;
1325         }
1326         -re "No current source file.\r\n$gdb_prompt $" {
1327             perror "get_debug_format used when no current source file"
1328             return 0;
1329         }
1330         -re "$gdb_prompt $" {
1331             warning "couldn't check debug format (no valid response)."
1332             return 1;
1333         }
1334         timeout {
1335             warning "couldn't check debug format (timed out)."
1336             return 1;
1337         }
1338     }
1339 }
1340
1341 # Like setup_xfail, but takes the name of a debug format (DWARF 1,
1342 # COFF, stabs, etc).  If that format matches the format that the
1343 # current test was compiled with, then the next test is expected to
1344 # fail for any target.  Returns 1 if the next test or set of tests is
1345 # expected to fail, 0 otherwise (or if it is unknown).  Must have
1346 # previously called get_debug_format.
1347
1348 proc setup_xfail_format { format } {
1349     global debug_format
1350
1351     if [string match $debug_format $format] then {
1352         setup_xfail "*-*-*"
1353         return 1;
1354     }
1355     return 0
1356 }
1357
1358 proc gdb_step_for_stub { } {
1359     global gdb_prompt;
1360
1361     if ![target_info exists gdb,use_breakpoint_for_stub] {
1362         if [target_info exists gdb_stub_step_command] {
1363             set command [target_info gdb_stub_step_command];
1364         } else {
1365             set command "step";
1366         }
1367         send_gdb "${command}\n";
1368         set tries 0;
1369         gdb_expect 60 {
1370             -re "(main.* at |.*in .*start).*$gdb_prompt" {
1371                 return;
1372             }
1373             -re ".*$gdb_prompt" {
1374                 incr tries;
1375                 if { $tries == 5 } {
1376                     fail "stepping out of breakpoint function";
1377                     return;
1378                 }
1379                 send_gdb "${command}\n";
1380                 exp_continue;
1381             }
1382             default {
1383                 fail "stepping out of breakpoint function";
1384                 return;
1385             }
1386         }
1387     }
1388     send_gdb "where\n";
1389     gdb_expect {
1390         -re "main\[^\r\n\]*at \(\[^:]+\):\(\[0-9\]+\)" {
1391             set file $expect_out(1,string);
1392             set linenum [expr $expect_out(2,string) + 1];
1393             set breakplace "${file}:${linenum}";
1394         }
1395         default {}
1396     }
1397     send_gdb "break ${breakplace}\n";
1398     gdb_expect 60 {
1399         -re "Breakpoint (\[0-9\]+) at.*$gdb_prompt" {
1400             set breakpoint $expect_out(1,string);
1401         }
1402         -re "Breakpoint (\[0-9\]+): file.*$gdb_prompt" {
1403             set breakpoint $expect_out(1,string);
1404         }
1405         default {}
1406     }
1407     send_gdb "continue\n";
1408     gdb_expect 60 {
1409         -re "Breakpoint ${breakpoint},.*$gdb_prompt" {
1410             gdb_test "delete $breakpoint" ".*" "";
1411             return;
1412         }
1413         default {}
1414     }
1415 }
1416
1417 ### gdb_get_line_number TEXT [FILE]
1418 ###
1419 ### Search the source file FILE, and return the line number of a line
1420 ### containing TEXT.  Use this function instead of hard-coding line
1421 ### numbers into your test script.
1422 ###
1423 ### Specifically, this function uses GDB's "search" command to search
1424 ### FILE for the first line containing TEXT, and returns its line
1425 ### number.  Thus, FILE must be a source file, compiled into the
1426 ### executable you are running.  If omitted, FILE defaults to the
1427 ### value of the global variable `srcfile'; most test scripts set
1428 ### `srcfile' appropriately at the top anyway.
1429 ###
1430 ### Use this function to keep your test scripts independent of the
1431 ### exact line numbering of the source file.  Don't write:
1432 ###
1433 ###   send_gdb "break 20"
1434 ###
1435 ### This means that if anyone ever edits your test's source file,
1436 ### your test could break.  Instead, put a comment like this on the
1437 ### source file line you want to break at:
1438 ###
1439 ###   /* breakpoint spot: frotz.exp: test name */
1440 ###
1441 ### and then write, in your test script (which we assume is named
1442 ### frotz.exp):
1443 ###
1444 ###   send_gdb "break [gdb_get_line_number "frotz.exp: test name"]\n"
1445 ###
1446 ### (Yes, Tcl knows how to handle the nested quotes and brackets.
1447 ### Try this:
1448 ###     $ tclsh
1449 ###     % puts "foo [lindex "bar baz" 1]"
1450 ###     foo baz
1451 ###     %
1452 ### Tcl is quite clever, for a little stringy language.)
1453
1454 proc gdb_get_line_number {text {file /omitted/}} {
1455     global gdb_prompt;
1456     global srcfile;
1457
1458     if {! [string compare $file /omitted/]} {
1459         set file $srcfile
1460     }
1461
1462     set result -1;
1463     gdb_test "list ${file}:1,1" ".*" ""
1464     send_gdb "search ${text}\n"
1465     gdb_expect {
1466         -re "\[\r\n\]+(\[0-9\]+)\[ \t\].*${text}.*$gdb_prompt $" {
1467             set result $expect_out(1,string)
1468         }
1469         -re ".*$gdb_prompt $" {
1470             fail "find line number containing \"${text}\""
1471         }
1472         timeout {
1473             fail "find line number containing \"${text}\" (timeout)"
1474         }
1475     }
1476     return $result;
1477 }
1478
1479 # gdb_continue_to_end:
1480 #       The case where the target uses stubs has to be handled specially. If a
1481 #       stub is used, we set a breakpoint at exit because we cannot rely on
1482 #       exit() behavior of a remote target.
1483 #
1484 # mssg is the error message that gets printed.
1485
1486 proc gdb_continue_to_end {mssg} {
1487   if [target_info exists use_gdb_stub] {
1488     if {![gdb_breakpoint "exit"]} {
1489       return 0
1490     }
1491     gdb_test "continue" "Continuing..*Breakpoint .*exit.*" \
1492       "continue until exit at $mssg"
1493   } else {
1494     # Continue until we exit.  Should not stop again.
1495     # Don't bother to check the output of the program, that may be
1496     # extremely tough for some remote systems.
1497     gdb_test "continue"\
1498       "Continuing.\[\r\n0-9\]+Program exited normally\\..*"\
1499       "continue until exit at $mssg"
1500   }
1501 }
1502
1503 proc rerun_to_main {} {
1504   global gdb_prompt
1505
1506   if [target_info exists use_gdb_stub] {
1507     gdb_run_cmd
1508     gdb_expect {
1509       -re ".*Breakpoint .*main .*$gdb_prompt $"\
1510               {pass "rerun to main" ; return 0}
1511       -re "$gdb_prompt $"\
1512               {fail "rerun to main" ; return 0}
1513       timeout {fail "(timeout) rerun to main" ; return 0}
1514     }
1515   } else {
1516     send_gdb "run\n"
1517     gdb_expect {
1518       -re "Starting program.*$gdb_prompt $"\
1519               {pass "rerun to main" ; return 0}
1520       -re "$gdb_prompt $"\
1521               {fail "rerun to main" ; return 0}
1522       timeout {fail "(timeout) rerun to main" ; return 0}
1523     }
1524   }
1525 }
1526