Index: library/tcltest/pkgIndex.tcl =================================================================== RCS file: /cvsroot/tcl/tcl/library/tcltest/pkgIndex.tcl,v retrieving revision 1.9 diff -u -r1.9 pkgIndex.tcl --- library/tcltest/pkgIndex.tcl 11 Mar 2002 21:50:32 -0000 1.9 +++ library/tcltest/pkgIndex.tcl 10 Apr 2002 01:46:16 -0000 @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} -package ifneeded tcltest 2.0.2 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.0.3 [list source [file join $dir tcltest.tcl]] 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 10 Apr 2002 01:46:19 -0000 @@ -1823,7 +1823,7 @@ # help humans understand what it does. # # Results: -# 0 if the command ran successfully; 1 otherwise. +# 0 if the command ran successfully; otherwise it throws an error. # # Side effects: # None. @@ -1854,12 +1854,7 @@ # 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]] + if {[string match -* [lindex $args 0]] || ([llength $args] == 1)} { if {[llength $args] == 1} { set list [SubstArguments [lindex $args 0]] @@ -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?\"" } } @@ -3256,5 +3249,5 @@ unset file } -package provide tcltest 2.0.2 +package provide tcltest 2.0.3 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 10 Apr 2002 01:46:20 -0000 @@ -1040,9 +1040,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} { @@ -1118,30 +1117,31 @@ } 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} \