[deliverable/binutils-gdb.git] / gdb / testsuite / lib / gdb.exp

# Copyright (C) 1992 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., 675 Mass Ave, Cambridge, MA 02139, USA.  */

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

# This file was written by Fred Fish. (fnf@cygnus.com)

# set the prompt if it doesn't exist
global prompt
if ![info exists prompt] then {
    set prompt "\[(\]gdb\[)\]"
}

# Generic gdb subroutines that should work for any target.  If these
# need to be modified for any target, it can be done with a variable
# or by passing arguments.

global GDB
if ![info exists GDB] then {
    set GDB [findfile $base_dir/../gdb "gdb" [transform gdb ]]
}

global GDBFLAGS
if ![info exists GDBFLAGS] then {
    set GDBFLAGS ""
}

#
# gdb_version -- extract and print the version number of gcc
#
proc default_gdb_version {} {
    global GDB
    global GDBFLAGS
    if {[which $GDB] != 0} then {
	set tmp [exec echo "q" | $GDB]
	regexp " \[0-9\.\]+" $tmp version
	clone_output "[which $GDB] version$version $GDBFLAGS\n"
    } else {
	warning "$GDB does not exist"
    }
}

#
# gdb_unload -- unload a file if one is loaded
#

proc gdb_unload {} {
    global verbose
    global GDB
    global prompt
    send "file\n"
    expect {
	-re "No exec file now.*\r" { exp_continue }
	-re "No symbol file now.*\r" { exp_continue }
	-re "A program is being debugged already..*Kill it.*y or n. $"\
	    { send "y\n"
		verbose "\t\tKilling previous program being debugged"
	    exp_continue
	}
	-re "Discard symbol table from .*y or n. $" {
	    send "y\n"
	    exp_continue
	}
	-re "$prompt $" {}
	timeout {
	    perror "couldn't unload file in $GDB (timed out)."
	    return -1
	}
    }
}

# Many of the tests depend on setting breakpoints at various places and
# running until that breakpoint is reached.  At times, we want to start
# with a clean-slate with respect to breakpoints, so this utility proc 
# lets us do this without duplicating this code everywhere.
#

proc delete_breakpoints {} {
    global prompt

    send "delete breakpoints\n"
    expect {
	-re "Delete all breakpoints.*y or n. $" {
	    send "y\n"
	    exp_continue
	}
	-re "y\r\n$prompt $" {}
	-re ".*$prompt $" { perror "Delete all breakpoints" ; return }
	timeout { perror "Delete all breakpoints (timeout)" ; return }
    }
    send "info breakpoints\n"
    expect {
	-re "No breakpoints or watchpoints..*$prompt $" {}
	-re ".*$prompt $" { perror "breakpoints not deleted" ; return }
	timeout { perror "info breakpoints (timeout)" ; return }
    }
}


#
# Set breakpoint at function and run gdb until it breaks there.
# Since this is the only breakpoint that will be set, if it stops
# at a breakpoint, we will assume it is the one we want.  We can't
# just compare to "function" because it might be a fully qualified,
# single quoted C++ function specifier.
#

proc runto { function } {
    global prompt
    global decimal

    send "delete\n"
    expect {
	-re "delete.*Delete all breakpoints.*y or n. $" {
	    send "y\n"
	    expect {
		-re "$prompt $" {}
		timeout { fail "deleting breakpoints (timeout)" ; return 0 }
	    }
	}
	-re ".*$prompt $" {}
	timeout { fail "deleting breakpoints (timeout)" ; return 0 }
    }

    send "break $function\n"
    # The first regexp is what we get with -g, the second without -g.
    expect {
	-re "Break.* at .*: file .*, line $decimal.\r\n$prompt $" {}
	-re "Breakpoint \[0-9\]* at 0x\[0-9a-f\]*.*$prompt $" {}
	-re "$prompt $" { fail "setting breakpoint at $function" ; return 0 }
	timeout { fail "setting breakpoint at $function (timeout)" ; return 0 }
    }

    send "run\n"
    # the "at foo.c:36" output we get with -g.
    # the "in func" output we get without -g.
    expect {
	-re "The program .* has been started already.*y or n. $" {
	    send "y\n"
	    exp_continue
	}
	-re "Starting.*Break.* at .*:$decimal.*$prompt $" { return 1 }
	-re "Breakpoint \[0-9\]*, \[0-9xa-f\]* in $function.*$prompt $" { 
	    return 1
	}
	-re "$prompt $" { fail "running to $function" ; return 0 }
	timeout { fail "running to $function (timeout)" ; return 0 }
    }
}

