gdb/testsuite/lib/mi-support.exp

   1 # Copyright 1999, 2000 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 based on a file written by Fred Fish. (fnf@cygnus.com)
  21
  22 # Test setup routines that work with the MI interpreter.
  23
  24 # The variable mi_gdb_prompt is a regexp which matches the gdb mi prompt.
  25 # Set it if it is not already set.
  26 global mi_gdb_prompt
  27 if ![info exists mi_gdb_prompt] then {
  28     set mi_gdb_prompt "\[(\]gdb\[)\] \r\n"
  29 }
  30
  31 set MIFLAGS "-i=mi"
  32
  33 #
  34 # mi_gdb_exit -- exit the GDB, killing the target program if necessary
  35 #
  36 proc mi_gdb_exit {} {
  37     catch mi_uncatched_gdb_exit
  38 }
  39
  40 proc mi_uncatched_gdb_exit {} {
  41     global GDB
  42     global GDBFLAGS
  43     global verbose
  44     global gdb_spawn_id;
  45     global gdb_prompt
  46     global mi_gdb_prompt
  47     global MIFLAGS
  48
  49     gdb_stop_suppressing_tests;
  50
  51     if { [info procs sid_exit] != "" } {
  52         sid_exit
  53     }
  54
  55     if ![info exists gdb_spawn_id] {
  56         return;
  57     }
  58
  59     verbose "Quitting $GDB $GDBFLAGS $MIFLAGS"
  60
  61     if { [is_remote host] && [board_info host exists fileid] } {
  62         send_gdb "999-gdb-exit\n";
  63         gdb_expect 10 {
  64             -re "y or n" {
  65                 send_gdb "y\n";
  66                 exp_continue;
  67             }
  68             -re "Undefined command.*$gdb_prompt $" {
  69                 send_gdb "quit\n"
  70                 exp_continue;
  71             }
  72             -re "DOSEXIT code" { }
  73             default { }
  74         }
  75     }
  76
  77     if ![is_remote host] {
  78         remote_close host;
  79     }
  80     unset gdb_spawn_id
  81 }
  82
  83 #
  84 # start gdb -- start gdb running, default procedure
  85 #
  86 # When running over NFS, particularly if running many simultaneous
  87 # tests on different hosts all using the same server, things can
  88 # get really slow.  Give gdb at least 3 minutes to start up.
  89 #
  90 proc mi_gdb_start { } {
  91     global verbose
  92     global GDB
  93     global GDBFLAGS
  94     global gdb_prompt
  95     global mi_gdb_prompt
  96     global timeout
  97     global gdb_spawn_id;
  98     global MIFLAGS
  99
 100     gdb_stop_suppressing_tests;
 101
 102     verbose "Spawning $GDB -nw $GDBFLAGS $MIFLAGS"
 103
 104     if [info exists gdb_spawn_id] {
 105         return 0;
 106     }
 107
 108     if ![is_remote host] {
 109         if { [which $GDB] == 0 } then {
 110             perror "$GDB does not exist."
 111             exit 1
 112         }
 113     }
 114     set res [remote_spawn host "$GDB -nw $GDBFLAGS $MIFLAGS [host_info gdb_opts]"];
 115     if { $res < 0 || $res == "" } {
 116         perror "Spawning $GDB failed."
 117         return 1;
 118     }
 119     gdb_expect {
 120         -re ".*MI_OUT.*$mi_gdb_prompt$" {
 121             verbose "GDB initialized."
 122         }
 123         -re ".*$mi_gdb_prompt$" {
 124             untested "Skip mi tests (output not in headless format)."
 125             remote_close host;
 126             return -1;
 127         }
 128         -re ".*$gdb_prompt $" {
 129             untested "Skip mi tests (got non-mi prompt)."
 130             remote_close host;
 131             return -1;
 132         }
 133         -re ".*unrecognized option.*for a complete list of options." {
 134             untested "Skip mi tests (not compiled with mi support)."
 135             remote_close host;
 136             return -1;
 137         }
 138         -re ".*Interpreter `mi' unrecognized." {
 139             untested "Skip mi tests (not compiled with mi support)."
 140             remote_close host;
 141             return -1;
 142         }
 143         timeout {
 144             perror "(timeout) GDB never initialized after 10 seconds."
 145             remote_close host;
 146             return -1
 147         }
 148     }
 149     set gdb_spawn_id -1;
 150
 151     # FIXME: mi output does not go through pagers, so these can be removed.
 152     # force the height to "unlimited", so no pagers get used
 153     send_gdb "100-gdb-set height 0\n"
 154     gdb_expect 10 {
 155         -re ".*100-gdb-set height 0\r\n100\\\^done\r\n$mi_gdb_prompt$" {
 156             verbose "Setting height to 0." 2
 157         }
 158         timeout {
 159             warning "Couldn't set the height to 0"
 160         }
 161     }
 162     # force the width to "unlimited", so no wraparound occurs
 163     send_gdb "101-gdb-set width 0\n"
 164     gdb_expect 10 {
 165         -re ".*101-gdb-set width 0\r\n101\\\^done\r\n$mi_gdb_prompt$" {
 166             verbose "Setting width to 0." 2
 167         }
 168         timeout {
 169             warning "Couldn't set the width to 0."
 170         }
 171     }
 172
 173     # Finally start SID.
 174     if { [info procs sid_start] != "" } {
 175         verbose "Spawning SID"
 176         sid_start
 177     }
 178
 179     return 0;
 180 }
 181
 182 # Many of the tests depend on setting breakpoints at various places and
 183 # running until that breakpoint is reached.  At times, we want to start
 184 # with a clean-slate with respect to breakpoints, so this utility proc
 185 # lets us do this without duplicating this code everywhere.
 186 #
 187
 188 proc mi_delete_breakpoints {} {
 189     global mi_gdb_prompt
 190
 191 # FIXME: The mi operation won't accept a prompt back and will use the 'all' arg
 192     send_gdb "102-break-delete\n"
 193     gdb_expect 30 {
 194          -re "Delete all breakpoints.*y or n.*$" {
 195             send_gdb "y\n";
 196             exp_continue
 197          }
 198          -re ".*102-break-delete\r\n102\\\^done\r\n$mi_gdb_prompt$" {
 199             # This happens if there were no breakpoints
 200          }
 201          timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
 202     }
 203
 204 # The correct output is not "No breakpoints or watchpoints." but an
 205 # empty BreakpointTable. Also, a query is not acceptable with mi.
 206     send_gdb "103-break-list\n"
 207     gdb_expect 30 {
 208          -re "103-break-list\r\n103\\\^done,BreakpointTable=\{\}\r\n$mi_gdb_prompt$" {}
 209          -re "103-break-list\r\n103\\\^doneNo breakpoints or watchpoints.\r\n\r\n$mi_gdb_prompt$" {warning "Unexpected console text received"}
 210          -re "$mi_gdb_prompt$" { perror "Breakpoints not deleted" ; return }
 211          -re "Delete all breakpoints.*or n.*$" {
 212             warning "Unexpected prompt for breakpoints deletion";
 213             send_gdb "y\n";
 214             exp_continue
 215         }
 216          timeout { perror "-break-list (timeout)" ; return }
 217     }
 218 }
 219
 220 proc mi_gdb_reinitialize_dir { subdir } {
 221     global mi_gdb_prompt
 222
 223     global suppress_flag
 224     if { $suppress_flag } {
 225         return
 226     }
 227
 228     if [is_remote host] {
 229         return "";
 230     }
 231
 232     send_gdb "104-environment-directory\n"
 233     gdb_expect 60 {
 234         -re ".*Reinitialize source path to empty.*y or n. " {
 235             warning "Got confirmation prompt for dir reinitialization."
 236             send_gdb "y\n"
 237             gdb_expect 60 {
 238                 -re "$mi_gdb_prompt$" {}
 239                 timeout {error "Dir reinitialization failed (timeout)"}
 240             }
 241         }
 242         -re "$mi_gdb_prompt$" {}
 243         timeout {error "Dir reinitialization failed (timeout)"}
 244     }
 245
 246     send_gdb "105-environment-directory $subdir\n"
 247     gdb_expect 60 {
 248         -re "Source directories searched.*$mi_gdb_prompt$" {
 249             verbose "Dir set to $subdir"
 250         }
 251         -re "105\\\^done\r\n$mi_gdb_prompt$" {
 252             # FIXME: We return just the prompt for now.
 253             verbose "Dir set to $subdir"
 254             # perror "Dir \"$subdir\" failed."
 255         }
 256     }
 257 }
 258
 259 #
 260 # load a file into the debugger.
 261 # return a -1 if anything goes wrong.
 262 #
 263 proc mi_gdb_load { arg } {
 264     global verbose
 265     global loadpath
 266     global loadfile
 267     global GDB
 268     global mi_gdb_prompt
 269     upvar timeout timeout
 270
 271     # ``gdb_unload''
 272
 273     # ``gdb_file_cmd''
 274 # FIXME: Several of these patterns are only acceptable for console
 275 # output.  Queries are an error for mi.
 276     send_gdb "105-file-exec-and-symbols $arg\n"
 277     gdb_expect 120 {
 278         -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
 279             verbose "\t\tLoaded $arg into the $GDB"
 280             # All OK
 281         }
 282         -re "has no symbol-table.*$mi_gdb_prompt$" {
 283             perror "$arg wasn't compiled with \"-g\""
 284             return -1
 285         }
 286         -re "A program is being debugged already.*Kill it.*y or n. $" {
 287             send_gdb "y\n"
 288                 verbose "\t\tKilling previous program being debugged"
 289             exp_continue
 290         }
 291         -re "Load new symbol table from \".*\".*y or n. $" {
 292             send_gdb "y\n"
 293             gdb_expect 120 {
 294                 -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
 295                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
 296                     # All OK
 297                 }
 298                 timeout {
 299                     perror "(timeout) Couldn't load $arg, other program already loaded."
 300                     return -1
 301                 }
 302             }
 303         }
 304         -re "No such file or directory.*$mi_gdb_prompt$" {
 305             perror "($arg) No such file or directory\n"
 306             return -1
 307         }
 308         -re "105-file-exec-and-symbols .*\r\n105\\\^done\r\n$mi_gdb_prompt$" {
 309             # We are just giving the prompt back for now
 310             # All OK
 311             }
 312         timeout {
 313             perror "couldn't load $arg into $GDB (timed out)."
 314             return -1
 315         }
 316         eof {
 317             # This is an attempt to detect a core dump, but seems not to
 318             # work.  Perhaps we need to match .* followed by eof, in which
 319             # gdb_expect does not seem to have a way to do that.
 320             perror "couldn't load $arg into $GDB (end of file)."
 321             return -1
 322         }
 323     }
 324
 325     # ``load''
 326     if { [info procs send_target_sid] != "" } {
 327         # For SID, things get complex
 328         send_target_sid
 329         gdb_expect 60 {
 330             -re "\\^done,.*$mi_gdb_prompt$" {
 331             }
 332             timeout {
 333                 perror "Unable to connect to SID target"
 334                 return -1
 335             }
 336         }
 337         send_gdb "48-target-download\n"
 338         gdb_expect 10 {
 339             -re "48\\^done.*$mi_gdb_prompt$" {
 340             }
 341             timeout {
 342                 perror "Unable to download to SID target"
 343                 return -1
 344             }
 345         }
 346     } elseif { [target_info protocol] == "sim" } {
 347         # For the simulator, just connect to it directly.
 348         send_gdb "47-target-select sim\n"
 349         gdb_expect 10 {
 350             -re "47\\^connected.*$mi_gdb_prompt$" {
 351             }
 352             timeout {
 353                 perror "Unable to select sim target"
 354                 return -1
 355             }
 356         }
 357         send_gdb "48-target-download\n"
 358         gdb_expect 10 {
 359             -re "48\\^done.*$mi_gdb_prompt$" {
 360             }
 361             timeout {
 362                 perror "Unable to download to sim target"
 363                 return -1
 364             }
 365         }
 366     }
 367     return 0
 368 }
 369
 370 # mi_gdb_test COMMAND PATTERN MESSAGE -- send a command to gdb; test the result.
 371 #
 372 # COMMAND is the command to execute, send to GDB with send_gdb.  If
 373 #   this is the null string no command is sent.
 374 # PATTERN is the pattern to match for a PASS, and must NOT include
 375 #   the \r\n sequence immediately before the gdb prompt.
 376 # MESSAGE is an optional message to be printed.  If this is
 377 #   omitted, then the pass/fail messages use the command string as the
 378 #   message.  (If this is the empty string, then sometimes we don't
 379 #   call pass or fail at all; I don't understand this at all.)
 380 #
 381 # Returns:
 382 #    1 if the test failed,
 383 #    0 if the test passes,
 384 #   -1 if there was an internal error.
 385 #
 386 proc mi_gdb_test { args } {
 387     global verbose
 388     global mi_gdb_prompt
 389     global GDB
 390     upvar timeout timeout
 391
 392     if [llength $args]>2 then {
 393         set message [lindex $args 2]
 394     } else {
 395         set message [lindex $args 0]
 396     }
 397     set command [lindex $args 0]
 398     set pattern [lindex $args 1]
 399
 400     if [llength $args]==5 {
 401         set question_string [lindex $args 3];
 402         set response_string [lindex $args 4];
 403     } else {
 404         set question_string "^FOOBAR$"
 405     }
 406
 407     if $verbose>2 then {
 408         send_user "Sending \"$command\" to gdb\n"
 409         send_user "Looking to match \"$pattern\"\n"
 410         send_user "Message is \"$message\"\n"
 411     }
 412
 413     set result -1
 414     set string "${command}\n";
 415     if { $command != "" } {
 416         while { "$string" != "" } {
 417             set foo [string first "\n" "$string"];
 418             set len [string length "$string"];
 419             if { $foo < [expr $len - 1] } {
 420                 set str [string range "$string" 0 $foo];
 421                 if { [send_gdb "$str"] != "" } {
 422                     global suppress_flag;
 423
 424                     if { ! $suppress_flag } {
 425                         perror "Couldn't send $command to GDB.";
 426                     }
 427                     fail "$message";
 428                     return $result;
 429                 }
 430                 gdb_expect 2 {
 431                     -re "\[\r\n\]" { }
 432                     timeout { }
 433                 }
 434                 set string [string range "$string" [expr $foo + 1] end];
 435             } else {
 436                 break;
 437             }
 438         }
 439         if { "$string" != "" } {
 440             if { [send_gdb "$string"] != "" } {
 441                 global suppress_flag;
 442
 443                 if { ! $suppress_flag } {
 444                     perror "Couldn't send $command to GDB.";
 445                 }
 446                 fail "$message";
 447                 return $result;
 448             }
 449         }
 450     }
 451
 452     if [info exists timeout] {
 453         set tmt $timeout;
 454     } else {
 455         global timeout;
 456         if [info exists timeout] {
 457             set tmt $timeout;
 458         } else {
 459             set tmt 60;
 460         }
 461     }
 462     gdb_expect $tmt {
 463          -re "\\*\\*\\* DOSEXIT code.*" {
 464              if { $message != "" } {
 465                  fail "$message";
 466              }
 467              gdb_suppress_entire_file "GDB died";
 468              return -1;
 469          }
 470          -re "Ending remote debugging.*$mi_gdb_prompt\[ \]*$" {
 471             if ![isnative] then {
 472                 warning "Can`t communicate to remote target."
 473             }
 474             gdb_exit
 475             gdb_start
 476             set result -1
 477         }
 478          -re "(${question_string})$" {
 479             send_gdb "$response_string\n";
 480             exp_continue;
 481         }
 482          -re "Undefined.* command:.*$mi_gdb_prompt\[ \]*$" {
 483             perror "Undefined command \"$command\"."
 484             fail "$message"
 485             set result 1
 486         }
 487          -re "Ambiguous command.*$mi_gdb_prompt\[ \]*$" {
 488             perror "\"$command\" is not a unique command name."
 489             fail "$message"
 490             set result 1
 491         }
 492          -re "\[\r\n\]*($pattern)\[\r\n\]+$mi_gdb_prompt\[ \]*$" {
 493             if ![string match "" $message] then {
 494                 pass "$message"
 495             }
 496             set result 0
 497         }
 498          -re "Program exited with code \[0-9\]+.*$mi_gdb_prompt\[ \]*$" {
 499             if ![string match "" $message] then {
 500                 set errmsg "$message: the program exited"
 501             } else {
 502                 set errmsg "$command: the program exited"
 503             }
 504             fail "$errmsg"
 505             return -1
 506         }
 507          -re "The program is not being run.*$mi_gdb_prompt\[ \]*$" {
 508             if ![string match "" $message] then {
 509                 set errmsg "$message: the program is no longer running"
 510             } else {
 511                 set errmsg "$command: the program is no longer running"
 512             }
 513             fail "$errmsg"
 514             return -1
 515         }
 516          -re ".*$mi_gdb_prompt\[ \]*$" {
 517             if ![string match "" $message] then {
 518                 fail "$message"
 519             }
 520             set result 1
 521         }
 522          "<return>" {
 523             send_gdb "\n"
 524             perror "Window too small."
 525             fail "$message"
 526         }
 527          -re "\\(y or n\\) " {
 528             send_gdb "n\n"
 529             perror "Got interactive prompt."
 530             fail "$message"
 531         }
 532          eof {
 533              perror "Process no longer exists"
 534              if { $message != "" } {
 535                  fail "$message"
 536              }
 537              return -1
 538         }
 539          full_buffer {
 540             perror "internal buffer is full."
 541             fail "$message"
 542         }
 543         timeout {
 544             if ![string match "" $message] then {
 545                 fail "$message (timeout)"
 546             }
 547             set result 1
 548         }
 549     }
 550     return $result
 551 }
 552
 553 #
 554 # MI run command.  (A modified version of gdb_run_cmd)
 555 #
 556
 557 # In patterns, the newline sequence ``\r\n'' is matched explicitly as
 558 # ``.*$'' could swallow up output that we attempt to match elsewhere.
 559
 560 proc mi_run_cmd {args} {
 561     global suppress_flag
 562     if { $suppress_flag } {
 563         return -1
 564     }
 565     global mi_gdb_prompt
 566
 567     if [target_info exists gdb_init_command] {
 568         send_gdb "[target_info gdb_init_command]\n";
 569         gdb_expect 30 {
 570             -re "$mi_gdb_prompt$" { }
 571             default {
 572                 perror "gdb_init_command for target failed";
 573                 return;
 574             }
 575         }
 576     }
 577
 578     if [target_info exists use_gdb_stub] {
 579         if [target_info exists gdb,do_reload_on_run] {
 580             # Specifying no file, defaults to the executable
 581             # currently being debugged.
 582             if { [mi_gdb_load ""] < 0 } {
 583                 return;
 584             }
 585             send_gdb "000-exec-continue\n";
 586             gdb_expect 60 {
 587                 -re "Continu\[^\r\n\]*\[\r\n\]" {}
 588                 default {}
 589             }
 590             return;
 591         }
 592     }
 593
 594     send_gdb "000-exec-run $args\n"
 595     gdb_expect {
 596         -re "000\\^running\r\n${mi_gdb_prompt}" {
 597         }
 598         timeout {
 599             perror "Unable to start target"
 600             return
 601         }
 602     }
 603     # NOTE: Shortly after this there will be a ``000*stopping,...(gdb)''
 604 }
 605
 606 #
 607 # Just like run-to-main but works with the MI interface
 608 #
 609
 610 proc mi_run_to_main { } {
 611     global suppress_flag
 612     if { $suppress_flag } {
 613         return -1
 614     }
 615
 616     global mi_gdb_prompt
 617     global hex
 618     global decimal
 619     global srcdir
 620     global subdir
 621     global binfile
 622     global srcfile
 623
 624     set test "mi run-to-main"
 625     mi_delete_breakpoints
 626     mi_gdb_reinitialize_dir $srcdir/$subdir
 627     mi_gdb_load ${binfile}
 628
 629     mi_gdb_test "200-break-insert main" \
 630             "200\\^done,bkpt=\{number=\"1\",type=\"breakpoint\",disp=\"keep\",enabled=\"y\",addr=\"$hex\",func=\"main\",file=\".*\",line=\"\[0-9\]*\",times=\"0\"\}" \
 631             "breakpoint at main"
 632
 633     mi_run_cmd
 634     gdb_expect {
 635         -re "000\\*stopped,reason=\"breakpoint-hit\",bkptno=\"1\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"main\",args=\{\},file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
 636             pass "$test"
 637             return 0
 638         }
 639         timeout {
 640             fail "$test (timeout)"
 641             return -1
 642         }
 643     }
 644 }
 645
 646
 647 # Next to the next statement
 648
 649 proc mi_next { test } {
 650     global suppress_flag
 651     if { $suppress_flag } {
 652         return -1
 653     }
 654     global mi_gdb_prompt
 655     send_gdb "220-exec-next\n"
 656     gdb_expect {
 657         -re "220\\^running\r\n${mi_gdb_prompt}220\\*stopped,reason=\"end-stepping-range\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\{.*\},,file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
 658             pass "$test"
 659             return 0
 660         }
 661         timeout {
 662             fail "$test"
 663             return -1
 664         }
 665     }
 666 }
 667
 668
 669 # Step to the next statement
 670
 671 proc mi_step { test } {
 672     global suppress_flag
 673     if { $suppress_flag } {
 674         return -1
 675     }
 676     global mi_gdb_prompt
 677     send_gdb "220-exec-step\n"
 678     gdb_expect {
 679         -re "220\\^running\r\n${mi_gdb_prompt}220\\*stopped,reason=\"end-stepping-range\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\{.*\},,file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
 680             pass "$test"
 681             return 0
 682         }
 683         timeout {
 684             fail "$test"
 685             return -1
 686         }
 687     }
 688 }