summaryrefslogtreecommitdiffstats
path: root/library/tcltest
diff options
context:
space:
mode:
Diffstat (limited to 'library/tcltest')
-rw-r--r--library/tcltest/tcltest.tcl20
1 files changed, 10 insertions, 10 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 4b7bf67..43ca8e7 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -16,7 +16,7 @@
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.tcl,v 1.78.2.1 2003/03/26 22:56:09 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.78.2.2 2003/04/21 20:41:55 dgp Exp $
package require Tcl 8.3 ;# uses [glob -directory]
namespace eval tcltest {
@@ -2009,11 +2009,17 @@ proc tcltest::test {name description args} {
}
}
+ # check if the return code matched the expected return code
+ set codeFailure 0
+ if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} {
+ set codeFailure 1
+ }
+
# If expected output/error strings exist, we have to compare
# them. If the comparison fails, then so did the test.
set outputFailure 0
variable outData
- if {[info exists output]} {
+ if {[info exists output] && !$codeFailure} {
if {[set outputCompare [catch {
CompareStrings $outData $output $match
} outputMatch]] == 0} {
@@ -2025,7 +2031,7 @@ proc tcltest::test {name description args} {
set errorFailure 0
variable errData
- if {[info exists errorOutput]} {
+ if {[info exists errorOutput] && !$codeFailure} {
if {[set errorCompare [catch {
CompareStrings $errData $errorOutput $match
} errorMatch]] == 0} {
@@ -2035,15 +2041,9 @@ proc tcltest::test {name description args} {
}
}
- # check if the return code matched the expected return code
- set codeFailure 0
- if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} {
- set codeFailure 1
- }
-
# check if the answer matched the expected answer
# Only check if we ran the body of the test (no setup failure)
- if {$setupFailure} {
+ if {$setupFailure || $codeFailure} {
set scriptFailure 0
} elseif {[set scriptCompare [catch {
CompareStrings $actualAnswer $result $match