#
# gdb_test -- send a command to gdb and test the result.
#             Takes three parameters.
#             Parameters:
#                First one is the command to execute,
#                Second one is the pattern to match for a PASS,
#                Third one is an optional message to be printed. If this
#                  a null string "", then the pass/fail messages are not printed.
#             Returns:
#                1 if the test failed,
#                0 if the test passes,
#               -1 if there was an internal error.
#
proc gdb_test { args } {
    global verbose
    global prompt
    global GDB
    global spawn_id

    if [llength $args]==3 then {
	set message [lindex $args 2]
    } else {
	set message [lindex $args 0]
    }
    set command [lindex $args 0]
    set pattern [lindex $args 1]

    if $verbose>2 then {
	send_user "Sending \"$command\" to gdb\n"
	send_user "Looking to match \"$pattern\"\n"
	send_user "Message is \"$message\"\n"
    }

    set result -1
    set errmess ""
    # trap the send so any problems don't crash things
    catch "send \"$command\n\"" errmess
    if [string match "write.spawn_id=\[0-9\]+.:" $errmess] then {
	perror "sent \"$command\" got expect error \"$errmess\""
	catch "close"
	gdb_start
	return -1
    }

    expect {
	-re ".*Ending remote debugging.*$prompt$" {
	    if ![isnative] then {
		warning "Can`t communicate to remote target."
	    }
	    gdb_exit
	    gdb_start
	    set result -1
	}
	-re "$pattern.*$prompt $" {
	    if ![string match "" $message] then {
		pass "$message"
	    }
	    set result 0
	}
	-re "Undefined command:.*$prompt" {
	    perror "Undefined command \"$command\"."
	    set result 1
	}
	-re "Ambiguous command.*$prompt $" {
	    perror "\"$command\" is not a unique command name."
	    set result 1
	}
	-re ".*$prompt $" {
	    if ![string match "" $message] then {
		fail "$message"
	    }
	    set result 1
	}
	"<return>" {
	    send "\n"
	    perror "Window too small."
	}
	-re "\[(\]+y or n\[)\]+ " {
	    send "n\n"
	    perror "Got interactive prompt."
	}
	eof {
	    perror "Process no longer exists"
	    return -1
	}
	buffer_full {
	    perror "internal buffer is full."
	}
	timeout	{
	    fail "(timeout) $message"
	    set result 1
	}
    }
    return $result
}

proc gdb_reinitialize_dir { subdir } {
    global prompt

   send "dir\n"
    expect {
	-re "Reinitialize source path to empty.*" {
	    send "y\n"
	    expect {
		-re "Source directories searched.*$prompt $" {
		    send "dir $subdir\n"
		    expect {
			-re "Source directories searched.*$prompt $" {
			    verbose "Dir set to $subdir"
			}
			-re ".*$prompt $" {
			    perror "Dir \"$subdir\" failed."
			}
		    }
		}
		-re ".*$prompt $" {
		    perror "Dir \"$subdir\" failed."
		}
	    }
	}
	-re ".*$prompt $" {
	    perror "Dir \"$subdir\" failed."
	}
    }
}

#
# gdb_exit -- exit the GDB, killing the target program if necessary
#
proc default_gdb_exit {} {
    global GDB
    global GDBFLAGS
    global verbose

    verbose "Quitting $GDB $GDBFLAGS"

    # This used to be 1 for unix-gdb.exp
    set timeout 5

    # this will kill the gdb process, it's cleaner than sending a quit.
      close
  
    # Before this was here sometimes "uit" would get sent to the next GDB
    # (assuming this is immediately followed by gdb_start), which would
    # cause a loss of syncronization (i.e. all the stuff that swallows a
    # prompt would swallow the wrong one).
    wait
}

