Attachment "patch-2002-04-12" to
ticket [513983ffff]
added by
dgp
2002-04-12 23:38:43.
Index: doc/tcltest.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/tcltest.n,v
retrieving revision 1.14
diff -u -r1.14 tcltest.n
--- doc/tcltest.n 27 Mar 2002 08:19:57 -0000 1.14
+++ doc/tcltest.n 12 Apr 2002 16:35:35 -0000
@@ -120,12 +120,11 @@
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 @@
\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 @@
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
Index: library/tcltest/tcltest.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/tcltest/tcltest.tcl,v
retrieving revision 1.47
diff -u -r1.47 tcltest.tcl
--- library/tcltest/tcltest.tcl 8 Apr 2002 18:35:51 -0000 1.47
+++ library/tcltest/tcltest.tcl 12 Apr 2002 16:35:36 -0000
@@ -1823,10 +1823,10 @@
# 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 @@
# 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 @@
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 @@
# 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 @@
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 @@
}
incr testLevel -1
- return 0
+ return
}
Index: tests/tcltest.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tcltest.test,v
retrieving revision 1.18
diff -u -r1.18 tcltest.test
--- tests/tcltest.test 27 Mar 2002 08:19:57 -0000 1.18
+++ tests/tcltest.test 12 Apr 2002 16:35:37 -0000
@@ -1026,6 +1026,10 @@
} {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 @@
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 @@
-cleanup {unset foo}
}
}
- -result {^0$}
+ -result {^$}
-match regexp
-output "Test cleanup failed:.*can't unset \"foo\": no such variable"
}
@@ -1083,7 +1086,7 @@
-setup {unset foo}
}
}
- -result {^0$}
+ -result {^$}
-match regexp
-output "Test setup failed:.*can't unset \"foo\": no such variable"
}
@@ -1112,36 +1115,37 @@
-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 @@
}
} -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 @@
}
} -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 @@
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.
