diff options
Diffstat (limited to 'tests/switch.test')
-rw-r--r-- | tests/switch.test | 29 |
1 files changed, 23 insertions, 6 deletions
diff --git a/tests/switch.test b/tests/switch.test index f04f636..4d204bb 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -11,11 +11,11 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } - + test switch-1.1 {simple patterns} { switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 1 @@ -169,7 +169,7 @@ test switch-4.1 {error in executed command} { "switch a a {error "Just a test"} default {subst 1}"}} test switch-4.2 {error: not enough args} -returnCodes error -body { switch -} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"} +} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} test switch-4.3 {error: pattern with no body} -body { switch a b } -returnCodes error -result {extra switch pattern with no body} @@ -269,16 +269,16 @@ test switch-8.3 {weird body text, variable} { test switch-9.1 {empty pattern/body list} -returnCodes error -body { switch x -} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"} +} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} test switch-9.2 {unpaired pattern} -returnCodes error -body { switch -- x } -result {extra switch pattern with no body} test switch-9.3 {empty pattern/body list} -body { switch x {} -} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"} +} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} test switch-9.4 {empty pattern/body list} -body { switch -- x {} -} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"} +} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} test switch-9.5 {unpaired pattern} -body { switch x a {} b } -returnCodes error -result {extra switch pattern with no body} @@ -746,7 +746,24 @@ test switch-14.16 {switch -regexp compilation} { }} } no +test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{ + -body { + proc coro {} { + switch -glob a { + a {yield ok1} + } + return ok2 + } + list [coroutine c coro] [c] + } + -result {ok1 ok2} + -cleanup { + rename coro {} + } +} + # cleanup +catch {rename foo {}} ::tcltest::cleanupTests return |