gdb/testsuite/lib/gdbserver-support.exp

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