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