RFA: Add libremote_server.exp to testsuite/config

Nick Clifton nickc@redhat.com
Mon Dec 15 12:26:00 GMT 2003


Hi Guys,

  May I have permission to contribute the following file ?  It adds
  the ability to the gdb testsuite to perform host-x-host tests via
  the rda interface.

Cheers
        Nick

gdb/testsuite/ChangeLog        
2003-12-15  Nick Clifton  <nickc@redhat.com>

	* libremote_server.exp: New file:  Allow testing of gdb with a
        "gdbserver" built either from libremote or from gdb/gdbserver.

------------------------------------------------------------------        
# Test framework for GDB (remote protocol) using a "gdbserver",
# ie. a debug agent running as a native process on the same or
# a different host.

# Copyright 2000, 2001, 2003 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.  

# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu

# This file was written by Michael Snyder. (msnyder@redhat.com)

#
# This module to be used for testing gdb with a "gdbserver" 
# built either from libremote or from gdb/gdbserver.
#

# Load the basic testing library, and the remote stuff.
load_lib ../config/monitor.exp

#
# 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 use_gdb_stub 1
#	This tells the rest of the test suite not to do things
#	like "run" which don't work well on remote targets.
#
#   set_board_info gdb,do_reload_on_run 1
#	Unles you have a gdbserver that can handle multiple sessions.
#
#   set_board_info noargs 1
#	At present there is no provision in the remote protocol
#	for passing arguments.  This test framework does not
#	address the issue, so it's best to set this variable
#	in your baseboard configuration file.  
#	FIXME: there's no reason why the test harness couldn't
#	pass commandline args when it spawns gdbserver.
#
#   set_board_info gdb,noinferiorio 1
#	Neither the traditional gdbserver nor the one in libremote
#	can presently capture stdout and relay it to GDB via the
#	'O' packet.  This means that tests involving printf will
#	fail unles you set this varibale in your baseboard
#	configuration file.
#   
#   set_board_info gdb,no_hardware_watchpoints 1
#	Unles you have a gdbserver that supports hardware watchpoints.
#	FIXME: gdb should detect if the target doesn't support them,
#	and fall back to using software watchpoints.
#
#   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 socketport
#	Port id to use for socket connection.  If not set explicitly,
#	it will start at "2345" and increment for each use.
#
#   set_board_info rsh_prog
#	The program to use to spawn executables on the remote board.
#	Default: "rsh"
#
#   set_board_info rcp_prog
#	The program to use to copy test executables to the remote board.
#	Default: "rcp"
#
#   set_board_info nfsdir
#	If rcp_prog is set to "cp", specify the local directory name that
#	is NFS mounted by the board.

#
# gdb_load -- load a file into the debugger.
#             return a -1 if anything goes wrong.
#

global server_exec;
global portnum;
set portnum "2000";

