gnu/dist/gdb6/gdb/testsuite/lib/gdbserver-support.exp

   1 # Copyright 2000, 2002, 2003, 2004, 2005 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 # 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 #
  26 #   set_board_info gdb_server_prog
  27 #       This will be the path to the gdbserver program you want to test.
  28 #       Defaults to "gdbserver".
  29 #
  30 #   set_board_info sockethost
  31 #       The name of the host computer whose socket is being used.
  32 #       Defaults to "localhost".  Note: old gdbserver requires
  33 #       that you define this, but libremote/gdbserver does not.
  34 #
  35 #   set_board_info gdb,socketport
  36 #       Port id to use for socket connection.  If not set explicitly,
  37 #       it will start at "2345" and increment for each use.
  38 #
  39
  40 #
  41 # gdb_target_cmd
  42 # Send gdb the "target" command
  43 #
  44 proc gdb_target_cmd { targetname serialport } {
  45     global gdb_prompt
  46
  47     for {set i 1} {$i <= 3} {incr i} {
  48         send_gdb "target $targetname $serialport\n"
  49         gdb_expect 60 {
  50             -re "A program is being debugged already.*ill it.*y or n. $" {
  51                 send_gdb "y\n"
  52                 exp_continue
  53             }
  54             -re "Couldn't establish connection to remote.*$gdb_prompt" {
  55                 verbose "Connection failed"
  56             }
  57             -re "Remote MIPS debugging.*$gdb_prompt" {
  58                 verbose "Set target to $targetname"
  59                 return 0
  60             }
  61             -re "Remote debugging using .*$serialport.*$gdb_prompt" {
  62                 verbose "Set target to $targetname"
  63                 return 0
  64             }
  65             -re "Remote target $targetname connected to.*$gdb_prompt" {
  66                 verbose "Set target to $targetname"
  67                 return 0
  68             }
  69             -re "Connected to.*$gdb_prompt" {
  70                 verbose "Set target to $targetname"
  71                 return 0
  72             }
  73             -re "Ending remote.*$gdb_prompt" { }
  74             -re "Connection refused.*$gdb_prompt" {
  75                 verbose "Connection refused by remote target.  Pausing, and trying again."
  76                 sleep 30
  77                 continue
  78             }
  79             -re "Timeout reading from remote system.*$gdb_prompt" {
  80                 verbose "Got timeout error from gdb."
  81             }
  82             timeout {
  83                 send_gdb "\x03"
  84                 break
  85             }
  86         }
  87     }
  88     return 1
  89 }
  90
  91
  92 global portnum
  93 set portnum "2345"
  94
  95 # Locate the gdbserver binary.  Returns "" if gdbserver could not be found.
  96
  97 proc find_gdbserver { } {
  98   global GDB
  99
 100   if [target_info exists gdb_server_prog] {
 101     return [target_info gdb_server_prog]
 102   }
 103
 104   set gdbserver "${GDB}server"
 105   if { [file isdirectory $gdbserver] } {
 106     append gdbserver "/gdbserver"
 107   }
 108
 109   if { [file executable $gdbserver] } {
 110     return $gdbserver
 111   }
 112
 113   return ""
 114 }
 115
 116 # Return non-zero if we should skip gdbserver-specific tests.
 117
 118 proc skip_gdbserver_tests { } {
 119   if { [find_gdbserver] == "" } {
 120     return 1
 121   }
 122
 123   return 0
 124 }
 125
 126 # Start a gdbserver process running SERVER_EXEC, and connect GDB
 127 # to it.  CHILD_ARGS are passed to the inferior.
 128 #
 129 # Returns the target protocol and socket to connect to.
 130
 131 proc gdbserver_spawn { server_exec child_args } {
 132     global portnum
 133
 134     # Port id -- either specified in baseboard file, or managed here.
 135     if [target_info exists gdb,socketport] {
 136         set portnum [target_info gdb,socketport]
 137     } else {
 138         # Bump the port number to avoid conflicts with hung ports.
 139         incr portnum
 140     }
 141
 142     # Extract the local and remote host ids from the target board struct.
 143     if [target_info exists sockethost] {
 144         set debughost  [target_info sockethost]
 145     } else {
 146         set debughost "localhost:"
 147     }
 148
 149     # Extract the protocol
 150     if [target_info exists gdb_protocol] {
 151         set protocol [target_info gdb_protocol]
 152     } else {
 153         set protocol "remote"
 154     }
 155
 156     set gdbserver [find_gdbserver]
 157
 158     # Export the host:port pair.
 159     set gdbport $debughost$portnum
 160
 161     # Fire off the debug agent.  This flavour of gdbserver takes as
 162     # arguments the port information, the name of the executable file to
 163     # be debugged, and any arguments.
 164     set gdbserver_command "$gdbserver :$portnum $server_exec"
 165     if { $child_args != "" } {
 166         append gdbserver_command " $child_args"
 167     }
 168
 169     set server_spawn_id [remote_spawn target $gdbserver_command]
 170
 171     # Wait for the server to produce at least one line and an additional
 172     # character of output.  This will wait until any TCP socket has been
 173     # created, so that GDB can connect.
 174     expect {
 175         -i $server_spawn_id
 176         -notransfer
 177         -re ".*\n." { }
 178     }
 179
 180     # We can't just call close, because if gdbserver is local then that means
 181     # that it will get a SIGHUP.  Doing it this way could also allow us to
 182     # get at the inferior's input or output if necessary, and means that we
 183     # don't need to redirect output.
 184     expect_background {
 185         -i $server_spawn_id
 186         -re "." { }
 187         eof {
 188             # The spawn ID is already closed now (but not yet waited for).
 189             wait -i $expect_out(spawn_id)
 190         }
 191     }
 192
 193     return [list $protocol $gdbport]
 194 }
 195
 196 proc infer_host_exec { } {
 197     set host_exec ""
 198
 199     send_gdb "info files\n"
 200     gdb_expect 30 {
 201         -re "Symbols from \"(\[^\"\]+)\"" {
 202             set host_exec $expect_out(1,string)
 203             exp_continue
 204         }
 205         -re "Local exec file:\[\r\n\]+\[ \t\]*`(\[^'\]+)'," {
 206             set host_exec $expect_out(1,string)
 207             exp_continue
 208         }
 209         -re "$gdb_prompt $" { }
 210     }
 211
 212     return $host_exec
 213 }
 214
 215 # Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS
 216 # to it.  Return 0 on success, or non-zero on failure.
 217
 218 proc gdbserver_load { host_exec child_args } {
 219     global gdbserver_host_exec
 220     global gdbserver_server_exec
 221
 222     # If we weren't passed an explicit binary, try to reuse the current
 223     # one.  If we were, be sure to redownload it.
 224
 225     if { $host_exec == "" && $gdbserver_host_exec == "" } {
 226         set gdbserver_host_exec [infer_host_exec]
 227     } elseif { $host_exec != "" } {
 228         set gdbserver_host_exec $host_exec
 229         if [info exists gdbserver_server_exec] { unset gdbserver_server_exec }
 230     }
 231
 232     if { ! [info exists gdbserver_server_exec] } {
 233         if [is_remote target] {
 234             set gdbserver_server_exec [remote_download target $host_exec /tmp/[file tail $gdbserver_host_exec].[pid]]
 235         } else {
 236             set gdbserver_server_exec $gdbserver_host_exec
 237         }
 238     }
 239
 240     set res [gdbserver_spawn $gdbserver_server_exec $child_args]
 241     set protocol [lindex $res 0]
 242     set gdbport [lindex $res 1]
 243
 244     if { $host_exec != "" } {
 245         if [gdb_file_cmd $host_exec] {
 246             return -1
 247         }
 248     }
 249     gdb_target_cmd $protocol $gdbport
 250 }