X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Ftestsuite%2Flib%2Fgdb.exp;h=c7990d1c7f5d50f7374d9b35c1002d2d8ea6d66d;hb=930764990dffdc53fe322f7db4ac952fd5d0446f;hp=64ccaa9362b0d2d2fe64b63261937347b6ff2c7c;hpb=11cf87416416e13eff634a70b4954fe6a3912720;p=deliverable%2Fbinutils-gdb.git

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 64ccaa9362..c7990d1c7f 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -63,6 +63,16 @@ if ![info exists gdb_prompt] then {
     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.
 
 #
@@ -335,6 +345,31 @@ proc runto_main { } {
 }
 
 
+### 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
@@ -901,13 +936,13 @@ proc get_compiler_info {binfile args} {
     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;
 	    }
@@ -916,7 +951,7 @@ proc get_compiler_info {binfile args} {
 	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;
@@ -924,7 +959,7 @@ proc get_compiler_info {binfile args} {
 	    }
 	} 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;
@@ -1164,7 +1199,7 @@ proc gdb_expect { args } {
     }
 }
 
-# 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.
@@ -1177,7 +1212,7 @@ proc gdb_expect { args } {
 #    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
@@ -1191,16 +1226,20 @@ proc gdb_expect_list {test sentinal list} {
 	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} } {
@@ -1208,7 +1247,7 @@ proc gdb_expect_list {test sentinal list} {
 		    -re "${pattern}" {
 			pass "${test}, pattern ${index}"
 		    }
-		    -re "${sentinal}" {
+		    -re "${sentinel}" {
 			fail "${test}, pattern ${index}"
 			set ok 0
 		    }
@@ -1218,7 +1257,7 @@ proc gdb_expect_list {test sentinal list} {
 		    }
 		}
 	    } else {
-		fail "${test}, pattern ${index}"
+		unresolved "${test}, pattern ${index}"
 	    }
 	}
     }
@@ -1555,3 +1594,133 @@ proc rerun_to_main {} {
   }
 }
 
+# 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;
+}
+