proc gdb_load { args } {
    global server_exec;
    global portnum;
    global verbose;
    global gdb_prompt;

    # 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";
    }

    # Extract the name of the gdbserver, if known (default 'gdbserver').
    if [target_info exists gdb_server_prog] {
	set gdbserver [target_info gdb_server_prog];
    } else {
	set gdbserver "gdbserver";
    }
    # Extract the socket hostname
    if [target_info exists sockethost] {
	set sockethost [target_info sockethost];
    } else {
	set sockethost ""
    }

    # Get target name
    if [target_info exists hostname] {
	set target_address [target_info hostname];
    } else {
	set target_address "localhost"
    }

    # Get the username on the target
    if [target_info exists "username"] {
	set username [target_info username];
    } else {
	set username "";
    }

    # Get download dir
    if [target_info exists download_dir] {
	set download_dir [target_info download_dir];
    } else {
	set download_dir "/tmp"
    }

    # Get tests dir
    if [target_info exists tests_dir] {
	set tests_dir [target_info tests_dir];
    } else {
	set tests_dir $download_dir
    }

    # Export the host:port pair.
    set gdbport $debughost$portnum;

    if { $args == "" || $args == "{}" } {
	if [info exists server_exec] {
	    set args $server_exec;
	} else {
	    send_gdb "info files\n";
	    gdb_expect 30 {
		-re "Symbols from \"(\[^\"\]+)\"" {
		    set args $expect_out(1,string);
		    exp_continue;
		}
		-re "Local exec file:\[\r\n\]+\[ \t\]*`(\[^'\]+)'," {
		    set args $expect_out(1,string);
		    exp_continue;
		}
		-re "$gdb_prompt $" { }
	    }
	}
    }

    # remember new exec file 
    set server_exec $args;

    # Download the test files into the test_board
    gdbserver_download $target_address $username $server_exec \
	$download_dir/a-$portnum.out

    # Fire off the debug agent
    gdbserver_spawn $target_address $username \
	"$gdbserver $portnum $tests_dir/a-$portnum.out > /dev/null 2>&1 < /dev/null &"
    #	"$gdbserver $portnum $tests_dir/a-$portnum.out >& /dev/null < /dev/null &"

    # Give it a little time to establish
    sleep 5

    # tell gdb what file we are debugging
    if [gdb_file_cmd $args] {
	return -1;
    }

    if [target_info exists solib_path] {
	send_gdb "set solib-absolute-prefix [target_info solib_path]\n"
	gdb_expect 30 {
	    -re "$gdb_prompt $" {
		if $verbose>1 then {
		    send_user "set library path\n"
		}
	    }
	    default { 
		perror "Couldn't set library path\n"
		return -1
	    }
	}
    }

    # attach to the "serial port"
    gdb_target_cmd $protocol $gdbport;

    # do the real load if needed
    if [target_info exists gdb_server_do_load] {
        send_gdb "load\n"
        set timeout 2400
        verbose "Timeout is now $timeout seconds" 2
        gdb_expect {
            -re ".*$gdb_prompt $" {
                if $verbose>1 then {
                    send_user "Loaded $arg into $GDB\n"
                }
                set timeout 30
                verbose "Timeout is now $timeout seconds" 2
                return 1
            }
            -re "$gdb_prompt $"     {
                if $verbose>1 then {
                    perror "GDB couldn't load."
                }
            }
            timeout {
                if $verbose>1 then {
                    perror "Timed out trying to load $arg."
                }
            }
        }
    }

    return 0;
}

#
# Use $RSH to spawn $commandline on remote machine $dest as user $username.
# (Note $username on $dest will have to have appropriate .rhost entries.)
#
proc gdbserver_spawn { dest username commandline } {
    global board_info

    if ![target_info exists rsh_prog] {
        if { [which remsh] != 0 } {
            set RSH remsh
        } else {
            set RSH rsh
        }
    } else {
        set RSH [target_info rsh_prog];
    }

    if [board_info $dest exists hostname] {
	set remote [board_info $dest hostname];
    } else {
	set remote $dest;
    }
    if { $username == "" } {
	verbose "spawn $RSH $remote $commandline";
	spawn $RSH $remote $commandline;
    } else {
	verbose "spawn $RSH -l $username $remote $commandline";
	spawn $RSH "-l" $username $remote $commandline;
    }
    set board_info($dest,fileid) $spawn_id;
    return $spawn_id;
}

#
# Download $srcfile to $destfile on $desthost as user $username using rcp.
#

proc gdbserver_download {desthost username srcfile destfile} {
    if [target_info exists rsh_prog] {
	set RSH [target_info rsh_prog];
    } else {
        set RSH rsh
    }

    if ![target_info exists rcp_prog] {
        set RCP rcp
    } else {
	set RCP [target_info rcp_prog];
    }

    if [board_info $desthost exists name] {
	set desthost [board_info $desthost name];
    }

    if [board_info $desthost exists hostname] {
	set desthost [board_info $desthost hostname];
    }

    if { $username == "" } {
	set rsh_useropts ""
	set rcp_dest $desthost
    } else {
	set rsh_useropts "-l $username"
	set rcp_dest "$username@$desthost"
    }

    set status [catch "exec $RSH $rsh_useropts $desthost rm -f $destfile |& cat" output]

    if { $RCP != "cp" } {
	set status [catch "exec $RCP $srcfile $rcp_dest:$destfile |& cat" output]
    } else {
	if [target_info exists nfsdir] {
	    set nfsdir [target_info nfsdir];
	    set status [catch "exec cp $srcfile $nfsdir$destfile |& cat" output]
	} else {
	    verbose "\nnfsdir not set\n"
	    set status 1
	}
    }
    if { $status == 0 } {
	verbose "Copied $srcfile to $desthost:$destfile" 2
	return $destfile;
    } else {
	verbose "Download to $desthost failed, $output."
	return ""
    }
}

                



More information about the Gdb-patches mailing list