summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-04-21 20:42:21 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-04-21 20:42:21 (GMT)
commitb44d851b88a7e6f142dfcb38b06b587780415794 (patch)
tree46e32c1267cd1ba1604fe92aa81a33aa44caa087 /library
parent9a1cea83309c598fc6068ddeede9f7d9d165e76d (diff)
downloadtcl-b44d851b88a7e6f142dfcb38b06b587780415794.zip
tcl-b44d851b88a7e6f142dfcb38b06b587780415794.tar.gz
tcl-b44d851b88a7e6f142dfcb38b06b587780415794.tar.bz2
* 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]
Diffstat (limited to 'library')
-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 125ed67..f2151e9 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.80 2003/03/26 22:55:41 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.81 2003/04/21 20:42:23 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