185 lines
5.7 KiB
Plaintext
185 lines
5.7 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.
|
||
|
# All rights reserved.
|
||
|
#
|
||
|
# Permission is hereby granted, without written agreement and without
|
||
|
# license or royalty fees, to use, copy, modify, and distribute this
|
||
|
# software and its documentation for any purpose, provided that the
|
||
|
# above copyright notice and the following two paragraphs appear in
|
||
|
# all copies of this software.
|
||
|
#
|
||
|
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
|
||
|
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
|
||
|
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
|
||
|
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||
|
#
|
||
|
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
|
||
|
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
|
||
|
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
||
|
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
|
||
|
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
||
|
#
|
||
|
# $Header: /user6/ouster/tcl/tests/RCS/switch.test,v 1.2 93/06/17 11:53:58 ouster Exp $ (Berkeley)
|
||
|
|
||
|
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"}}
|