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 target $targetname connected to.*$gdb_prompt $" {
  74                 verbose "Set target to $targetname"
  75                 return 0
  76             }
  77             -re "Connected to.*$gdb_prompt $" {
  78                 verbose "Set target to $targetname"
  79                 return 0
  80             }
  81             -re "Ending remote.*$gdb_prompt $" { }
  82             -re "Connection refused.*$gdb_prompt $" {
  83                 verbose "Connection refused by remote target.  Pausing, and trying again."
  84                 sleep 30
  85                 continue
  86             }
  87             -re "Timeout reading from remote system.*$gdb_prompt $" {
  88                 verbose "Got timeout error from gdb."
  89             }
  90             -notransfer -re "Remote debugging using .*\r\n> $" {
  91                 # We got an unexpected prompt while creating the target.
  92                 # Leave it there for the test to diagnose.
  93                 return 1
  94             }
  95             timeout {
  96                 send_gdb "\ 3"
  97                 break
  98             }
  99         }
 100     }
 101     return 1
 102 }
 103
 104
 105 global portnum
 106 set portnum "2345"
 107
 108 # Locate the gdbserver binary.  Returns "" if gdbserver could not be found.
 109
 110 proc find_gdbserver { } {
 111   global GDB
 112   global GDBSERVER
 113
 114   if [info exists GDBSERVER] {
 115     return ${GDBSERVER}
 116   }
 117
 118   if [target_info exists gdb_server_prog] {
 119     return [target_info gdb_server_prog]
 120   }
 121
 122   set gdbserver "${GDB}server"
 123   if { [file isdirectory $gdbserver] } {
 124     append gdbserver "/gdbserver"
 125   }
 126
 127   if { [file executable $gdbserver] } {
 128     return $gdbserver
 129   }
 130
 131   return ""
 132 }
 133
 134 # Return non-zero if we should skip gdbserver-specific tests.
 135
 136 proc skip_gdbserver_tests { } {
 137   if { [find_gdbserver] == "" } {
 138     return 1
 139   }
 140
 141   return 0
 142 }
 143
 144 # Download the currently loaded program to the target if necessary.
 145 # Return the target system filename.
 146 # NOTE: This was named "gdbserver_download", but that collides with the
 147 # dejagnu "download" API function when using load_generic_config "gdbserver".
 148
 149 proc gdbserver_download_current_prog { } {
 150     global gdbserver_host_exec
 151     global gdbserver_host_mtime
 152     global gdbserver_server_exec
 153     global last_loaded_file
 154
 155     set host_exec $last_loaded_file
 156
 157     # If we already downloaded a file to the target, see if we can reuse it.
 158     set reuse 0
 159     if { [info exists gdbserver_server_exec] } {
 160         set reuse 1
 161
 162         # If the file has changed, we can not.
 163         if { $host_exec != $gdbserver_host_exec } {
 164             set reuse 0
 165         }
 166
 167         # If the mtime has changed, we can not.
 168         if { [file mtime $host_exec] != $gdbserver_host_mtime } {
 169             set reuse 0
 170         }
 171     }
 172
 173     if { $reuse == 0 } {
 174         set gdbserver_host_exec $host_exec
 175         set gdbserver_host_mtime [file mtime $host_exec]
 176         if [is_remote target] {
 177             set gdbserver_server_exec [gdb_download $host_exec]
 178         } else {
 179             set gdbserver_server_exec $host_exec
 180         }
 181     }
 182
 183     return $gdbserver_server_exec
 184 }
 185
 186 # Start a gdbserver process with initial OPTIONS and trailing ARGUMENTS.
 187 # The port will be filled in between them automatically.
 188 #
 189 # Returns the target protocol and socket to connect to.
 190
 191 proc gdbserver_start { options arguments } {
 192     global portnum
 193
 194     # Port id -- either specified in baseboard file, or managed here.
 195     if [target_info exists gdb,socketport] {
 196         set portnum [target_info gdb,socketport]
 197     } else {
 198         # Bump the port number to avoid conflicts with hung ports.
 199         incr portnum
 200     }
 201
 202     # Extract the local and remote host ids from the target board struct.
 203     if [target_info exists sockethost] {
 204         set debughost [target_info sockethost]
 205     } else {
 206         set debughost "localhost:"
 207     }
 208
 209     # Extract the protocol
 210     if [target_info exists gdb_protocol] {
 211         set protocol [target_info gdb_protocol]
 212     } else {
 213         set protocol "remote"
 214     }
 215
 216     set gdbserver [find_gdbserver]
 217
 218     # Loop till we find a free port.
 219     while 1 {
 220         # Export the host:port pair.
 221         set gdbport $debughost$portnum
 222
 223         # Fire off the debug agent.
 224         set gdbserver_command "$gdbserver"
 225
 226         # If gdbserver_reconnect will be called $gdbserver_reconnect_p must be
 227         # set to true already during gdbserver_start.
 228         global gdbserver_reconnect_p
 229         if {![info exists gdbserver_reconnect_p] || !$gdbserver_reconnect_p} {
 230             # GDB client could accidentally connect to a stale server.
 231             # append gdbserver_command " --debug --once"
 232             append gdbserver_command " --once"
 233         }
 234
 235         if { $options != "" } {
 236             append gdbserver_command " $options"
 237         }
 238
 239         append gdbserver_command " :$portnum"
 240
 241         if { $arguments != "" } {
 242             append gdbserver_command " $arguments"
 243         }
 244
 245         set server_spawn_id [remote_spawn target $gdbserver_command]
 246
 247         # Wait for the server to open its TCP socket, so that GDB can connect.
 248         expect {
 249             -i $server_spawn_id
 250             -notransfer
 251             -re "Listening on" { }
 252             -re "Can't bind address: Address already in use\\.\r\n" {
 253                 verbose -log "Port $portnum is already in use."
 254                 if ![target_info exists gdb,socketport] {
 255                     # Bump the port number to avoid the conflict.
 256                     wait -i $expect_out(spawn_id)
 257                     incr portnum
 258                     continue
 259                 }
 260             }
 261         }
 262         break
 263     }
 264
 265     # We can't just call close, because if gdbserver is local then that means
 266     # that it will get a SIGHUP.  Doing it this way could also allow us to
 267     # get at the inferior's input or output if necessary, and means that we
 268     # don't need to redirect output.
 269     expect_background {
 270         -i $server_spawn_id
 271         full_buffer { }
 272         eof {
 273             # The spawn ID is already closed now (but not yet waited for).
 274             wait -i $expect_out(spawn_id)
 275         }
 276     }
 277
 278     return [list $protocol $gdbport]
 279 }
 280
 281 # Start a gdbserver process running SERVER_EXEC, and connect GDB
 282 # to it.  CHILD_ARGS are passed to the inferior.
 283 #
 284 # Returns the target protocol and socket to connect to.
 285
 286 proc gdbserver_spawn { child_args } {
 287     set target_exec [gdbserver_download_current_prog]
 288
 289     # Fire off the debug agent.  This flavour of gdbserver takes as
 290     # arguments the port information, the name of the executable file to
 291     # be debugged, and any arguments.
 292     set arguments "$target_exec"
 293     if { $child_args != "" } {
 294         append arguments " $child_args"
 295     }
 296     return [gdbserver_start "" $arguments]
 297 }
 298
 299 # Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS
 300 # to it.  Return 0 on success, or non-zero on failure.
 301
 302 proc gdbserver_run { child_args } {
 303     global gdbserver_protocol
 304     global gdbserver_gdbport
 305
 306     # Kill anything running before we try to start gdbserver, in case
 307     # we are sharing a serial connection.
 308     global gdb_prompt
 309     send_gdb "kill\n"
 310     gdb_expect 120 {
 311         -re "Kill the program being debugged. .y or n. $" {
 312             send_gdb "y\n"
 313             verbose "\t\tKilling previous program being debugged"
 314             exp_continue
 315         }
 316         -re "$gdb_prompt $" {
 317             # OK.
 318         }
 319     }
 320
 321     set res [gdbserver_spawn $child_args]
 322     set gdbserver_protocol [lindex $res 0]
 323     set gdbserver_gdbport [lindex $res 1]
 324
 325     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 326 }
 327
 328 # Reconnect to the previous gdbserver session.
 329
 330 proc gdbserver_reconnect { } {
 331     global gdbserver_protocol
 332     global gdbserver_gdbport
 333
 334     global gdbserver_reconnect_p;
 335     if {![info exists gdbserver_reconnect_p] || !$gdbserver_reconnect_p} {
 336         error "gdbserver_reconnect_p is not set before gdbserver_reconnect"
 337         return 0
 338     }
 339
 340     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 341 }
 342
 343 # Start and connect to a gdbserver in extended mode.
 344 proc gdbserver_start_extended { } {
 345     global gdbserver_protocol
 346     global gdbserver_gdbport
 347     global use_gdb_stub
 348
 349     set res [gdbserver_start "--multi" ""]
 350     set gdbserver_protocol "extended-[lindex $res 0]"
 351     set gdbserver_gdbport [lindex $res 1]
 352
 353     # Even if the board file is testing with target remote, our caller
 354     # wants to test against gdbserver in extended-remote mode.  Make sure to
 355     # disable stub-like techniques.
 356     set use_gdb_stub 0
 357
 358     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 359 }