diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-01-01 15:14:42 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-01-01 15:14:42 (GMT) |
commit | a6cdf257c61c62aa64357851af8f6e376b7f8881 (patch) | |
tree | 06031b0878fe01f3aa9ec4610a723046d9c4fe24 /tests/cmdMZ.test | |
parent | 52a3d5af143656324d78483b244f92addfbe6176 (diff) | |
download | tcl-a6cdf257c61c62aa64357851af8f6e376b7f8881.zip tcl-a6cdf257c61c62aa64357851af8f6e376b7f8881.tar.gz tcl-a6cdf257c61c62aa64357851af8f6e376b7f8881.tar.bz2 |
Clean up of tests and conversion to tcltest 2. Target has been to get init and
cleanup code out of the test body and into the -setup/-cleanup stanzas.
Diffstat (limited to 'tests/cmdMZ.test')
-rw-r--r-- | tests/cmdMZ.test | 58 |
1 files changed, 27 insertions, 31 deletions
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index c7f6e44..78bb329 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdMZ.test,v 1.30 2010/04/05 19:44:45 ferrieux Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.31 2011/01/01 15:14:43 dkf Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -38,7 +38,7 @@ namespace eval ::tcl::test::cmdMZ { return 1 } customMatch listGlob [namespace which ListGlobMatch] - + # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body { @@ -166,35 +166,31 @@ test cmdMZ-return-2.13 {return option handling} -body { test cmdMZ-return-2.14 {return option handling} -body { return -level 0 -code error -options {-code foo -options {-code break}} } -returnCodes break -result {} -test cmdMZ-return-2.15 {return opton handling} -setup { - proc p {} { - return -code error -errorcode {a b} c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} -test cmdMZ-return-2.16 {return opton handling} -setup { - proc p {} { - return -code error -errorcode [list a b] c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} -test cmdMZ-return-2.17 {return opton handling} -setup { - proc p {} { - return -code error -errorcode a\ b c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} +test cmdMZ-return-2.15 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode {a b} c + }} + } result] $result $::errorCode +} {1 c {a b}} +test cmdMZ-return-2.16 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode [list a b] c + }} + } result] $result $::errorCode +} {1 c {a b}} +test cmdMZ-return-2.17 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode a\ b c + }} + } result] $result $::errorCode +} {1 c {a b}} test cmdMZ-return-2.18 {return option handling} { - list [catch {return -code error -errorstack [list CALL a CALL b] yo} -> foo] [dictSort $foo] [info errorstack] + list [catch { + return -code error -errorstack [list CALL a CALL b] yo + } -> foo] [dictSort $foo] [info errorstack] } {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}} # Check that the result of a [return -options $opts $result] is @@ -349,7 +345,7 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { "time {error foo}"}} # The tests for Tcl_WhileObjCmd are in while.test - + # cleanup cleanupTests } |