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.
#
}
}
-# 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;
+}
+