set gdb_prompt "\[(\]gdb\[)\]"
}
+# Needed for some tests under Cygwin.
+global EXEEXT
+global env
+
+if ![info exists env(EXEEXT)] {
+ set EXEEXT ""
+} else {
+ set EXEEXT $env(EXEEXT)
+}
+
### Only procedures should come after this point.
#
}
+### Continue, and expect to hit a breakpoint.
+### Report a pass or fail, depending on whether it seems to have
+### worked. Use NAME as part of the test name; each call to
+### continue_to_breakpoint should use a NAME which is unique within
+### that test file.
+proc gdb_continue_to_breakpoint {name} {
+ global gdb_prompt
+ set full_name "continue to breakpoint: $name"
+
+ send_gdb "continue\n"
+ gdb_expect {
+ -re "Breakpoint .* at .*\r\n$gdb_prompt $" {
+ pass $full_name
+ }
+ -re ".*$gdb_prompt $" {
+ fail $full_name
+ }
+ timeout {
+ fail "$full_name (timeout)"
+ }
+ }
+}
+
+
+
# gdb_test COMMAND PATTERN MESSAGE -- send a command to gdb; test the result.
#
# COMMAND is the command to execute, send to GDB with send_gdb. If
if {![istarget "hppa*-*-hpux*"]} {
if { [llength $args] > 0 } {
if {$args == "c++"} {
- if { [gdb_compile "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci" preprocess {}] != "" } {
+ if { [gdb_compile "${srcdir}/lib/compiler.cc" "${binfile}.ci" preprocess {}] != "" } {
perror "Couldn't make ${binfile}.ci file"
return 1;
}
}
} else {
- if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
+ if { [gdb_compile "${srcdir}/lib/compiler.c" "${binfile}.ci" preprocess {}] != "" } {
perror "Couldn't make ${binfile}.ci file"
return 1;
}
if { [llength $args] > 0 } {
if {$args == "c++"} {
if { [eval gdb_preprocess \
- [list "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci"] \
+ [list "${srcdir}/lib/compiler.cc" "${binfile}.ci"] \
$args] != "" } {
perror "Couldn't make ${binfile}.ci file"
return 1;
}
} elseif { $args != "f77" } {
if { [eval gdb_preprocess \
- [list "${srcdir}/${subdir}/compiler.c" "${binfile}.ci"] \
+ [list "${srcdir}/lib/compiler.c" "${binfile}.ci"] \
$args] != "" } {
perror "Couldn't make ${binfile}.ci file"
return 1;
}
}
-# gdb_expect_list MESSAGE SENTINAL LIST -- expect a sequence of outputs
+# gdb_expect_list MESSAGE SENTINEL LIST -- expect a sequence of outputs
#
# Check for long sequence of output by parts.
# MESSAGE: is the test message to be printed with the test success/fail.
# 0 if the test passes,
# -1 if there was an internal error.
#
-proc gdb_expect_list {test sentinal list} {
+proc gdb_expect_list {test sentinel list} {
global gdb_prompt
global suppress_flag
set index 0
if { ${index} == [llength ${list}] } {
if { ${ok} } {
gdb_expect {
- -re "${pattern}${sentinal}" {
- pass "${test}, pattern ${index} + sentinal"
+ -re "${pattern}${sentinel}" {
+ pass "${test}, pattern ${index} + sentinel"
+ }
+ -re "${sentinel}" {
+ fail "${test}, pattern ${index} + sentinel"
+ set ok 0
}
timeout {
- fail "${test}, pattern ${index} + sentinal (timeout)"
+ fail "${test}, pattern ${index} + sentinel (timeout)"
set ok 0
}
}
} else {
- fail "${test}, pattern ${index} + sentinal"
+ unresolved "${test}, pattern ${index} + sentinel"
}
} else {
if { ${ok} } {
-re "${pattern}" {
pass "${test}, pattern ${index}"
}
- -re "${sentinal}" {
+ -re "${sentinel}" {
fail "${test}, pattern ${index}"
set ok 0
}
}
}
} else {
- fail "${test}, pattern ${index}"
+ unresolved "${test}, pattern ${index}"
}
}
}
}
}
+# From dejagnu:
+# srcdir = testsuite src dir (e.g., devo/gdb/testsuite)
+# objdir = testsuite obj dir (e.g., gdb/testsuite)
+# subdir = subdir of testsuite (e.g., gdb.gdbtk)
+#
+# To gdbtk:
+# env(DEFS)=the "defs" files (e.g., devo/gdb/testsuite/gdb.gdbtk/defs)
+# env(SRCDIR)=directory containing the test code (e.g., *.test)
+# env(OBJDIR)=directory which contains any executables
+# (e.g., gdb/testsuite/gdb.gdbtk)
+proc gdbtk_start {test} {
+ global verbose
+ global GDB
+ global GDBFLAGS
+ global env srcdir subdir objdir
+
+ gdb_stop_suppressing_tests;
+
+ verbose "Starting $GDB -nx -q --tclcommand=$test"
+
+ set real_test [which $test]
+ if {$real_test == 0} {
+ perror "$test is not found"
+ exit 1
+ }
+
+ if {![is_remote host]} {
+ if { [which $GDB] == 0 } {
+ perror "$GDB does not exist."
+ exit 1
+ }
+ }
+
+
+ set wd [pwd]
+ cd $srcdir
+ set abs_srcdir [pwd]
+ cd [file join $abs_srcdir .. gdbtk library]
+ set env(GDBTK_LIBRARY) [pwd]
+ cd [file join $abs_srcdir .. .. tcl library]
+ set env(TCL_LIBRARY) [pwd]
+ cd [file join $abs_srcdir .. .. tk library]
+ set env(TK_LIBRARY) [pwd]
+ cd [file join $abs_srcdir .. .. tix library]
+ set env(TIX_LIBRARY) [pwd]
+ cd [file join $abs_srcdir .. .. itcl itcl library]
+ set env(ITCL_LIBRARY) [pwd]
+ cd [file join .. $abs_srcdir .. .. libgui library]
+ set env(CYGNUS_GUI_LIBRARY) [pwd]
+ cd $wd
+ cd [file join $abs_srcdir $subdir]
+ set env(DEFS) [file join [pwd] defs]
+ cd $wd
+ cd [file join $objdir $subdir]
+ set env(OBJDIR) [pwd]
+ cd $wd
+
+ set env(SRCDIR) $abs_srcdir
+ set env(GDBTK_VERBOSE) 1
+ set env(GDBTK_LOGFILE) [file join $objdir gdb.log]
+ set env(GDBTK_TEST_RUNNING) 1
+ set err [catch {exec $GDB -nx -q --tclcommand=$test} res]
+ if { $err } {
+ perror "Execing $GDB failed: $res"
+ exit 1;
+ }
+ return $res
+}
+
+# gdbtk tests call this function to print out the results of the
+# tests. The argument is a proper list of lists of the form:
+# {status name description msg}. All of these things typically
+# come from the testsuite harness.
+proc gdbtk_analyze_results {results} {
+ foreach test $results {
+ set status [lindex $test 0]
+ set name [lindex $test 1]
+ set description [lindex $test 2]
+ set msg [lindex $test 3]
+
+ switch $status {
+ PASS {
+ pass "$description ($name)"
+ }
+
+ FAIL {
+ fail "$description ($name)"
+ }
+
+ ERROR {
+ perror "$name"
+ }
+
+ XFAIL {
+ xfail "$description ($name)"
+ }
+
+ XPASS {
+ xpass "$description ($name)"
+ }
+ }
+ }
+}
+
+# Print a message and return true if a test should be skipped
+# due to lack of floating point suport.
+
+proc gdb_skip_float_test { msg } {
+ if [target_info exists gdb,skip_float_tests] {
+ verbose "Skipping test '$msg': no float tests.";
+ return 1;
+ }
+ return 0;
+}
+
+# Print a message and return true if a test should be skipped
+# due to lack of stdio support.
+
+proc gdb_skip_stdio_test { msg } {
+ if [target_info exists gdb,noinferiorio] {
+ verbose "Skipping test '$msg': no inferior i/o.";
+ return 1;
+ }
+ return 0;
+}
+
+proc gdb_skip_bogus_test { msg } {
+ return 0;
+}
+
projects / deliverable / binutils-gdb.git / blobdiff