summaryrefslogtreecommitdiffstats
path: root/tests/switch.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/switch.test')
-rw-r--r--tests/switch.test57
1 files changed, 56 insertions, 1 deletions
diff --git a/tests/switch.test b/tests/switch.test
index e05f2ca..ed1d38a 100644
--- a/tests/switch.test
+++ b/tests/switch.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: switch.test,v 1.13 2005/06/01 11:00:35 dkf Exp $
+# RCS: @(#) $Id: switch.test,v 1.14 2005/06/20 07:49:12 mdejong Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -139,6 +139,34 @@ test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} {
}
} exact
+test switch-3.7 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -exa Foo Foo {set result OK}} msg] $msg
+} {0 OK}
+
+test switch-3.8 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -gl Foo Fo? {set result OK}} msg] $msg
+} {0 OK}
+
+test switch-3.9 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -re Foo Fo. {set result OK}} msg] $msg
+} {0 OK}
+
+test switch-3.10 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -exact -exact Foo Foo {set result OK}} msg] $msg
+} {1 {bad option "-exact": -exact option already found}}
+
+test switch-3.11 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -exact -glob Foo Foo {set result OK}} msg] $msg
+} {1 {bad option "-glob": -exact option already found}}
+
+test switch-3.12 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -glob -regexp Foo Foo {set result OK}} msg] $msg
+} {1 {bad option "-regexp": -glob option already found}}
+
+test switch-3.13 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -regexp -glob Foo Foo {set result OK}} msg] $msg
+} {1 {bad option "-glob": -regexp option already found}}
+
test switch-4.1 {error in executed command} {
list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
$msg $errorInfo
@@ -220,6 +248,15 @@ test switch-7.3 {"-" bodies} {
}
} msg] $msg
} {1 {no body specified for pattern "c"}}
+test switch-7.4 {"-" bodies} {
+ list [catch {
+ switch a {
+ a -
+ b -foo
+ c {}
+ }
+ } msg] $msg
+} {1 {invalid command name "-foo"}}
test switch-8.1 {empty body} {
set msg {}
@@ -230,6 +267,24 @@ test switch-8.1 {empty body} {
}
} {}
+proc test_switch_body {} {
+ return "INVOKED"
+}
+
+test switch-8.2 {weird body text, variable} {
+ set cmd {test_switch_body}
+ switch Foo {
+ Foo $cmd
+ }
+} {INVOKED}
+
+test switch-8.3 {weird body text, variable} {
+ set cmd {test_switch_body}
+ switch Foo {
+ Foo {$cmd}
+ }
+} {INVOKED}
+
test switch-9.1 {empty pattern/body list} {
list [catch {switch x} msg] $msg
} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}