#
# gdb_load -- load a file into the debugger.
#             return a -1 if anything goes wrong.
#
proc gdb_file_cmd { arg } {
    global verbose
    global loadpath
    global loadfile
    global GDB
    global prompt
    global spawn_id

    send "file $arg\n"
    expect {
        -re "Reading symbols from.*done.*$prompt $" {
            verbose "\t\tLoaded $arg into the $GDB"
            return 0
        }
        -re "has no symbol-table.*$prompt $" {
            perror "$arg wasn't compiled with \"-g\""
            return -1
        }
        -re "A program is being debugged already.*Kill it.*y or n. $" {
            send "y\n"
                verbose "\t\tKilling previous program being debugged"
            exp_continue
        }
        -re "Load new symbol table from \".*\".*y or n. $" {
            send "y\n"
            expect {
                -re "Reading symbols from.*done.*$prompt $" {
                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
                    return 0
                }
                timeout {
                    perror "(timeout) Couldn't load $arg, other program already l
oaded."
                    return -1
                }
            }
	}
        -re ".*No such file or directory.*$prompt $" {
            perror "($arg) No such file or directory\n"
            return -1
        }
        -re "$prompt $" {
            perror "couldn't load $arg into $GDB."
            return -1
            }
        timeout {
            perror "couldn't load $arg into $GDB (timed out)."
            return -1
        }
        eof {
            # This is an attempt to detect a core dump, but seems not to
            # work.  Perhaps we need to match .* followed by eof, in which
            # expect does not seem to have a way to do that.
            perror "couldn't load $arg into $GDB (end of file)."
            return -1
        }
    }
}


#
# start gdb -- start gdb running
#
proc default_gdb_start { } {
    global verbose
    global GDB
    global GDBFLAGS
    global prompt
    global spawn_id
    global timeout
    verbose "Spawning $GDB $GDBFLAGS"
    
    set oldtimeout $timeout
    set timeout [expr "$timeout + 60"]
    if [ llength $GDBFLAGS ] then {
	if {[which $GDB] != 0} then {
	    spawn $GDB $GDBFLAGS
	} else {
	    perror "$GDB does not exist."
	    exit 1
	}
    } else {
	if {[which $GDB] != 0} then {
	    spawn $GDB
	} else {
	    perror "$GDB does not exist."
	    exit 1
	}
    }
    expect {
	-re ".*\r\n$prompt $" {
	    verbose "GDB initialized for native mode"
	}
	-re "$prompt $"	{
	    perror "GDB never initialized."
	    return -1
	}
	timeout		{
	    perror "(timeout) GDB never initialized."
  	    return -1
  	}
      }
    set timeout $oldtimeout
    # force the height to "unlimited", so no pagers get used
    send "set height 0\n"
    expect {
	-re ".*$prompt $" { 
	    verbose "Setting height to 0." 2
	}
	timeout {
	    warning "Couldn't set the height to 0."
	}
    }
    # force the width to "unlimited", so no wraparound occurs
    send "set width 0\n"
    expect {
	-re ".*$prompt $" {
	    verbose "Setting width to 0." 2
	}
	timeout {
	    warning "Couldn't set the width to 0."
	}
    }
}

#
# FIXME: this is a copy of the new library procedure, but it's here too
# till the new dejagnu gets installed everywhere. I'd hate to break the
# gdb tests suite.
#
global argv0
if ![info exists argv0] then {
    proc exp_continue { } {
	continue -expect
    }
}
Commit	Line	Data
19fa4a0a MW	1	# Copyright (C) 1992 Free Software Foundation, Inc.
	2
	3	# This program is free software; you can redistribute it and/or modify
	4	# it under the terms of the GNU General Public License as published by
	5	# the Free Software Foundation; either version 2 of the License, or
	6	# (at your option) any later version.
	7	#
	8	# This program is distributed in the hope that it will be useful,
	9	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	# GNU General Public License for more details.
	12	#
	13	# You should have received a copy of the GNU General Public License
	14	# along with this program; if not, write to the Free Software
	15	# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
	16
	17	# Please email any bugs, comments, and/or additions to this file to:
