config/gdb-comm.exp

   1 # Copyright (C) 1992-2016 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu; if not, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # Note: some of this was cribbed from the gdb testsuite since we need
  20 # to use some pretty standard gdb features (breakpoints in particular).
  21
  22 # Load up some standard junk.
  23 load_lib remote.exp
  24
  25 if {![info exists board]} {
  26     perror "$board must be set before loading gdb-comm"
  27 }
  28
  29 # The number of times we've tried to download/execute this executable.
  30 set try_again 0
  31
  32 #
  33 # Delete all breakpoints and verify that they were deleted.  If anything
  34 # goes wrong, return -1.
  35 #
  36 proc gdb_comm_delete_breakpoints {} {
  37     global gdb_prompt
  38
  39     remote_send host "delete breakpoints\n"
  40     remote_expect host 10 {
  41         -re "Delete all breakpoints.*y or n. $" {
  42             remote_send host "y\n"
  43             exp_continue
  44         }
  45         -re ".*$gdb_prompt $" { }
  46         timeout { perror "Delete all breakpoints (timeout)" ; return -1}
  47     }
  48     remote_send host "info breakpoints\n"
  49     remote_expect host 10 {
  50         -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
  51         -re ".*$gdb_prompt $" { perror "breakpoints not deleted" ; return -1}
  52         timeout { perror "info breakpoints (timeout)" ; return -1}
  53     }
  54     return 0
  55 }
  56
  57 #
  58 # Inform the debugger that we have a new exec file.
  59 # return a -1 if anything goes wrong, 0 on success.
  60 #
  61 proc gdb_comm_file_cmd { arg } {
  62     global verbose
  63     global loadpath
  64     global loadfile
  65     global GDB
  66     global gdb_prompt
  67     upvar timeout timeout
  68
  69     # The "file" command loads up a new symbol file for gdb, deal with
  70     # the various messages it might spew out.
  71     if {[isremote host]} {
  72         set arg [remote_download host $arg a.out]
  73     }
  74     remote_send host "file $arg\n"
  75     remote_expect host 60 {
  76         -re "Reading symbols from.*done.*$gdb_prompt $" {
  77             verbose "\t\tLoaded $arg into the $GDB"
  78             return 0
  79         }
  80         -re "has no symbol-table.*$gdb_prompt $" {
  81             perror "$arg wasn't compiled with \"-g\""
  82             return -1
  83         }
  84         -re "A program is being debugged already.*Kill it.*y or n. $" {
  85             remote_send host "y\n"
  86             verbose "\t\tKilling previous program being debugged"
  87             exp_continue
  88         }
  89         -re {Load new symbol table from ".*".*y or n.*$} {
  90             remote_send host "y\n"
  91             remote_expect host 60 {
  92                 -re "Reading symbols from.*done.*$gdb_prompt $" {
  93                     verbose "\t\tLoaded $arg with new symbol table into $GDB"
  94                     return 0
  95                 }
  96                 timeout {
  97                     perror "(timeout) Couldn't load $arg, other program already loaded."
  98                     return -1
  99                 }
 100             }
 101         }
 102         -re ".*No such file or directory.*$gdb_prompt $" {
 103             perror "($arg) No such file or directory\n"
 104             return -1
 105         }
 106         -re "$gdb_prompt $" {
 107             perror "couldn't load $arg into $GDB."
 108             return -1
 109         }
 110         timeout {
 111             perror "couldn't load $arg into $GDB (timed out)."
 112             return -1
 113         }
 114         eof {
 115             # This is an attempt to detect a core dump, but seems not to
 116             # work.  Perhaps we need to match .* followed by eof, in which
 117             # expect does not seem to have a way to do that.
 118             perror "couldn't load $arg into $GDB (end of file)."
 119             return -1
 120         }
 121     }
 122     return 0
 123 }
 124
 125 # Disconnect from the target and forget that we have an executable. Returns
 126 # -1 on failure, 0 on success.
 127
 128 proc gdb_comm_go_idle { } {
 129     global gdb_prompt
 130
 131     if {![board_info host exists fileid]} {
 132         return -1
 133     }
 134
 135     remote_send host "target exec\n"
 136     remote_expect host 10 {
 137         -re "Kill it.*y or n.*$" {
 138             remote_send host "y\n"
 139             exp_continue
 140         }
 141         -re "No exec.* file now.*$gdb_prompt $" {
 142             return 0
 143         }
 144         default {
 145             remote_close host
 146             return -1
 147         }
 148     }
 149 }
 150
 151 # Start GDB running with target DEST.
 152 proc gdb_comm_start { dest } {
 153     global GDB
 154     global gdb_prompt
 155     global tool_root_dir
 156
 157     # The variable gdb_prompt is a regexp which matches the gdb prompt.  Set it
 158     # if it is not already set.
 159     if {![board_info $dest exists gdb_prompt]} then {
 160         set gdb_prompt {\(gdb\)}
 161     } else {
 162         set gdb_prompt [board_info $dest gdb_prompt]
 163     }
 164     # Similarly for GDB.  Look in the object directory for gdb if we aren't
 165     # provided with one.
 166     if {![info exists GDB]} then {
 167         set GDB "[lookfor_file $tool_root_dir gdb/gdb]"
 168         if { $GDB eq "" } {
 169             set GDB [transform gdb]
 170         }
 171     }
 172     if {[board_info host exists gdb_opts]} {
 173         set gdb_opts [board_info host gdb_opts]
 174     } else {
 175         set gdb_opts ""
 176     }
 177     # Start up gdb (no startfiles, no windows) and wait for a prompt.
 178     remote_spawn host "$GDB $gdb_opts -nw -nx"
 179     remote_expect host 60 {
 180         -re ".*$gdb_prompt $" { }
 181     }
 182     remote_send host "set height 0\n"
 183     remote_expect host 10 {
 184         -re ".*$gdb_prompt $" {}
 185     }
 186     remote_send host "set width 0\n"
 187     remote_expect host 10 {
 188         -re ".*$gdb_prompt $" {}
 189     }
 190 }
 191
 192 # Add a breakpoint at function FUNCTION. We assume that GDB has already been
 193 # started.
 194 proc gdb_comm_add_breakpoint { function } {
 195     global gdb_prompt
 196
 197     remote_send host "break $function\n"
 198     remote_expect host 60 {
 199         -re "Breakpoint.*$gdb_prompt $" { return "" }
 200         -re "Function.*not defined.*$gdb_prompt $" { return "undef" }
 201         -re "No symbol table.*$gdb_prompt $" { return "undef" }
 202         -re {.*Make breakpoint pending.*\? \(y or \[n\]\) $} {
 203             remote_send host "y\n"
 204             return "maybe"
 205         }
 206         default {
 207             return "untested"
 208         }
 209     }
 210 }
 211
 212 #
 213 # quit_gdb -- try to quit GDB gracefully
 214 #
 215
 216 proc quit_gdb { } {
 217     global gdb_prompt
 218
 219     set spawn_id [board_info host fileid]
 220
 221     if { $spawn_id ne "" && $spawn_id > -1 } {
 222         if { [remote_send host "quit\n"] eq "" } {
 223             remote_expect host 10 {
 224                 -re ".*y or n.*$" {
 225                     remote_send host "y\n"
 226                     exp_continue
 227                 }
 228                 -re {.*[*][*][*].*EXIT code} { }
 229                 default { }
 230             }
 231         }
 232     }
 233     if {![isremote host]} {
 234         remote_close host
 235     }
 236 }
 237
 238 proc gdb_comm_leave { } {
 239     if {[isremote host]} {
 240         quit_gdb
 241     } else {
 242         gdb_comm_go_idle
 243     }
 244 }
 245 #
 246 # gdb_comm_load -- load the program and execute it
 247 #
 248 # PROG is a full pathname to the file to load, no arguments.
 249 # Result is "untested", "pass", "fail", etc.
 250 #
 251
 252 proc gdb_comm_load { dest prog args } {
 253     global GDB
 254     global GDBFLAGS
 255     global gdb_prompt
 256     global timeout
 257     set argnames { "command-line arguments" "input file" "output file" }
 258
 259     for { set x 0 } { $x < [llength $args] } { incr x } {
 260         if { [lindex $args $x] ne "" } {
 261             return [list "unsupported" "no support for [lindex $argnames $x] on this target"]
 262         }
 263     }
 264     # Make sure the file we're supposed to load really exists.
 265     if {![file exists $prog]} then {
 266         perror "$prog does not exist."
 267         return [list "untested" ""]
 268     }
 269
 270     if { [isremote host] || ![board_info host exists fileid] } {
 271         gdb_comm_start $dest
 272     }
 273
 274     # Remove all breakpoints, then tell the debugger that we have
 275     # new exec file.
 276     if { [gdb_comm_delete_breakpoints] != 0 } {
 277         gdb_comm_leave
 278         return [gdb_comm_reload $dest $prog $args]
 279     }
 280     if { [gdb_comm_file_cmd $prog] != 0 } {
 281         gdb_comm_leave
 282         return [gdb_comm_reload $dest $prog $args]
 283     }
 284     if {[board_info $dest exists gdb_sect_offset]} {
 285         set textoff [board_info $dest gdb_sect_offset]
 286         remote_send host "sect .text $textoff\n"
 287         remote_expect host 10 {
 288             -re {(0x[0-9a-z]+) - 0x[0-9a-z]+ is \.data} {
 289                 set dataoff $expect_out(1,string)
 290                 exp_continue
 291             }
 292             -re {(0x[0-9a-z]+) - 0x[0-9a-z]+ is \.bss} {
 293                 set bssoff $expect_out(1,string)
 294                 exp_continue
 295             }
 296             -re $gdb_prompt { }
 297         }
 298         set dataoff [format 0x%x [expr {$dataoff + $textoff}]]
 299         set bssoff [format 0x%x [expr {$bssoff + $textoff}]]
 300         remote_send host "sect .data $dataoff\n"
 301         remote_expect host 10 {
 302             -re $gdb_prompt { }
 303         }
 304         remote_send host "sect .bss $bssoff\n"
 305         remote_expect host 10 {
 306             -re $gdb_prompt { }
 307         }
 308     }
 309
 310     set protocol [board_info $dest gdb_protocol]
 311     if {[board_info $dest exists gdb_serial]} {
 312         set targetname [board_info $dest gdb_serial]
 313     } elseif {[board_info $dest exists netport]} {
 314         set targetname [board_info $dest netport]
 315     } else {
 316         if {[board_info $dest exists serial]} {
 317             set targetname [board_info $dest serial]
 318         } else {
 319             set targetname ""
 320         }
 321     }
 322     if {[board_info $dest exists baud]} {
 323         remote_send host "set remotebaud [board_info $dest baud]\n"
 324         remote_expect host 10 {
 325             -re ".*$gdb_prompt $" {}
 326             default {
 327                 warning "failed setting baud rate"
 328             }
 329         }
 330     }
 331     remote_send host "target $protocol $targetname\n"
 332     remote_expect host 60 {
 333         -re "Couldn.t establish conn.*$gdb_prompt $" {
 334             warning "Unable to connect to $targetname with GDB."
 335             quit_gdb
 336             return [gdb_comm_reload $dest $prog $args]
 337         }
 338         -re "Ending remote.*$gdb_prompt $" {
 339             warning "Unable to connect to $targetname with GDB."
 340             quit_gdb
 341             return [gdb_comm_reload $dest $prog $args]
 342         }
 343         -re "Remote target $protocol connected to.*$gdb_prompt $" { }
 344         -re "Remote target $targetname connected to.*$gdb_prompt $" { }
 345         -re "Connected to ARM RDI target.*$gdb_prompt $" { }
 346         -re "Connected to the simulator.*$gdb_prompt $" { }
 347         -re "Remote.*using $targetname.*$gdb_prompt $" { }
 348         -re "$gdb_prompt $" {
 349             warning "Unable to connect to $targetname with GDB."
 350             quit_gdb
 351             return [gdb_comm_reload $dest $prog $args]
 352         }
 353         -re ".*RDI_open.*should reset target.*" {
 354             warning "RDI Open Failed"
 355             quit_gdb
 356             return [gdb_comm_reload $dest $prog $args]
 357         }
 358         default {
 359             warning "Unable to connect to $targetname with GDB."
 360             quit_gdb
 361             return [gdb_comm_reload $dest $prog $args]
 362         }
 363     }
 364
 365     if {[target_info exists gdb_init_command]} {
 366         remote_send host "[target_info gdb_init_command]\n"
 367         remote_expect host 10 {
 368             -re ".*$gdb_prompt $" { }
 369             default {
 370                 gdb_comm_leave
 371                 return [list "fail" ""]
 372             }
 373         }
 374     }
 375     # Now download the executable to the target board.  If communications
 376     # with the target are very slow the timeout might need to be increased.
 377     if {[board_info $dest exists gdb_load_offset]} {
 378         remote_send host "load $prog [board_info $dest gdb_load_offset]\n"
 379     } else {
 380         remote_send host "load\n"
 381     }
 382     remote_expect host 600 {
 383         -re "text.*data.*$gdb_prompt $" { }
 384         -re "data.*text.*$gdb_prompt $" { }
 385         -re "$gdb_prompt $" {
 386             warning "Unable to send program to target board."
 387             gdb_comm_leave
 388             return [gdb_comm_reload $dest $prog $args]
 389         }
 390         default {
 391             warning "Unable to send program to target board."
 392             gdb_comm_leave
 393             return [gdb_comm_reload $dest $prog $args]
 394         }
 395     }
 396
 397     # Now set up breakpoints in exit, _exit, and abort.  These
 398     # are used to determine if a c-torture test passed or failed.  More
 399     # work would be necessary for things like the g++ testsuite which
 400     # use printf to indicate pass/fail status.
 401
 402     if { [gdb_comm_add_breakpoint _exit] ne "" } {
 403         gdb_comm_add_breakpoint exit
 404     }
 405     gdb_comm_add_breakpoint abort
 406
 407     set output ""
 408
 409     # Now start up the program and look for our magic breakpoints.
 410     # And a whole lot of other magic stuff too.
 411
 412     if {[board_info $dest exists gdb_run_command]} {
 413         remote_send host "[board_info $dest gdb_run_command]\n"
 414     } else {
 415         remote_send host "run\n"
 416     }
 417     # FIXME: The value 300 below should be a parameter.
 418     if {[board_info $dest exists testcase_timeout]} {
 419         set testcase_timeout [board_info $dest testcase_timeout]
 420     } else {
 421         set testcase_timeout 300
 422     }
 423     remote_expect host $testcase_timeout {
 424         -re "Line.*Jump anyway.*.y or n.*" {
 425             remote_send host "y\n"
 426             exp_continue
 427         }
 428         -re {Continuing( at |\.| with no signal\.)[^\r\n]*[\r\n]} {
 429             exp_continue
 430         }
 431         -re ".*Start it from the beginning?.*y or n.*" {
 432             remote_send host "n\n"
 433             remote_expect host 10 {
 434                 -re ".*$gdb_prompt $" {
 435                     remote_send host "signal 0\n"
 436                     remote_expect host 10 {
 437                         -re {signal 0[\r\n]+} { exp_continue }
 438                         -re {Continuing(\.| with no signal\.)[\r\n]} {}
 439                     }
 440                 }
 441             }
 442             exp_continue
 443         }
 444         -re {(run[\r\n]*|)Starting program: [^\r\n]*[\r\n]} {
 445             exp_continue
 446         }
 447         -re "$gdb_prompt (signal 0|continue)\[\r\n\]+Continuing(\\.| with no signal\\.)\[\r\n\]" {
 448             exp_continue
 449         }
 450         -re "(.*)Breakpoint.*exit.*=0.*$gdb_prompt $" {
 451             append output $expect_out(1,string)
 452             set result [check_for_board_status output]
 453             gdb_comm_leave
 454             if { $result > 0 } {
 455                 return [list "fail" $output]
 456             }
 457             return [list "pass" $output]
 458         }
 459         -re "(.*)Breakpoint.*exit.*=\[1-9\]\[0-9\]*.*$gdb_prompt $" {
 460             append output $expect_out(1,string)
 461             set result [check_for_board_status output]
 462             gdb_comm_leave
 463             if { $result == 0 } {
 464                 return [list "pass" $output]
 465             }
 466             if {[board_info $dest exists exit_statuses_bad]} {
 467                 return [list "pass" $output]
 468             }
 469             return [list "fail" $output]
 470         }
 471         -re "(.*)Breakpoint.*exit.*$gdb_prompt $" {
 472             append output $expect_out(1,string)
 473             set status [check_for_board_status output]
 474             gdb_comm_leave
 475             if { $status > 0 } {
 476                 return [list "fail" $output]
 477             }
 478             return [list "pass" $output]
 479         }
 480         -re "(.*)Breakpoint.*abort.*$gdb_prompt $" {
 481             append output $expect_out(1,string)
 482             check_for_board_status output
 483             gdb_comm_leave
 484             return [list "fail" $output]
 485         }
 486         -re "SIGTRAP.*$gdb_prompt $" {
 487             return [gdb_comm_reload $dest $prog $args]
 488         }
 489         -re "(.*)Program (received |terminated ).*$gdb_prompt $" {
 490             set output $expect_out(1,string)
 491             check_for_board_status output
 492             gdb_comm_leave
 493             remote_reboot $dest
 494             return [list "fail" $output]
 495         }
 496         -re "(.*)Program exited with code \[0-9\]+.*$gdb_prompt $" {
 497             set output $expect_out(1,string)
 498             set status [check_for_board_status output]
 499             gdb_comm_leave
 500             if { $status > 0 } {
 501                 return [list "fail" $output]
 502             }
 503             return [list "pass" $output]
 504         }
 505         default {
 506             gdb_comm_leave
 507             if {[board_info $dest exists unreliable]} {
 508                 if { [board_info $dest unreliable] > 0 } {
 509                     global board_info
 510                     set name [board_info $dest name]
 511                     incr board_info($name,unreliable) -1
 512                     set result [gdb_comm_reload $dest $prog $args]
 513                     incr board_info($name,unreliable)
 514                     return $result
 515                 }
 516             }
 517             return [list "fail" ""]
 518         }
 519     }
 520     gdb_comm_leave
 521     return [list "fail" ""]
 522 }
 523
 524 # If we've tried less than 4 times to load PROG, reboot the target, restart GDB
 525 # and try again. Otherwise, return "untested".
 526 proc gdb_comm_reload { dest prog aargs } {
 527     global try_again
 528
 529     # how many times have we done this?
 530     set n_reloads [board_info $dest n_reloads]
 531     if {$n_reloads eq ""} {
 532         set n_reloads 0
 533     }
 534
 535     # increment it
 536     global board_info
 537     set name [board_info $dest name]
 538     set board_info($dest,n_reloads) [expr {$n_reloads + 1}]
 539
 540     # how many times are we allowed to do this?
 541     set max [board_info $dest max_reload_reboots]
 542     if {$max eq ""} {
 543         set max 15
 544     }
 545
 546     # if we've been doing this too much, something's very
 547     # wrong.  just give up, to reduce stress on boards.
 548     if {$max == $n_reloads} {
 549         perror "Too many reboots.  Giving up."
 550     }
 551     if {$max <= $n_reloads} {
 552         return {untested {}}
 553     }
 554
 555     if { $try_again < 4 } {
 556         global GDB
 557         remote_reboot $dest
 558         remote_close host
 559         incr try_again
 560         set result [eval remote_load \"$dest\" \"$prog\" $aargs]
 561         set try_again 0
 562         return $result
 563     } else {
 564         set try_again 0
 565         return [list "untested" ""]
 566     }
 567 }
 568
 569 set_board_info protocol  "gdb_comm"