* runtest.exp: Conditionally set the exit_status so we don't stomp

	on FAIL. Rearrange --status so it works correctly with --strace.

diff --git a/ChangeLog b/ChangeLog
index f8289f0..548fd44 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2001-05-14  Rob Savoye  <rob@peggyo.welcomehome.org>
+
+       * runtest.exp: Conditionally set the exit_status so we don't stomp
+       on FAIL. Rearrange --status so it works correctly with --strace.
+
 2001-05-13  Rob Savoye  <rob@peggyo.welcomehome.org>
 
        * lib/target.exp: Fix the regsub line where it prunes -fPIC

diff --git a/runtest.exp b/runtest.exp
index 971b834..8f69a3e 100755 (executable)
--- a/runtest.exp
+++ b/runtest.exp
@@ -372,7 +372,7 @@ proc usage { } {
     send_user "\t--host \[string\]\t\tThe canonical config name of the host machine\n"
     send_user "\t--host_board \[name\]\tThe host board to use\n"
     send_user "\t--target \[string\]\tThe canonical config name of the target board\n"
-    send_user "\t--status (-st)\t\tSet the exit status to fail on Tcl errors\n"
+    send_user "\t--status (-sta)\t\tSet the exit status to fail on Tcl errors\n"
     send_user "\t--debug (-de)\t\tSet expect debugging ON\n"
     send_user "\t--help (-he)\t\tPrint help text\n"
     send_user "\t--mail \[name(s)\]\tWhom to mail the results to\n"
@@ -439,7 +439,7 @@ for { set i 0 } { $i < $argc } { incr i } {
        "--ob*" -
        "--ou*" -
        "--sr*" -
-       "--st*" -
+       "--str*" -
         "--ta*" -
        "--di*" -
        "--to*" {
@@ -469,11 +469,6 @@ for { set i 0 } { $i < $argc } { incr i } {
            continue
        }
 
-       "--st*" {
-           set exit_error 1
-           continue
-       }
-       
        "--sr*" {                       # (--srcdir) where the testsuite source code lives
            set srcdir $optarg
            continue
@@ -988,7 +983,7 @@ for { set i 0 } { $i < $argc } { incr i } {
        "--ob*" -
        "--ou*" -
        "--sr*" -
-       "--st*" -
+       "--str*" -
         "--ta*" -
        "--di*" -
        "--to*" {
@@ -1118,13 +1113,19 @@ for { set i 0 } { $i < $argc } { incr i } {
            continue
        }
        
-       "--st*" {                       # (--strace) expect trace level
+       "--str*" {                      # (--strace) expect trace level
            set tracelevel $optarg
            strace $tracelevel
            verbose "Source Trace level is now $tracelevel"
            continue
        }
        
+       "--sta*" {                      # (--status) exit status flag
+           set exit_error 1
+           verbose "Tcl errors will set an ERROR exit status"
+           continue
+       }
+       
        "--tool_opt*" {
            continue
        }
@@ -1442,7 +1443,9 @@ proc runtest { test_file_name } {
            # notices the error.
            global exit_status exit_error
            # exit error is set by a command line option
-           set exit_status $exit_error
+           if { $exit_status == 0 } {
+               set exit_status $exit_error
+           }
            # We can't call `perror' here, it resets `errorInfo'
            # before we want to look at it.  Also remember that perror
            # increments `errcnt'.  If we do call perror we'd have to