From b44d851b88a7e6f142dfcb38b06b587780415794 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 21 Apr 2003 20:42:21 +0000
Subject:         * 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]

---
 ChangeLog                   |  7 +++++++
 library/tcltest/tcltest.tcl | 20 ++++++++++----------
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8597ab4..f4ca8d3 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>
 
 	* win/tclWinInt.h (VER_PLATFORM_WIN32_CE): conditionally define.
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
-- 
cgit v0.12