diff options
| author | dgp <dgp@users.sourceforge.net> | 2003-04-21 20:41:53 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2003-04-21 20:41:53 (GMT) |
| commit | 18cd8fbc6f64e08f50f389af9201c9fbd4498b3b (patch) | |
| tree | 8b2340da1ac10e12dc879615574acec01444bb86 /library/tcltest | |
| parent | 8eca645a8d81346e1c4d39a5868058c4c0a92e35 (diff) | |
| download | tcl-18cd8fbc6f64e08f50f389af9201c9fbd4498b3b.zip tcl-18cd8fbc6f64e08f50f389af9201c9fbd4498b3b.tar.gz tcl-18cd8fbc6f64e08f50f389af9201c9fbd4498b3b.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/tcltest')
| -rw-r--r-- | library/tcltest/tcltest.tcl | 20 |
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 |