gdb/testsuite/lib/gdbserver-support.exp

   1 # Copyright 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
   2 # Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 # This file is based on config/gdbserver.exp, which was written by
  18 # Michael Snyder (msnyder@redhat.com).
  19
  20 #
  21 # To be addressed or set in your baseboard config file:
  22 #
  23 #   set_board_info gdb_protocol "remote"
  24 #       Unles you have a gdbserver that uses a different protocol...
  25 #       After GDB starts you should check global $gdbserver_protocol instead as
  26 #       the testfile may force a specific different target protocol itself.
  27 #
  28 #   set_board_info gdb_server_prog
  29 #       This will be the path to the gdbserver program you want to test.
  30 #       Defaults to "gdbserver".
  31 #
  32 #   set_board_info sockethost
  33 #       The name of the host computer whose socket is being used.
  34 #       Defaults to "localhost".  Note: old gdbserver requires
  35 #       that you define this, but libremote/gdbserver does not.
  36 #
  37 #   set_board_info gdb,socketport
  38 #       Port id to use for socket connection.  If not set explicitly,
  39 #       it will start at "2345" and increment for each use.
  40 #       After GDB starts you should check global $gdbserver_gdbport for the
  41 #       real port used.  It is not useful if $gdbserver_reconnect_p was not set.
  42 #
  43
  44 #
  45 # gdb_target_cmd
  46 # Send gdb the "target" command
  47 #
  48 proc gdb_target_cmd { targetname serialport } {
  49     global gdb_prompt
  50
  51     set serialport_re [string_to_regexp $serialport]
  52     for {set i 1} {$i <= 3} {incr i} {
  53         send_gdb "target $targetname $serialport\n"
  54         gdb_expect 60 {
  55             -re "A program is being debugged already.*ill it.*y or n. $" {
  56                 send_gdb "y\n"
  57                 exp_continue
  58             }
  59             -re "unknown host.*$gdb_prompt" {
  60                 verbose "Couldn't look up $serialport"
  61             }
  62             -re "Couldn't establish connection to remote.*$gdb_prompt $" {
  63                 verbose "Connection failed"
  64             }
  65             -re "Remote MIPS debugging.*$gdb_prompt" {
  66                 verbose "Set target to $targetname"
  67                 return 0
  68             }
  69             -re "Remote debugging using .*$serialport_re.*$gdb_prompt $" {
  70                 verbose "Set target to $targetname"
  71                 return 0
  72             }
  73             -re "Remote debugging using stdio.*$gdb_prompt $" {
  74                 verbose "Set target to $targetname"
  75                 return 0
  76             }
  77             -re "Remote target $targetname connected to.*$gdb_prompt $" {
  78                 verbose "Set target to $targetname"
  79                 return 0
  80             }
  81             -re "Connected to.*$gdb_prompt $" {
  82                 verbose "Set target to $targetname"
  83                 return 0
  84             }
  85             -re "Ending remote.*$gdb_prompt $" { }
  86             -re "Connection refused.*$gdb_prompt $" {
  87                 verbose "Connection refused by remote target.  Pausing, and trying again."
  88                 sleep 30
  89                 continue
  90             }
  91             -re "Timeout reading from remote system.*$gdb_prompt $" {
  92                 verbose "Got timeout error from gdb."
  93             }
  94             -notransfer -re "Remote debugging using .*\r\n> $" {
  95                 # We got an unexpected prompt while creating the target.
  96                 # Leave it there for the test to diagnose.
  97                 return 1
  98             }
  99             timeout {
 100                 send_gdb "\ 3"
 101                 break
 102             }
 103         }
 104     }
 105     return 1
 106 }
 107
 108
 109 global portnum
 110 set portnum "2345"
 111
 112 # Locate the gdbserver binary.  Returns "" if gdbserver could not be found.
 113
 114 proc find_gdbserver { } {
 115   global GDB
 116   global GDBSERVER
 117
 118   if [info exists GDBSERVER] {
 119     return ${GDBSERVER}
 120   }
 121
 122   if [target_info exists gdb_server_prog] {
 123     return [target_info gdb_server_prog]
 124   }
 125
 126   set gdbserver "${GDB}server"
 127   if { [file isdirectory $gdbserver] } {
 128     append gdbserver "/gdbserver"
 129   }
 130
 131   if { [file executable $gdbserver] } {
 132     return $gdbserver
 133   }
 134
 135   return ""
 136 }
 137
 138 # Return non-zero if we should skip gdbserver-specific tests.
 139
 140 proc skip_gdbserver_tests { } {
 141   if { [find_gdbserver] == "" } {
 142     return 1
 143   }
 144
 145   return 0
 146 }
 147
 148 # Download the currently loaded program to the target if necessary.
 149 # Return the target system filename.
 150 # NOTE: This was named "gdbserver_download", but that collides with the
 151 # dejagnu "download" API function when using load_generic_config "gdbserver".
 152
 153 proc gdbserver_download_current_prog { } {
 154     global gdbserver_host_exec
 155     global gdbserver_host_mtime
 156     global gdbserver_server_exec
 157     global last_loaded_file
 158
 159     set host_exec $last_loaded_file
 160
 161     # If we already downloaded a file to the target, see if we can reuse it.
 162     set reuse 0
 163     if { [info exists gdbserver_server_exec] } {
 164         set reuse 1
 165
 166         # If the file has changed, we can not.
 167         if { $host_exec != $gdbserver_host_exec } {
 168             set reuse 0
 169         }
 170
 171         # If the mtime has changed, we can not.
 172         if { [file mtime $host_exec] != $gdbserver_host_mtime } {
 173             set reuse 0
 174         }
 175     }
 176
 177     if { $reuse == 0 } {
 178         set gdbserver_host_exec $host_exec
 179         set gdbserver_host_mtime [file mtime $host_exec]
 180         if [is_remote target] {
 181             set gdbserver_server_exec [gdb_download $host_exec]
 182         } else {
 183             set gdbserver_server_exec $host_exec
 184         }
 185     }
 186
 187     return $gdbserver_server_exec
 188 }
 189
 190 # Default routine to compute the argument to "target remote".
 191
 192 proc gdbserver_default_get_remote_address { host port } {
 193     return "$host$port"
 194 }
 195
 196 # Start a gdbserver process with initial OPTIONS and trailing ARGUMENTS.
 197 # The port will be filled in between them automatically.
 198 #
 199 # Returns the target protocol and socket to connect to.
 200
 201 proc gdbserver_start { options arguments } {
 202     global portnum
 203
 204     # Port id -- either specified in baseboard file, or managed here.
 205     if [target_info exists gdb,socketport] {
 206         set portnum [target_info gdb,socketport]
 207     } else {
 208         # Bump the port number to avoid conflicts with hung ports.
 209         incr portnum
 210     }
 211
 212     # Extract the local and remote host ids from the target board struct.
 213     if [target_info exists sockethost] {
 214         set debughost [target_info sockethost]
 215     } else {
 216         set debughost "localhost:"
 217     }
 218
 219     # Some boards use a different value for the port that is passed to
 220     # gdbserver and the port that is passed to the "target remote" command.
 221     # One example is the stdio gdbserver support.
 222     if [target_info exists gdb,get_remote_address] {
 223         set get_remote_address [target_info gdb,get_remote_address]
 224     } else {
 225         set get_remote_address gdbserver_default_get_remote_address
 226     }
 227
 228     # Extract the protocol
 229     if [target_info exists gdb_protocol] {
 230         set protocol [target_info gdb_protocol]
 231     } else {
 232         set protocol "remote"
 233     }
 234
 235     set gdbserver [find_gdbserver]
 236
 237     # Loop till we find a free port.
 238     while 1 {
 239         # Fire off the debug agent.
 240         set gdbserver_command "$gdbserver"
 241
 242         # If gdbserver_reconnect will be called $gdbserver_reconnect_p must be
 243         # set to true already during gdbserver_start.
 244         global gdbserver_reconnect_p
 245         if {![info exists gdbserver_reconnect_p] || !$gdbserver_reconnect_p} {
 246             # GDB client could accidentally connect to a stale server.
 247             # append gdbserver_command " --debug --once"
 248             append gdbserver_command " --once"
 249         }
 250
 251         if { $options != "" } {
 252             append gdbserver_command " $options"
 253         }
 254         if { $portnum != "" } {
 255             append gdbserver_command " :$portnum"
 256         }
 257         if { $arguments != "" } {
 258             append gdbserver_command " $arguments"
 259         }
 260
 261         set server_spawn_id [remote_spawn target $gdbserver_command]
 262
 263         # Wait for the server to open its TCP socket, so that GDB can connect.
 264         expect {
 265             -i $server_spawn_id
 266             -notransfer
 267             -re "Listening on" { }
 268             -re "Can't bind address: Address already in use\\.\r\n" {
 269                 verbose -log "Port $portnum is already in use."
 270                 if ![target_info exists gdb,socketport] {
 271                     # Bump the port number to avoid the conflict.
 272                     wait -i $expect_out(spawn_id)
 273                     incr portnum
 274                     continue
 275                 }
 276             }
 277         }
 278         break
 279     }
 280
 281     # We can't just call close, because if gdbserver is local then that means
 282     # that it will get a SIGHUP.  Doing it this way could also allow us to
 283     # get at the inferior's input or output if necessary, and means that we
 284     # don't need to redirect output.
 285     expect_background {
 286         -i $server_spawn_id
 287         full_buffer { }
 288         eof {
 289             # The spawn ID is already closed now (but not yet waited for).
 290             wait -i $expect_out(spawn_id)
 291         }
 292     }
 293
 294     return [list $protocol [$get_remote_address $debughost $portnum]]
 295 }
 296
 297 # Start a gdbserver process running SERVER_EXEC, and connect GDB
 298 # to it.  CHILD_ARGS are passed to the inferior.
 299 #
 300 # Returns the target protocol and socket to connect to.
 301
 302 proc gdbserver_spawn { child_args } {
 303     set target_exec [gdbserver_download_current_prog]
 304
 305     # Fire off the debug agent.  This flavour of gdbserver takes as
 306     # arguments the port information, the name of the executable file to
 307     # be debugged, and any arguments.
 308     set arguments "$target_exec"
 309     if { $child_args != "" } {
 310         append arguments " $child_args"
 311     }
 312     return [gdbserver_start "" $arguments]
 313 }
 314
 315 # Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS
 316 # to it.  Return 0 on success, or non-zero on failure.
 317
 318 proc gdbserver_run { child_args } {
 319     global gdbserver_protocol
 320     global gdbserver_gdbport
 321
 322     # Kill anything running before we try to start gdbserver, in case
 323     # we are sharing a serial connection.
 324     global gdb_prompt
 325     send_gdb "kill\n"
 326     gdb_expect 120 {
 327         -re "Kill the program being debugged. .y or n. $" {
 328             send_gdb "y\n"
 329             verbose "\t\tKilling previous program being debugged"
 330             exp_continue
 331         }
 332         -re "$gdb_prompt $" {
 333             # OK.
 334         }
 335     }
 336
 337     set res [gdbserver_spawn $child_args]
 338     set gdbserver_protocol [lindex $res 0]
 339     set gdbserver_gdbport [lindex $res 1]
 340
 341     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 342 }
 343
 344 # Reconnect to the previous gdbserver session.
 345
 346 proc gdbserver_reconnect { } {
 347     global gdbserver_protocol
 348     global gdbserver_gdbport
 349
 350     global gdbserver_reconnect_p;
 351     if {![info exists gdbserver_reconnect_p] || !$gdbserver_reconnect_p} {
 352         error "gdbserver_reconnect_p is not set before gdbserver_reconnect"
 353         return 0
 354     }
 355
 356     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 357 }
 358
 359 # Start and connect to a gdbserver in extended mode.
 360 proc gdbserver_start_extended { } {
 361     global gdbserver_protocol
 362     global gdbserver_gdbport
 363     global use_gdb_stub
 364
 365     set res [gdbserver_start "--multi" ""]
 366     set gdbserver_protocol "extended-[lindex $res 0]"
 367     set gdbserver_gdbport [lindex $res 1]
 368
 369     # Even if the board file is testing with target remote, our caller
 370     # wants to test against gdbserver in extended-remote mode.  Make sure to
 371     # disable stub-like techniques.
 372     set use_gdb_stub 0
 373
 374     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 375 }