From f86515c4b7db350147a14758123c1578aa55211e Mon Sep 17 00:00:00 2001 From: Rob Savoye Date: Mon, 14 May 2001 15:48:24 +0000 Subject: [PATCH] * runtest.exp: Conditionally set the exit_status so we don't stomp on FAIL. Rearrange --status so it works correctly with --strace. --- ChangeLog | 5 +++++ runtest.exp | 23 +++++++++++++---------- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index f8289f0..548fd44 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2001-05-14 Rob Savoye + + * 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 * lib/target.exp: Fix the regsub line where it prunes -fPIC diff --git a/runtest.exp b/runtest.exp index 971b834..8f69a3e 100755 --- 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 -- 2.7.4