-# Copyright (C) 1992 Free Software Foundation, Inc.
+# Copyright (C) 1992, 1994, 1995 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
# 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 $base_dir/../gdb [transform gdb ]]
+}
+
+global GDBFLAGS
+if ![info exists GDBFLAGS] then {
+ set GDBFLAGS ""
+}
+
+# set the prompt if it doesn't exist
+global prompt
+if ![info exists prompt] then {
+ set prompt "\[(\]gdb\[)\]"
+}
+
#
-# gdb_version -- extract and print the version number of gcc
+# gdb_version -- extract and print the version number of GDB
#
proc default_gdb_version {} {
global GDB
global GDBFLAGS
if {[which $GDB] != 0} then {
- 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"
+ set tmp [exec echo "q" | $GDB -nw]
+ regexp " \[0-9\.\]+" $tmp version
+ clone_output "[which $GDB] version$version -nw $GDBFLAGS \n"
} else {
warning "$GDB does not exist"
}
global prompt
send "file\n"
expect {
- -re "No exec file now\.\r" { continue -expect }
- -re "No symbol file now\.\r" { continue -expect }
- -re "A program is being debugged already..*Kill it\? \(y or n\) $"\
+ -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"
- if $verbose>1 then {
- send_user "\t\tKilling previous program being debugged\n"
- }
- continue -expect
+ verbose "\t\tKilling previous program being debugged"
+ exp_continue
}
- -re "Discard symbol table from .*\? \(y or n\) $" {
+ -re "Discard symbol table from .*y or n. $" {
send "y\n"
- continue -expect
+ exp_continue
}
-re "$prompt $" {}
timeout {
- error "couldn't unload file in $GDB (timed out)."
+ perror "couldn't unload file in $GDB (timed out)."
return -1
}
}
send "delete breakpoints\n"
expect {
- -re "Delete all breakpoints\? \(y or n\) $" {
+ -re "Delete all breakpoints.*y or n. $" {
send "y\n"
- continue -expect
+ exp_continue
}
-re "y\r\n$prompt $" {}
- -re ".*$prompt $" { fail "Delete all breakpoints" ; return }
- timeout { fail "Delete all breakpoints (timeout)" ; return }
+ -re ".*$prompt $" { # This happens if there were no breakpoints
+ }
+ timeout { perror "Delete all breakpoints (timeout)" ; return }
}
send "info breakpoints\n"
expect {
-re "No breakpoints or watchpoints..*$prompt $" {}
- -re ".*$prompt $" { fail "breakpoints not deleted" ; return }
- timeout { fail "info breakpoints (timeout)" ; return }
+ -re ".*$prompt $" { perror "breakpoints not deleted" ; return }
+ timeout { perror "info breakpoints (timeout)" ; return }
}
}
#
+# Generic run command.
+#
+# The second pattern below matches up to the first newline *only*.
+# Using ``.*$'' could swallow up output that we attempt to match
+# elsewhere.
+#
+proc gdb_run_cmd {} {
+ send "run\n"
+ expect {
+ -re "The program .* has been started already.*y or n. $" {
+ send "y\n"
+ exp_continue
+ }
+ -re "Starting program: \[^\n\]*" {}
+ }
+}
+
+
# 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
send "delete\n"
expect {
- -re "Delete all breakpoints\? \(y or n\) $" {
+ -re "delete.*Delete all breakpoints.*y or n. $" {
send "y\n"
expect {
-re "$prompt $" {}
}
send "break $function\n"
- # The first regexp is what we get with -g, the second without -g.
+ # The first two regexps are what we get with -g, the third is without -g.
expect {
- -re "Break.* at .*: file .*, line $decimal.\r\n$prompt $" {}
- -re "Breakpoint \[0-9\]* at 0x\[0-9a-f\]*.*$prompt $" {}
+ -re "Breakpoint \[0-9\]* at .*: file .*, line $decimal.\r\n$prompt $" {}
+ -re "Breakpoint \[0-9\]*: file .*, line $decimal.\r\n$prompt $" {}
+ -re "Breakpoint \[0-9\]* at .*$prompt $" {}
-re "$prompt $" { fail "setting breakpoint at $function" ; return 0 }
timeout { fail "setting breakpoint at $function (timeout)" ; return 0 }
}
- send "run\n"
+ gdb_run_cmd
+
# 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"
- continue -expect
+ -re "Break.* at .*:$decimal.*$prompt $" {
+ return 1
}
- -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 }
+ -re "$prompt $" {
+ fail "running to $function"
+ return 0
+ }
+ timeout {
+ fail "running to $function (timeout)"
+ return 0
+ }
}
}
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 {
- error "sent \"$command\" got expect error \"$errmess\""
- catch "close"
- gdb_start
- return -1
+ if ![string match $command ""] {
+ # 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 {
set result 0
}
-re "Undefined command:.*$prompt" {
- error "Undefined command \"$command\"."
+ perror "Undefined command \"$command\"."
set result 1
}
-re "Ambiguous command.*$prompt $" {
- error "\"$command\" is not a unique command name."
+ perror "\"$command\" is not a unique command name."
set result 1
}
-re ".*$prompt $" {
}
"<return>" {
send "\n"
- error "Window too small."
+ perror "Window too small."
}
- -re "\(y or n\) " {
+ -re "\[(\]+y or n\[)\]+ " {
send "n\n"
- error "Got interactive prompt."
+ perror "Got interactive prompt."
}
eof {
- error "Process no longer exists"
+ perror "Process no longer exists"
return -1
}
buffer_full {
- error "internal buffer is full."
+ perror "internal buffer is full."
}
timeout {
- fail "(timeout) $message"
+ if ![string match "" $message] then {
+ fail "(timeout) $message"
+ }
set result 1
}
}
return $result
}
+\f
+# Testing printing of a specific value. For passes and fails, return
+# a 1 to indicate that more tests can proceed. However a timeout
+# is a serious error, generates a special fail message, and causes
+# a 0 to be returned to indicate that more tests are likely to fail
+# as well.
+#
+# Args are:
+#
+# First one is string to send to gdb
+# Second one is string to match gdb result to
+# Third one is an optional message to be printed
+#
+# This differs from gdb_test in a few ways: (1) no catch on the send (there is
+# no reason for this to be different from gdb_test but I think the lack of
+# catch is correct), (2) it tests for the " =" (that could easily be moved
+# to the callers, (3) the pattern must be followed by \r\n and the prompt,
+# not other garbage as in gdb_test (this feature seems kind of worthwhile).
-proc gdb_reinitialize_dir { subdir } {
+proc test_print_accept { args } {
global prompt
global verbose
- send "dir\n"
+ if [llength $args]==3 then {
+ set message [lindex $args 2]
+ } else {
+ set message [lindex $args 0]
+ }
+ set sendthis [lindex $args 0]
+ set expectthis [lindex $args 1]
+ if $verbose>2 then {
+ send_user "Sending \"$sendthis\" to gdb\n"
+ send_user "Looking to match \"$expectthis\"\n"
+ send_user "Message is \"$message\"\n"
+ }
+ send "$sendthis\n"
+ expect {
+ -re ".* = $expectthis\r\n$prompt $" {
+ if ![string match "" $message] then {
+ pass "$sendthis ($message)"
+ } else {
+ pass "$sendthis"
+ }
+ return 1
+ }
+ -re ".*$prompt $" {
+ if ![string match "" $message] then {
+ fail "$sendthis ($message)"
+ } else {
+ fail "$sendthis"
+ }
+ return 1
+ }
+ timeout {
+ fail "$sendthis (timeout)"
+ return 0
+ }
+ }
+}
+
+# Testing printing of a specific value. For pass or fail, return
+# a 1 to indicate that more tests can proceed. However a timeout
+# is a serious error, generates a special fail message, and causes
+# a 0 to be returned to indicate that more tests are likely to fail
+# as well.
+
+proc test_print_reject { args } {
+ global prompt
+ global verbose
+
+ if [llength $args]==2 then {
+ set expectthis [lindex $args 1]
+ } else {
+ set expectthis "should never match this bogus string"
+ }
+ set sendthis [lindex $args 0]
+ if $verbose>2 then {
+ send_user "Sending \"$sendthis\" to gdb\n"
+ send_user "Looking to match \"$expectthis\"\n"
+ }
+ send "$sendthis\n"
+ expect {
+ -re ".*A .* in expression.*\\.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*Invalid syntax in expression.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*Junk after end of expression.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*Invalid number.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*Invalid character constant.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*No symbol table is loaded.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*No symbol .* in current context.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*$expectthis.*$prompt $" {
+ pass "reject $sendthis"
+ return 1
+ }
+ -re ".*$prompt $" {
+ fail "reject $sendthis"
+ return 1
+ }
+ default {
+ fail "reject $sendthis (eof or timeout)"
+ return 0
+ }
+ }
+}
+\f
+# Given an input string, adds backslashes as needed to create a
+# regexp that will match the string.
+
+proc string_to_regexp {str} {
+ set result $str
+ regsub -all {[]*+.|()^$\[]} $str {\\&} result
+ return $result
+}
+
+# Same as gdb_test, but the second parameter is not a regexp,
+# but a string that must match exactly.
+
+proc gdb_test_exact { args } {
+ set command [lindex $args 0]
+ set pattern [string_to_regexp [lindex $args 1]]
+ if [llength $args]==3 then {
+ set message [lindex $args 2]
+ } else {
+ set message $command
+ }
+ return [gdb_test $command $pattern $message]
+}
+\f
+proc gdb_reinitialize_dir { subdir } {
+ global prompt
+
+ send "dir\n"
expect {
-re "Reinitialize source path to empty.*" {
send "y\n"
send "dir $subdir\n"
expect {
-re "Source directories searched.*$prompt $" {
- if $verbose>1 then {
- send_user "Dir set to $subdir\n"
- }
+ verbose "Dir set to $subdir"
}
-re ".*$prompt $" {
- error "Dir \"$subdir\" failed."
+ perror "Dir \"$subdir\" failed."
}
}
}
-re ".*$prompt $" {
- error "Dir \"$subdir\" failed."
+ perror "Dir \"$subdir\" failed."
}
}
}
-re ".*$prompt $" {
- error "Dir \"$subdir\" failed."
+ perror "Dir \"$subdir\" failed."
}
}
}
-
#
# gdb_exit -- exit the GDB, killing the target program if necessary
#
global GDBFLAGS
global verbose
- verbose "Quitting $GDB $GDBFLAGS" 1
+ verbose "Quitting $GDB $GDBFLAGS"
# This used to be 1 for unix-gdb.exp
set timeout 5
- catch "send \"quit\n\"" result
- # If the process has gone away (e.g. gdb dumped core), deal with it.
- if [string match "write\(spawn_id=\[0-9\]+\):" $result] then {
- catch "close"
- # FIXME: Shouldn't we call "wait" too?
- return -1
+ # We used to try to send "quit" to GDB, and wait for it to die.
+ # Dealing with all the cases and errors got pretty hairy. Just close it,
+ # that is simpler.
+ close
+
+ # Omitting this probably would cause strange timing-dependent failures.
+ 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
+ }
}
- # FIXME: What is this catch statement doing here? Won't it prevent us
- # from getting errors that we'd rather see?
- catch {
+}
+
+#
+# start gdb -- start gdb running, default procedure
+#
+proc default_gdb_start { } {
+ global verbose
+ global GDB
+ global GDBFLAGS
+ global prompt
+ global spawn_id
+ global timeout
+ verbose "Spawning $GDB -nw $GDBFLAGS"
+
+ if { [which $GDB] == 0 } then {
+ perror "$GDB does not exist."
+ exit 1
+ }
+
+ set oldtimeout $timeout
+ set timeout [expr "$timeout + 60"]
+ eval "spawn $GDB -nw $GDBFLAGS"
expect {
- eof {
- verbose "Got EOF from $GDB" 2
+ -re ".*\r\n$prompt $" {
+ verbose "GDB initialized."
}
- timeout {
- verbose "Got TIMEOUT from $GDB" 2
+ -re "$prompt $" {
+ perror "GDB never initialized."
+ return -1
}
- -re "The program is running. Quit anyway.*(y or n) $" {
- send "y\n"
- verbose "Killing program being debugged" 2
+ 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 "Seting width to 0." 2
+ }
+ timeout {
+ warning "Couldn't set the width to 0."
+ }
}
-
- # FIXME: Does the catch prevent us from getting errors that we'd rather
- # see? the old gdb_exit in unix-gdb.exp had "close" without catch
- # in the above expect statement (for the timeout and -re "The
- # program... cases) (as well as a catch "close" here).
- catch "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
}
-
+#
+# 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
+ }
+}
projects / deliverable / binutils-gdb.git / blobdiff