* Revised [tcltest::test] to return errors

        when called with invalid syntax and to accept exactly two arguments
        as documented.  Improved error messages.  [Bug 497446, Patch 513983]
        ***POTENTIAL INCOMPATIBILITY***: Incompatible with previous
        tcltest 2.* releases, found only in alpha releases of Tcl 8.4.

4 files changed, 60 insertions, 53 deletions

diff --git a/ChangeLog b/ChangeLog
index 0cd2f0d..48da8a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2002-04-15  Don Porter  <dgp@users.sourceforge.net>
+
+	* doc/tcltest.n:
+	* library/tcltest/tcltest.tcl:
+	* tests/tcltest.test:  Revised [tcltest::test] to return errors
+	when called with invalid syntax and to accept exactly two arguments
+	as documented.  Improved error messages.  [Bug 497446, Patch 513983]
+	***POTENTIAL INCOMPATIBILITY***: Incompatible with previous
+	tcltest 2.* releases, found only in alpha releases of Tcl 8.4.
+
 2002-04-11  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* generic/tclNotify.c (TclFinalizeNotifier): remove remaining
diff --git a/doc/tcltest.n b/doc/tcltest.n
index 9996f48..dff7100 100644
--- a/doc/tcltest.n
+++ b/doc/tcltest.n
@@ -7,7 +7,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: tcltest.n,v 1.14 2002/03/27 08:19:57 dgp Exp $
+'\" RCS: @(#) $Id: tcltest.n,v 1.15 2002/04/15 17:04:29 dgp Exp $
 '\" 
 .so man.macros
 .TH "tcltest" n 8.4 Tcl "Tcl Built-In Commands"
@@ -120,12 +120,11 @@ section \fI"How to Customize the Test Harness"\fR.
 The \fBtcltest::test\fR command runs the value supplied for attribute
 \fIscript\fR and compares its result to possible results.  
 It prints an error message if actual results and expected results do
-not match.  The \fBtcltest::test\fR command returns 0 if it completes
-successfully. Any other return value indicates that an error has
-occurred in the tcltest package.  See the \fI"Tests"\fR section for
-more details on this command.   
+not match, or if an error occurs during evaluation of the \fIscript\fR.
+The \fBtcltest::test\fR command returns an empty string.  See the
+\fI"Tests"\fR section for more details on this command.   
 .TP
-\fBtcltest::cleanupTests\fR \fI?runningMultipleTests?\fR
+\fBtcltest::cleanupTests\fR \fI?calledFromAllFile?\fR
 This command should be called at the end of a test file.  It prints
 statistics about the tests run and removes files that were created by
 \fBtcltest::makeDirectory\fR and \fBtcltest::makeFile\fR.  Names
@@ -133,11 +132,12 @@ of files and directories created outside of
 \fBtcltest::makeFile\fR and \fBtcltest::makeDirectory\fR and
 never deleted are printed to \fBtcltest::outputChannel\fR.  This command
 also restores the original shell environment, as described by the ::env
-array. \fIcalledFromAll\fR should be specified if
+array. \fIcalledFromAllFile\fR should be specified as a true value if
 \fBtcltest::cleanupTests\fR is called explicitly from an "all.tcl"
-file.  Tcl files files are generally used to run multiple tests.  For
+file.  Tcl files are generally used to run multiple tests.  The
+\fBtcltest::cleanupTests\fR command returns an empty string.  For
 more details on how to run multiple tests, please see the section
-\fI"Running test files"\fR.  This proc has no defined return value.
+\fI"Running test files"\fR.  
 .TP
 \fBtcltest::runAllTests\fR
 This command should be used in your 'all.tcl' file.  It is used to
@@ -504,11 +504,11 @@ run will be compared.  Note that only output printed using
 puts is used for comparison.  If \fIoutput\fR is not specified, output
 sent to stdout and tcltest::outputChannel is not processed for comparison.
 .TP
