freebsd-skq/contrib/tcl/tests/switch.test
Poul-Henning Kamp 403acdc0da Tcl 7.5, various makefiles will be updated to use these sources as soon
as I get these back down to my machine.
1996-06-26 06:06:43 +00:00

171 lines
4.8 KiB
Plaintext

# 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.5 96/02/16 08:56:31
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": should 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"}}