diff options
Diffstat (limited to 'tests/switch.test')
| -rw-r--r-- | tests/switch.test | 179 |
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} + } +} {} |