gdb/testsuite/lib/gdbserver-support.exp - binutils-gdb - Git at Google

 # Copyright 2000, 2002, 2003, 2004, 2005 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
 }
	# Copyright 2000, 2002, 2003, 2004, 2005 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
	}