From e7bb6998a64684a72f4f8ff53809d85c67172cd8 Mon Sep 17 00:00:00 2001 From: dgp Date: Sun, 22 Sep 2002 18:19:25 +0000 Subject: * library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also corrected reporting of body return code. Thanks to David Taback [Bug 611922] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.1. * tests/tcltest.test: added tests for these bugs. --- ChangeLog | 3 +++ library/tcltest/tcltest.tcl | 6 +++--- tests/tcltest.test | 18 +++++++++++++++++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4ce356b..15e19cc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,7 +2,10 @@ * library/tcltest/tcltest.tcl: Corrected [puts -nonewline] within test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] + Also corrected reporting of body return code. Thanks to David + Taback [Bug 611922] * library/tcltest/pkgIndex.tcl: Bump to version 2.2.1. + * tests/tcltest.test: added tests for these bugs. 2002-09-15 Mo DeJong diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 400e50d..bc912f0 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.74 2002/09/22 17:55:38 dgp Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.75 2002/09/22 18:19:26 dgp Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { @@ -2017,7 +2017,7 @@ proc tcltest::test {name description args} { } } if {$codeFailure} { - switch -- $code { + switch -- $returnCode { 0 { set msg "Test completed normally" } 1 { set msg "Test generated error" } 2 { set msg "Test generated return exception" } @@ -2025,7 +2025,7 @@ proc tcltest::test {name description args} { 4 { set msg "Test generated continue exception" } default { set msg "Test generated exception" } } - puts [outputChannel] "---- $msg; Return code was: $code" + puts [outputChannel] "---- $msg; Return code was: $returnCode" puts [outputChannel] "---- Return code should have been\ one of: $returnCodes" if {[IsVerbose error]} { diff --git a/tests/tcltest.test b/tests/tcltest.test index dd03458..0c0edbc 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,7 +6,7 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.34 2002/09/06 15:10:32 rmax Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.35 2002/09/22 18:19:26 dgp Exp $ # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup @@ -1686,6 +1686,22 @@ test tcltest-25.1 { unset foo } -result 0 +test tcltest-25.2 { + puts -nonewline (Bug 612786) +} -body { + puts -nonewline stdout bla + puts -nonewline stdout bla +} -output {blabla} + +test tcltest-25.3 { + reported return code (Bug 611922) +} -body { + # Buggy tcltest will generate result of 2 + test tcltest-25.3.0 {} -body { + error foo + } +} -match glob -output {*generated error; Return code was: 1*} + cleanupTests } -- cgit v0.12