c79f61db	18	# bug-gdb@prep.ai.mit.edu
19fa4a0a MW	19
	20	# This file was written by Fred Fish. (fnf@cygnus.com)
	21
2f109983 BC	22	# set the prompt if it doesn't exist
	23	global prompt
	24	if ![info exists prompt] then {
	25	set prompt "\[(\]gdb\[)\]"
	26	}
	27
19fa4a0a MW	28	# Generic gdb subroutines that should work for any target. If these
	29	# need to be modified for any target, it can be done with a variable
	30	# or by passing arguments.
	31
9bcc6c3f RS	32	global GDB
9bcc6c3f RS	33	if ![info exists GDB] then {
2f109983	34	set GDB [findfile $base_dir/../gdb "gdb" [transform gdb ]]
9bcc6c3f RS	35	}
	36
	37	global GDBFLAGS
85174909 RS	38	if ![info exists GDBFLAGS] then {
	39	set GDBFLAGS ""
	40	}
	41
5019a275 RS	42	#
	43	# gdb_version -- extract and print the version number of gcc
	44	#
	45	proc default_gdb_version {} {
	46	global GDB
	47	global GDBFLAGS
	48	if {[which $GDB] != 0} then {
	49	set tmp [exec echo "q" \| $GDB]
85174909 RS	50	regexp " \[0-9\.\]+" $tmp version
85174909 RS	51	clone_output "[which $GDB] version$version $GDBFLAGS\n"
5019a275 RS	52	} else {
	53	warning "$GDB does not exist"
	54	}
	55	}
	56
