old-cross-binutils/gdb/testsuite/lib/gdbserver-support.exp
2007-01-09 17:59:20 +00:00

251 lines
6.8 KiB
Text
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

# Copyright 2000, 2002, 2003, 2004, 2005, 2006, 2007
# Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# This file is based on config/gdbserver.exp, which was written by
# Michael Snyder (msnyder@redhat.com).
#
# To be addressed or set in your baseboard config file:
#
# set_board_info gdb_protocol "remote"
# Unles you have a gdbserver that uses a different protocol...
#
# set_board_info gdb_server_prog
# This will be the path to the gdbserver program you want to test.
# Defaults to "gdbserver".
#
# set_board_info sockethost
# The name of the host computer whose socket is being used.
# Defaults to "localhost". Note: old gdbserver requires
# that you define this, but libremote/gdbserver does not.
#
# set_board_info gdb,socketport
# Port id to use for socket connection. If not set explicitly,
# it will start at "2345" and increment for each use.
#
#
# gdb_target_cmd
# Send gdb the "target" command
#
proc gdb_target_cmd { targetname serialport } {
global gdb_prompt
for {set i 1} {$i <= 3} {incr i} {
send_gdb "target $targetname $serialport\n"
gdb_expect 60 {
-re "A program is being debugged already.*ill it.*y or n. $" {
send_gdb "y\n"
exp_continue
}
-re "Couldn't establish connection to remote.*$gdb_prompt $" {
verbose "Connection failed"
}
-re "Remote MIPS debugging.*$gdb_prompt" {
verbose "Set target to $targetname"
return 0
}
-re "Remote debugging using .*$serialport.*$gdb_prompt $" {
verbose "Set target to $targetname"
return 0
}
-re "Remote target $targetname connected to.*$gdb_prompt $" {
verbose "Set target to $targetname"
return 0
}
-re "Connected to.*$gdb_prompt $" {
verbose "Set target to $targetname"
return 0
}
-re "Ending remote.*$gdb_prompt $" { }
-re "Connection refused.*$gdb_prompt $" {
verbose "Connection refused by remote target. Pausing, and trying again."
sleep 30
continue
}
-re "Timeout reading from remote system.*$gdb_prompt $" {
verbose "Got timeout error from gdb."
}
timeout {
send_gdb ""
break
}
}
}
return 1
}
global portnum
set portnum "2345"
# Locate the gdbserver binary. Returns "" if gdbserver could not be found.
proc find_gdbserver { } {
global GDB
if [target_info exists gdb_server_prog] {
return [target_info gdb_server_prog]
}
set gdbserver "${GDB}server"
if { [file isdirectory $gdbserver] } {
append gdbserver "/gdbserver"
}
if { [file executable $gdbserver] } {
return $gdbserver
}
return ""
}
# Return non-zero if we should skip gdbserver-specific tests.
proc skip_gdbserver_tests { } {
if { [find_gdbserver] == "" } {
return 1
}
return 0
}
# Start a gdbserver process running SERVER_EXEC, and connect GDB
# to it. CHILD_ARGS are passed to the inferior.
#
# Returns the target protocol and socket to connect to.
proc gdbserver_spawn { server_exec child_args } {
global portnum
# Port id -- either specified in baseboard file, or managed here.
if [target_info exists gdb,socketport] {
set portnum [target_info gdb,socketport]
} else {
# Bump the port number to avoid conflicts with hung ports.
incr portnum
}
# Extract the local and remote host ids from the target board struct.
if [target_info exists sockethost] {
set debughost [target_info sockethost]
} else {
set debughost "localhost:"
}
# Extract the protocol
if [target_info exists gdb_protocol] {
set protocol [target_info gdb_protocol]
} else {
set protocol "remote"
}
set gdbserver [find_gdbserver]
# Export the host:port pair.
set gdbport $debughost$portnum
# Fire off the debug agent. This flavour of gdbserver takes as
# arguments the port information, the name of the executable file to
# be debugged, and any arguments.
set gdbserver_command "$gdbserver :$portnum $server_exec"
if { $child_args != "" } {
append gdbserver_command " $child_args"
}
set server_spawn_id [remote_spawn target $gdbserver_command]
# Wait for the server to produce at least one line and an additional
# character of output. This will wait until any TCP socket has been
# created, so that GDB can connect.
expect {
-i $server_spawn_id
-notransfer
-re ".*\n." { }
}
# We can't just call close, because if gdbserver is local then that means
# that it will get a SIGHUP. Doing it this way could also allow us to
# get at the inferior's input or output if necessary, and means that we
# don't need to redirect output.
expect_background {
-i $server_spawn_id
-re "." { }
eof {
# The spawn ID is already closed now (but not yet waited for).
wait -i $expect_out(spawn_id)
}
}
return [list $protocol $gdbport]
}
proc infer_host_exec { } {
set host_exec ""
send_gdb "info files\n"
gdb_expect 30 {
-re "Symbols from \"(\[^\"\]+)\"" {
set host_exec $expect_out(1,string)
exp_continue
}
-re "Local exec file:\[\r\n\]+\[ \t\]*`(\[^'\]+)'," {
set host_exec $expect_out(1,string)
exp_continue
}
-re "$gdb_prompt $" { }
}
return $host_exec
}
# Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS
# to it. Return 0 on success, or non-zero on failure.
proc gdbserver_load { host_exec child_args } {
global gdbserver_host_exec
global gdbserver_server_exec
# If we weren't passed an explicit binary, try to reuse the current
# one. If we were, be sure to redownload it.
if { $host_exec == "" && $gdbserver_host_exec == "" } {
set gdbserver_host_exec [infer_host_exec]
} elseif { $host_exec != "" } {
set gdbserver_host_exec $host_exec
if [info exists gdbserver_server_exec] { unset gdbserver_server_exec }
}
if { ! [info exists gdbserver_server_exec] } {
if [is_remote target] {
set gdbserver_server_exec [remote_download target $host_exec /tmp/[file tail $gdbserver_host_exec].[pid]]
} else {
set gdbserver_server_exec $gdbserver_host_exec
}
}
set res [gdbserver_spawn $gdbserver_server_exec $child_args]
set protocol [lindex $res 0]
set gdbport [lindex $res 1]
if { $host_exec != "" } {
if [gdb_file_cmd $host_exec] {
return -1
}
}
gdb_target_cmd $protocol $gdbport
}