summaryrefslogtreecommitdiffstats
path: root/tests/switch.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/switch.test')
-rw-r--r--tests/switch.test179
1 files changed, 179 insertions, 0 deletions
diff --git a/tests/switch.test b/tests/switch.test
new file mode 100644
index 0000000..347e7a5
--- /dev/null
+++ b/tests/switch.test
@@ -0,0 +1,179 @@
+# Commands covered: switch
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) switch.test 1.7 97/02/10 17:27:13
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test switch-1.1 {simple patterns} {
+ switch a a {format 1} b {format 2} c {format 3} default {format 4}
+} 1
+test switch-1.2 {simple patterns} {
+ switch b a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.3 {simple patterns} {
+ switch x a {format 1} b {format 2} c {format 3} default {format 4}
+} 4
+test switch-1.4 {simple patterns} {
+ switch x a {format 1} b {format 2} c {format 3}
+} {}
+test switch-1.5 {simple pattern matches many times} {
+ switch b a {format 1} b {format 2} b {format 3} b {format 4}
+} 2
+test switch-1.6 {simple patterns} {
+ switch default a {format 1} default {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.7 {simple patterns} {
+ switch x a {format 1} default {format 2} c {format 3} default {format 4}
+} 4
+
+test switch-2.1 {single-argument form for pattern/command pairs} {
+ switch b {
+ a {format 1}
+ b {format 2}
+ default {format 6}
+ }
+} {2}
+test switch-2.2 {single-argument form for pattern/command pairs} {
+ list [catch {switch z {a 2 b}} msg] $msg
+} {1 {extra switch pattern with no body}}
+
+test switch-3.1 {-exact vs. -glob vs. -regexp} {
+ switch -exact aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} exact
+test switch-3.2 {-exact vs. -glob vs. -regexp} {
+ switch -exact -regexp aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} regexp
+test switch-3.3 {-exact vs. -glob vs. -regexp} {
+ switch -glob aaaab {
+ ^a*b$ {concat regexp}
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }
+} glob
+test switch-3.4 {-exact vs. -glob vs. -regexp} {
+ switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
+ aaaab {concat exact} default {concat none}
+} exact
+test switch-3.5 {-exact vs. -glob vs. -regexp} {
+ switch -- -glob {
+ ^g.*b$ {concat regexp}
+ -* {concat glob}
+ -glob {concat exact}
+ default {concat none}
+ }
+} exact
+test switch-3.6 {-exact vs. -glob vs. -regexp} {
+ list [catch {switch -foo a b c} msg] $msg
+} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}}
+
+test switch-4.1 {error in executed command} {
+ list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
+ $msg $errorInfo
+} {1 {Just a test} {Just a test
+ while executing
+"error "Just a test""
+ ("a" arm line 1)
+ invoked from within
+"switch a a {error "Just a test"} default {format 1}"}}
+test switch-4.2 {error: not enough args} {
+ list [catch {switch} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-4.3 {error: pattern with no body} {
+ list [catch {switch a b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.4 {error: pattern with no body} {
+ list [catch {switch a b {format 1} c} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.5 {error in default command} {
+ list [catch {switch foo a {error switch1} b {error switch 3} \
+ default {error switch2}} msg] $msg $errorInfo
+} {1 switch2 {switch2
+ while executing
+"error switch2"
+ ("default" arm line 1)
+ invoked from within
+"switch foo a {error switch1} b {error switch 3} default {error switch2}"}}
+
+test switch-5.1 {errors in -regexp matching} {
+ list [catch {switch -regexp aaaab {
+ *b {concat glob}
+ aaaab {concat exact}
+ default {concat none}
+ }} msg] $msg
+} {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
+
+test switch-6.1 {backslashes in patterns} {
+ switch -exact {\a\$\.\[} {
+ \a\$\.\[ {concat first}
+ \a\\$\.\\[ {concat second}
+ \\a\\$\\.\\[ {concat third}
+ {\a\\$\.\\[} {concat fourth}
+ {\\a\\$\\.\\[} {concat fifth}
+ default {concat none}
+ }
+} third
+test switch-6.2 {backslashes in patterns} {
+ switch -exact {\a\$\.\[} {
+ \a\$\.\[ {concat first}
+ {\a\$\.\[} {concat second}
+ {{\a\$\.\[}} {concat third}
+ default {concat none}
+ }
+} second
+
+test switch-7.1 {"-" bodies} {
+ switch a {
+ a -
+ b -
+ c {concat 1}
+ default {concat 2}
+ }
+} 1
+test switch-7.2 {"-" bodies} {
+ list [catch {
+ switch a {
+ a -
+ b -
+ c -
+ }
+ } msg] $msg
+} {1 {no body specified for pattern "a"}}
+test switch-7.3 {"-" bodies} {
+ list [catch {
+ switch a {
+ a -
+ b -foo
+ c -
+ }
+ } msg] $msg
+} {1 {invalid command name "-foo"}}
+
+test switch-8.1 {empty body} {
+ set msg {}
+ switch {2} {
+ 1 {set msg 1}
+ 2 {}
+ default {set msg 2}
+ }
+} {}