19fa4a0a MW	57	#
	58	# gdb_unload -- unload a file if one is loaded
	59	#
	60
	61	proc gdb_unload {} {
	62	global verbose
	63	global GDB
	64	global prompt
	65	send "file\n"
	66	expect {
9bcc6c3f RS	67	-re "No exec file now.*\r" { exp_continue }
	68	-re "No symbol file now.*\r" { exp_continue }
	69	-re "A program is being debugged already..Kill it.y or n. $"\
19fa4a0a	70	{ send "y\n"
85174909	71	verbose "\t\tKilling previous program being debugged"
9bcc6c3f	72	exp_continue
19fa4a0a	73	}
9bcc6c3f	74	-re "Discard symbol table from .*y or n. $" {
19fa4a0a	75	send "y\n"
9bcc6c3f	76	exp_continue
19fa4a0a MW	77	}
	78	-re "$prompt $" {}
	79	timeout {
85174909	80	perror "couldn't unload file in $GDB (timed out)."
c79f61db	81	return -1
19fa4a0a MW	82	}
	83	}
	84	}
	85
	86	# Many of the tests depend on setting breakpoints at various places and
	87	# running until that breakpoint is reached. At times, we want to start
	88	# with a clean-slate with respect to breakpoints, so this utility proc
	89	# lets us do this without duplicating this code everywhere.
	90	#
	91
	92	proc delete_breakpoints {} {
	93	global prompt
	94
	95	send "delete breakpoints\n"
	96	expect {
9bcc6c3f	97	-re "Delete all breakpoints.*y or n. $" {
19fa4a0a	98	send "y\n"
9bcc6c3f	99	exp_continue
19fa4a0a MW	100	}
19fa4a0a MW	101	-re "y\r\n$prompt $" {}
9bcc6c3f	102	-re ".*$prompt $" { perror "Delete all breakpoints" ; return }
8f07e537	103	timeout { perror "Delete all breakpoints (timeout)" ; return }
19fa4a0a MW	104	}
	105	send "info breakpoints\n"
	106	expect {
	107	-re "No breakpoints or watchpoints..*$prompt $" {}
9bcc6c3f	108	-re ".*$prompt $" { perror "breakpoints not deleted" ; return }
8f07e537	109	timeout { perror "info breakpoints (timeout)" ; return }
19fa4a0a MW	110	}
	111	}
	112
	113
	114	#
	115	# Set breakpoint at function and run gdb until it breaks there.
	116	# Since this is the only breakpoint that will be set, if it stops
	117	# at a breakpoint, we will assume it is the one we want. We can't
	118	# just compare to "function" because it might be a fully qualified,
	119	# single quoted C++ function specifier.
	120	#
	121
	122	proc runto { function } {
	123	global prompt
	124	global decimal
	125
	126	send "delete\n"
	127	expect {
9bcc6c3f	128	-re "delete.Delete all breakpoints.y or n. $" {
19fa4a0a MW	129	send "y\n"
	130	expect {
	131	-re "$prompt $" {}
	132	timeout { fail "deleting breakpoints (timeout)" ; return 0 }
	133	}
	134	}
	135	-re ".*$prompt $" {}
	136	timeout { fail "deleting breakpoints (timeout)" ; return 0 }
	137	}
	138
	139	send "break $function\n"
c79f61db	140	# The first regexp is what we get with -g, the second without -g.
19fa4a0a MW	141	expect {
19fa4a0a MW	142	-re "Break.* at .: file ., line $decimal.\r\n$prompt $" {}
c79f61db	143	-re "Breakpoint \[0-9\]* at 0x\[0-9a-f\].$prompt $" {}
19fa4a0a MW	144	-re "$prompt $" { fail "setting breakpoint at $function" ; return 0 }
	145	timeout { fail "setting breakpoint at $function (timeout)" ; return 0 }
	146	}
	147
	148	send "run\n"
c79f61db RS	149	# the "at foo.c:36" output we get with -g.
c79f61db RS	150	# the "in func" output we get without -g.
19fa4a0a	151	expect {
9bcc6c3f	152	-re "The program .* has been started already.*y or n. $" {
19fa4a0a	153	send "y\n"
9bcc6c3f	154	exp_continue
19fa4a0a	155	}
c79f61db RS	156	-re "Starting.Break. at .:$decimal.$prompt $" { return 1 }
	157	-re "Breakpoint \[0-9\], \[0-9xa-f\] in $function.*$prompt $" {
	158	return 1
	159	}
19fa4a0a MW	160	-re "$prompt $" { fail "running to $function" ; return 0 }
	161	timeout { fail "running to $function (timeout)" ; return 0 }
	162	}
	163	}
	164
	165	#
	166	# gdb_test -- send a command to gdb and test the result.
	167	# Takes three parameters.
	168	# Parameters:
	169	# First one is the command to execute,
	170	# Second one is the pattern to match for a PASS,
	171	# Third one is an optional message to be printed. If this
	172	# a null string "", then the pass/fail messages are not printed.
	173	# Returns:
	174	# 1 if the test failed,
	175	# 0 if the test passes,
	176	# -1 if there was an internal error.
	177	#
	178	proc gdb_test { args } {
	179	global verbose
	180	global prompt
	181	global GDB
	182	global spawn_id
	183
	184	if [llength $args]==3 then {
	185	set message [lindex $args 2]
	186	} else {
	187	set message [lindex $args 0]
	188	}
	189	set command [lindex $args 0]
	190	set pattern [lindex $args 1]
	191
	192	if $verbose>2 then {
	193	send_user "Sending \"$command\" to gdb\n"
	194	send_user "Looking to match \"$pattern\"\n"
	195	send_user "Message is \"$message\"\n"
	196	}
	197
	198	set result -1
	199	set errmess ""
	200	# trap the send so any problems don't crash things
	201	catch "send \"$command\n\"" errmess
9bcc6c3f	202	if [string match "write.spawn_id=\[0-9\]+.:" $errmess] then {
85174909	203	perror "sent \"$command\" got expect error \"$errmess\""
c79f61db RS	204	catch "close"
c79f61db RS	205	gdb_start
19fa4a0a MW	206	return -1
	207	}
	208
	209	expect {
	210	-re ".Ending remote debugging.$prompt$" {
	211	if ![isnative] then {
	212	warning "Can`t communicate to remote target."
	213	}
	214	gdb_exit
	215	gdb_start
	216	set result -1
	217	}
	218	-re "$pattern.*$prompt $" {
	219	if ![string match "" $message] then {
	220	pass "$message"
	221	}
	222	set result 0
	223	}
	224	-re "Undefined command:.*$prompt" {
85174909	225	perror "Undefined command \"$command\"."
c79f61db	226	set result 1
19fa4a0a MW	227	}
19fa4a0a MW	228	-re "Ambiguous command.*$prompt $" {
85174909	229	perror "\"$command\" is not a unique command name."
c79f61db	230	set result 1
19fa4a0a MW	231	}
	232	-re ".*$prompt $" {
	233	if ![string match "" $message] then {
	234	fail "$message"
	235	}
	236	set result 1
	237	}
	238	"<return>" {
	239	send "\n"
85174909	240	perror "Window too small."
19fa4a0a	241	}
9bcc6c3f	242	-re "\[(\]+y or n\[)\]+ " {
19fa4a0a	243	send "n\n"
85174909	244	perror "Got interactive prompt."
19fa4a0a	245	}
c79f61db	246	eof {
85174909	247	perror "Process no longer exists"
c79f61db RS	248	return -1
c79f61db RS	249	}
19fa4a0a	250	buffer_full {
85174909	251	perror "internal buffer is full."
19fa4a0a	252	}
19fa4a0a MW	253	timeout {
	254	fail "(timeout) $message"
	255	set result 1
	256	}
	257	}
	258	return $result
	259	}
	260