-\fB-errorOutut \fIexpectedValue\fR
+\fB-errorOutput \fIexpectedValue\fR
 The \fIerrorOutput\fR attribute supplies the comparison value with which
 any output sent to stderr or tcltest::errorChannel during the script
 run will be compared. Note that only output printed using
-puts is used for comparison.  If \fIerrorOutut\fR is not specified, output
+puts is used for comparison.  If \fIerrorOutput\fR is not specified, output
 sent to stderr and tcltest::errorChannel is not processed for comparison.
 .TP
 \fB-returnCodes \fIexpectedCodeList\fR
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index ee56e7a..d2535be 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -15,7 +15,7 @@
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.tcl,v 1.47 2002/04/08 18:35:51 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.48 2002/04/15 17:04:29 dgp Exp $
 
 # create the "tcltest" namespace for all testing variables and
 # procedures
@@ -1823,10 +1823,10 @@ proc tcltest::SubstArguments {argList} {
 #  		  	help humans understand what it does.
 #
 # Results:
-#	0 if the command ran successfully; 1 otherwise.
+#	None.
 #
 # Side effects:
-#       None.
+#       Just about anything is possible depending on the test.
 #
 
 proc tcltest::test {name description args} {
@@ -1854,13 +1854,8 @@ proc tcltest::test {name description args} {
 
     # The old test format can't have a 3rd argument (constraints or
     # script) that starts with '-'.
-    if {[llength $args] == 0} {
-	puts [errorChannel] "test $name: {wrong # args:\
-		should be \"test name desc ?options?\"}"
-	incr testLevel -1
-	return 1
-    } elseif {[string match -* [lindex $args 0]]
-	    || ([llength $args] == 1)} {
+    if {[string match -* [lindex $args 0]]
+	    || ([llength $args] <= 1)} {
 	if {[llength $args] == 1} {
 	    set list [SubstArguments [lindex $args 0]]
 	    foreach {element value} $list {
@@ -1882,10 +1877,11 @@ proc tcltest::test {name description args} {
 
 	foreach flag [array names testAttributes] {
 	    if {[lsearch -exact $validFlags $flag] == -1} {
-		puts [errorChannel] "test $name:\
-			bad flag $flag supplied to tcltest::test"
 		incr tcltest::testLevel -1
-		return 1
+		set sorted [lsort $validFlags]
+		set options [join [lrange $sorted 0 end-1] ", "]
+		append options ", or [lindex $sorted end]"
+		return -code error "bad option \"$flag\": must be $options"
 	    }
 	}
 
@@ -1896,10 +1892,9 @@ proc tcltest::test {name description args} {
 
 	# Check the values supplied for -match
 	if {[lsearch {regexp glob exact} $match] == -1} {
-	    puts [errorChannel] "test $name: {bad value for -match:\
-		    must be one of exact, glob, regexp}"
 	    incr tcltest::testLevel -1
-	    return 1
+	    return -code error "bad -match value \"$match\":\
+		    must be exact, glob, or regexp"
 	}
 
 	# Replace symbolic valies supplied for -returnCodes
@@ -1918,11 +1913,9 @@ proc tcltest::test {name description args} {
 	    set constraints [lindex $args 0]
 	    set body [lindex $args 1]
 	} else {
-	    puts [errorChannel] "test $name: {wrong # args:\
-		    should be \"test name desc ?constraints?\
-		    script expectedResult\"}"
 	    incr tcltest::testLevel -1
-	    return 1
+	    return -code error "wrong # args:\
+		    should be \"test name desc ?options?\""
 	}
     }
 
@@ -2107,7 +2100,7 @@ proc tcltest::test {name description args} {
     }
 
     incr testLevel -1
-    return 0
+    return
 }
 
 
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 8de5bcf..1078268 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.18 2002/03/27 08:19:57 dgp Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.19 2002/04/15 17:04:29 dgp Exp $
 
 set tcltestVersion [package require tcltest]
 namespace import -force ::tcltest::*
@@ -1026,6 +1026,10 @@ test tcltest-20.1 {PrintError} {unixOrPc} {
 } {1 1 1 1 1 1}
 
 # test::test
+test tcltest-21.0 {name and desc but no args specified} -body {
+   test foo bar
+} -result {}
+
 test tcltest-21.1 {expect with glob} {
     -body {
 	list a b c d e
@@ -1040,9 +1044,8 @@ test tcltest-21.2 {force a test command failure} {
 	    return 2
 	} {1}
     }
-    -errorOutput {^test foo: bad flag 1 supplied to tcltest::test\n$}
-    -result {1}
-    -match regexp
+    -returnCodes 1
+    -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
 }
 
 test tcltest-21.3 {test command with setup} {
@@ -1067,7 +1070,7 @@ test tcltest-21.4 {test command with cleanup failure} {
 	    -cleanup {unset foo}
 	}
     }
-    -result {^0$}
+    -result {^$}
     -match regexp
     -output "Test cleanup failed:.*can't unset \"foo\": no such variable"
 }
@@ -1083,7 +1086,7 @@ test tcltest-21.5 {test command with setup failure} {
 	    -setup {unset foo}
 	}
     }
-    -result {^0$}
+    -result {^$}
     -match regexp
     -output "Test setup failed:.*can't unset \"foo\": no such variable"
 }
@@ -1112,36 +1115,37 @@ test tcltest-21.6 {test command - setup occurs before cleanup & before script} {
 	    -result {$expected}
 	}
     }
-    -result {^0$}
+    -result {^$}
     -match regexp
     -output "foo is 2"
 }
 
 test tcltest-21.7 {test command - bad flag} {
-     -body {
+    -body {
 	test foo-4 {foo-4} {
 	    -foobar {}
 	}
     }
-    -result {1}
-    -errorOutput {test foo-4: bad flag -foobar supplied to tcltest::test*}
-    -match glob
+    -returnCodes 1
+    -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
 }
 
 # alternate test command format (these are the same as 21.1-21.6, with the
 # exception of being in the all-inline format)
 
-test tcltest-21.7 {expect with glob} \
+test tcltest-21.7a {expect with glob} \
 	-body {list a b c d e} \
 	-result {[ab] b c d e} \
 	-match glob
 
-test tcltest-21.8 {force a test command failure} -body {
-    test foo {
-	return 2
-    } {1}
-} -errorOutput {test foo: bad flag 1 supplied to tcltest::test
-} -result {1}
+test tcltest-21.8 {force a test command failure} \
+    -body {
+        test foo {
+            return 2
+        } {1}
+    } \
+    -returnCodes 1 \
+    -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
 
 test tcltest-21.9 {test command with setup} \
 	-setup {set foo 1} \
@@ -1155,7 +1159,7 @@ test tcltest-21.10 {test command with cleanup failure} -setup {
     }
 } -body {
     test foo-1 {foo-1} -cleanup {unset foo}
-} -result {^0$} -match regexp \
+} -result {^$} -match regexp \
 	-output {Test cleanup failed:.*can't unset \"foo\": no such variable}
 
 test tcltest-21.11 {test command with setup failure} -setup {
@@ -1164,7 +1168,7 @@ test tcltest-21.11 {test command with setup failure} -setup {
     }
 } -body {
     test foo-2 {foo-2} -setup {unset foo}
-} -result {^0$} -output {Test setup failed:.*can't unset \"foo\": no such variable} -match regexp
+} -result {^$} -output {Test setup failed:.*can't unset \"foo\": no such variable} -match regexp
 
 test tcltest-21.12 {test command - setup occurs before cleanup & before script} -body {
     test foo-3 {foo-3} -setup {
@@ -1183,7 +1187,7 @@ test tcltest-21.12 {test command - setup occurs before cleanup & before script}
 	    puts [tcltest::outputChannel] "foo is 2"
 	}
     }  -result {$expected}
-} -result {^0$} -output {foo is 2} -match regexp
+} -result {^$} -output {foo is 2} -match regexp
 
 # test all.tcl usage (runAllTests); simulate .test file failure, as well as
 # crashes to determine whether or not these errors are logged.