summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--library/tcltest/tcltest.tcl20
2 files changed, 17 insertions, 10 deletions
diff --git a/ChangeLog b/ChangeLog
index 9ae51c2..b063674 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-04-21 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: When the return code of a test does
+ not meet expectations, report that as the reason for test failure,
+ and do not attempt to check the test result for correctness.
+ [Bug 725253]
+
2003-04-18 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclExecute.c (ExprCallMathFunc): remove incorrect
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