Update FSF address.

[thirdparty/binutils-gdb.git] / gdb / testsuite / config / slite-gdb.exp

#   Copyright (C) 1993 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:
# DejaGnu@cygnus.com

# This file was written by Ian Lance Taylor <ian@cygnus.com>.

# GDB support routines for a board using the MIPS remote debugging
# protocol.  These are actually pretty generic.

# DejaGnu currently assumes that debugging is being done over the main
# console port.  It would probably be more convenient for people using
# IDT boards to permit the debugging port and the connected port to be
# different, since an IDT board has two ports.  This would require
# extending some of the tests in a fashion similar to that done for
# VxWorks, because the test output would appear on the other port,
# rather than being displayed by gdb.

load_lib remote.exp
load_lib gdb.exp

#
# gdb_version -- extract and print the version number of gdb
#
proc gdb_version {} {
    global GDB
    global GDBFLAGS
    global prompt
    set tmp [exec echo "q" | $GDB]
    set version [lindex $tmp [lsearch $tmp "\[0-9\]*"]]
    set version [string range $version 0 [expr [string length $version]-2]]
    clone_output "[which $GDB] version $version $GDBFLAGS\n"
}

#
# gdb_load -- load a file into the GDB. 
#             Returns a 0 if there was an error,
#                       1 if it load successfully.
#
proc gdb_load { arg } {
    global verbose
    global loadpath
    global loadfile
    global prompt
    global spawn_id
    global GDB
    global expect_out
    global targetname

    set loadfile [file tail $arg]
    set loadpath [file dirname $arg]

    send "file $arg\n"
    expect {
	-re "A program is being debugged already..*Kill it.*y or n. $" {
	    send "y\n"
	    exp_continue
	}
        -re "Load new symbol table.*y or n. $" {
	    send "y\n"
	    exp_continue
	}
	-re "Reading symbols from.*done..*$prompt $" {}
	-re "$prompt $" { perror "GDB couldn't read file" }
	timeout { perror "(timeout) read symbol file" ; return -1 }
    }

    send "target sparclite $targetname\n"
    set timeout 60
    expect {
	-re ".*SPARClite appears to be alive.*$prompt $"	{
	    if $verbose>1 then {
		send_user "Set target to $targetname\n"
	    }
	}
	timeout { 
	    perror "Couldn't set SLITE target."
	    set timeout 10
	    return -1
	}
    }
    
    send "load $arg\n"
    if $verbose>1 then {
	send_user "Loading $arg into $GDB\n"
    }
    set timeout 2400
    expect {
	-re "Loading.*$prompt $" {
	    if $verbose>1 then {
		send_user "Loaded $arg into $GDB\n"
	    }
	    set timeout 30
	}
	-re "$prompt $"     {
	    if $verbose>1 then {
		 perror "GDB couldn't load."
	    }
	}
	timeout {
	    if $verbose>1 then {
		 perror "Timed out trying to load $arg."
	    }
	}
    }
    set timeout 10

    send "target remote $targetname\n"
    set timeout 60
    expect {
	-re ".*$prompt $"	{
	    if $verbose>1 then {
		send_user "Set remote target to $targetname\n"
	    }
	}
	timeout { 
	    perror "Couldn't set remote target."
	    set timeout 10
	    return -1
	}
    }

    if [info exists expect_out(buffer)] then {
	send_log $expect_out(buffer)
    }
    return 0
}

#
# gdb_start -- start GDB running.
#
proc gdb_start { } {
    global GDB
    global GDBFLAGS
    global spawn_id
    global shell_id
    global prompt
    global verbose
    global targetname
    global connectmode
    global reboot
    global baud

    # reboot the board to get a clean start
    if $reboot then {
	if ![info exists connectmode] then {
	    set connectmode "kermit"
	}	
	if ![info exists baud] then {
	    set baud 9600
	}
	set shell_id [ eval $connectmode "$targetname" ]
	send -i $shell_id "\n"
	expect {
	    -i $shell_id -re ">$" { }
	    timeout {
		send -i $shell_id "\CC"
		expect {
		    -i $shell_id -re ">$" { }
		    timeout {
		 perror "(timeout) board did not come up."; return -1
		    }
		}
	    }
	}
	send -i $shell_id "go 0xbfc00000\n"
	expect {
	    -i $shell_id -re ">$" { }
	    timeout     { perror "(timeout) board did not come up."; return -1 }
	}
	verbose "about to exit kermit"
	exit_remote_shell $shell_id
    }

    set GDB [which $GDB]
    # start GDB
    if [ llength $GDBFLAGS ] then {
	spawn $GDB $GDBFLAGS
    } else {
	spawn $GDB
    }
    expect  {
	-re ".*\r\n$prompt $" {
	    verbose "GDB initialized."
	}
	-re "$prompt $"	{
	    perror "GDB never initialized."
	    return -1
	}
	timeout		{
	    perror "(timeout) GDB never initialized."
	    return -1
	}
    }

    # force the height to "unlimited", so no pagers get used
    send "set height 0\n"
    expect -re ".*$prompt $" {}
    # force the width to "unlimited", so no wraparound occurs
    send "set width 0\n"
    expect -re ".*$prompt $" {}

    # Don't use floating point instructions, in case the board doesn't
    # support them.
    # send "set mipsfpu off\n"
    # expect -re ".*$prompt $" {}

#    if $verbose>1 then {
#	send_user "Setting up target, please wait...\n"
#    }
#    send "target mips $targetname\n"
#    set timeout 60
#    expect {
#	-re "Remote MIPS debugging.*$prompt $"	{
#	    if $verbose>1 then {
#		send_user "Set target to $targetname\n"
#	    }
#	}
#	timeout { 
#	    perror "Couldn't set MIPS target."
#	    set timeout 10
#	    return -1
#	}
#    }
    set timeout 10
}

expect_after {
    "<return>"		   { send "\n"; perror "Window too small." }
    -re "\(y or n\) " 	   { send "n\n"; perror "Got interactive prompt." }
    buffer_full		   { perror "internal buffer is full." }
    eof			   { perror "eof -- pty is hosed." }
    timeout			   { perror "timeout." }
    "virtual memory exhausted" { perror "virtual memory exhausted." }
    "Undefined command"	   { perror "send string probably wrong." }
}

proc gdb_exit { } {
    catch default_gdb_exit
}

gdb_start

# make sure gdb has actually started, otherwise if the first test
# timesout, DejaGnu crashes
send "\n"
expect {
    -re "$prompt"
    }