19fa4a0a MW	261	proc gdb_reinitialize_dir { subdir } {
19fa4a0a MW	262	global prompt
19fa4a0a	263
85174909	264	send "dir\n"
19fa4a0a MW	265	expect {
	266	-re "Reinitialize source path to empty.*" {
	267	send "y\n"
	268	expect {
	269	-re "Source directories searched.*$prompt $" {
	270	send "dir $subdir\n"
	271	expect {
	272	-re "Source directories searched.*$prompt $" {
85174909	273	verbose "Dir set to $subdir"
19fa4a0a MW	274	}
19fa4a0a MW	275	-re ".*$prompt $" {
85174909	276	perror "Dir \"$subdir\" failed."
19fa4a0a MW	277	}
	278	}
	279	}
	280	-re ".*$prompt $" {
85174909	281	perror "Dir \"$subdir\" failed."
19fa4a0a MW	282	}
	283	}
	284	}
	285	-re ".*$prompt $" {
85174909	286	perror "Dir \"$subdir\" failed."
19fa4a0a MW	287	}
	288	}
	289	}
c79f61db	290
c79f61db RS	291	#
	292	# gdb_exit -- exit the GDB, killing the target program if necessary
	293	#
	294	proc default_gdb_exit {} {
	295	global GDB
	296	global GDBFLAGS
	297	global verbose
	298
002cc99f	299	verbose "Quitting $GDB $GDBFLAGS"
c79f61db RS	300
	301	# This used to be 1 for unix-gdb.exp
	302	set timeout 5
	303
2f109983 BC	304	# this will kill the gdb process, it's cleaner than sending a quit.
	305	close
	306
	307	# Before this was here sometimes "uit" would get sent to the next GDB
	308	# (assuming this is immediately followed by gdb_start), which would
	309	# cause a loss of syncronization (i.e. all the stuff that swallows a
	310	# prompt would swallow the wrong one).
c79f61db RS	311	wait
	312	}
	313
85174909 RS	314	#
	315	# gdb_load -- load a file into the debugger.
	316	# return a -1 if anything goes wrong.
	317	#
	318	proc gdb_file_cmd { arg } {
	319	global verbose
	320	global loadpath
	321	global loadfile
	322	global GDB
	323	global prompt
9bcc6c3f	324	global spawn_id
85174909 RS	325
	326	send "file $arg\n"
	327	expect {
	328	-re "Reading symbols from.done.$prompt $" {
	329	verbose "\t\tLoaded $arg into the $GDB"
	330	return 0
	331	}
	332	-re "has no symbol-table.*$prompt $" {
	333	perror "$arg wasn't compiled with \"-g\""
	334	return -1
	335	}
9bcc6c3f	336	-re "A program is being debugged already.Kill it.y or n. $" {
85174909 RS	337	send "y\n"
85174909 RS	338	verbose "\t\tKilling previous program being debugged"
9bcc6c3f	339	exp_continue
85174909	340	}
9bcc6c3f	341	-re "Load new symbol table from \".\".y or n. $" {
85174909 RS	342	send "y\n"
	343	expect {
	344	-re "Reading symbols from.done.$prompt $" {
	345	verbose "\t\tLoaded $arg with new symbol table into $GDB"
	346	return 0
	347	}
	348	timeout {
	349	perror "(timeout) Couldn't load $arg, other program already l
	350	oaded."
	351	return -1
	352	}
	353	}
	354	}
	355	-re ".No such file or directory.$prompt $" {
	356	perror "($arg) No such file or directory\n"
	357	return -1
	358	}
	359	-re "$prompt $" {
	360	perror "couldn't load $arg into $GDB."
	361	return -1
	362	}
	363	timeout {
9bcc6c3f	364	perror "couldn't load $arg into $GDB (timed out)."
85174909 RS	365	return -1
	366	}
	367	eof {
	368	# This is an attempt to detect a core dump, but seems not to
	369	# work. Perhaps we need to match .* followed by eof, in which
	370	# expect does not seem to have a way to do that.
8f07e537	371	perror "couldn't load $arg into $GDB (end of file)."
85174909 RS	372	return -1
	373	}
	374	}
	375	}
c79f61db	376
2f109983 BC	377
	378	#
	379	# start gdb -- start gdb running
	380	#
	381	proc default_gdb_start { } {
	382	global verbose
	383	global GDB
	384	global GDBFLAGS
	385	global prompt
	386	global spawn_id
	387	global timeout
	388	verbose "Spawning $GDB $GDBFLAGS"
	389
	390	set oldtimeout $timeout
	391	set timeout [expr "$timeout + 60"]
	392	if [ llength $GDBFLAGS ] then {
	393	if {[which $GDB] != 0} then {
	394	spawn $GDB $GDBFLAGS
	395	} else {
	396	perror "$GDB does not exist."
	397	exit 1
	398	}
	399	} else {
	400	if {[which $GDB] != 0} then {
	401	spawn $GDB
	402	} else {
	403	perror "$GDB does not exist."
	404	exit 1
	405	}
	406	}
	407	expect {
	408	-re ".*\r\n$prompt $" {
	409	verbose "GDB initialized for native mode"
	410	}
	411	-re "$prompt $" {
	412	perror "GDB never initialized."
	413	return -1
	414	}
	415	timeout {
	416	perror "(timeout) GDB never initialized."
	417	return -1
	418	}
	419	}
	420	set timeout $oldtimeout
	421	# force the height to "unlimited", so no pagers get used
	422	send "set height 0\n"
	423	expect {
	424	-re ".*$prompt $" {
	425	verbose "Setting height to 0." 2
	426	}
	427	timeout {
	428	warning "Couldn't set the height to 0."
	429	}
	430	}
	431	# force the width to "unlimited", so no wraparound occurs
	432	send "set width 0\n"
	433	expect {
	434	-re ".*$prompt $" {
	435	verbose "Setting width to 0." 2
	436	}
	437	timeout {
	438	warning "Couldn't set the width to 0."
	439	}
	440	}
441	}
442
9bcc6c3f RS	443	#
	444	# FIXME: this is a copy of the new library procedure, but it's here too
	445	# till the new dejagnu gets installed everywhere. I'd hate to break the
	446	# gdb tests suite.
	447	#
002cc99f RS	448	global argv0
002cc99f RS	449	if ![info exists argv0] then {
9bcc6c3f RS	450	proc exp_continue { } {
	451	continue -expect
	452	}
	453	}
c79f61db RS	454
c79f61db RS	455