1# Commands covered:  switch
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1993 The Regents of the University of California.
8# Copyright (c) 1994 Sun Microsystems, Inc.
9# Copyright (c) 1998-1999 by Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13#
14# RCS: @(#) $Id: switch.test,v 1.7 2001/11/27 13:30:54 dkf Exp $
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest
18    namespace import -force ::tcltest::*
19}
20
21test switch-1.1 {simple patterns} {
22    switch a a {format 1} b {format 2} c {format 3} default {format 4}
23} 1
24test switch-1.2 {simple patterns} {
25    switch b a {format 1} b {format 2} c {format 3} default {format 4}
26} 2
27test switch-1.3 {simple patterns} {
28    switch x a {format 1} b {format 2} c {format 3} default {format 4}
29} 4
30test switch-1.4 {simple patterns} {
31    switch x a {format 1} b {format 2} c {format 3}
32} {}
33test switch-1.5 {simple pattern matches many times} {
34    switch b a {format 1} b {format 2} b {format 3} b {format 4}
35} 2
36test switch-1.6 {simple patterns} {
37    switch default a {format 1} default {format 2} c {format 3} default {format 4}
38} 2
39test switch-1.7 {simple patterns} {
40    switch x a {format 1} default {format 2} c {format 3} default {format 4}
41} 4
42
43test switch-2.1 {single-argument form for pattern/command pairs} {
44    switch b {
45	a {format 1}
46	b {format 2}
47	default {format 6}
48    }
49} {2}
50test switch-2.2 {single-argument form for pattern/command pairs} {
51    list [catch {switch z {a 2 b}} msg] $msg
52} {1 {extra switch pattern with no body}}
53
54test switch-3.1 {-exact vs. -glob vs. -regexp} {
55    switch -exact aaaab {
56	^a*b$	{concat regexp}
57	*b	{concat glob}
58	aaaab	{concat exact}
59	default	{concat none}
60    }
61} exact
62test switch-3.2 {-exact vs. -glob vs. -regexp} {
63    switch -regexp aaaab {
64	^a*b$	{concat regexp}
65	*b	{concat glob}
66	aaaab	{concat exact}
67	default	{concat none}
68    }
69} regexp
70test switch-3.3 {-exact vs. -glob vs. -regexp} {
71    switch -glob aaaab {
72	^a*b$	{concat regexp}
73	*b	{concat glob}
74	aaaab	{concat exact}
75	default	{concat none}
76    }
77} glob
78test switch-3.4 {-exact vs. -glob vs. -regexp} {
79    switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
80	    aaaab {concat exact} default {concat none}
81} exact
82test switch-3.5 {-exact vs. -glob vs. -regexp} {
83    switch -- -glob {
84	^g.*b$	{concat regexp}
85	-*	{concat glob}
86	-glob	{concat exact}
87	default {concat none}
88    }
89} exact
90test switch-3.6 {-exact vs. -glob vs. -regexp} {
91    list [catch {switch -foo a b c} msg] $msg
92} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}}
93
94test switch-4.1 {error in executed command} {
95    list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
96	    $msg $errorInfo
97} {1 {Just a test} {Just a test
98    while executing
99"error "Just a test""
100    ("a" arm line 1)
101    invoked from within
102"switch a a {error "Just a test"} default {format 1}"}}
103test switch-4.2 {error: not enough args} {
104    list [catch {switch} msg] $msg
105} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
106test switch-4.3 {error: pattern with no body} {
107    list [catch {switch a b} msg] $msg
108} {1 {extra switch pattern with no body}}
109test switch-4.4 {error: pattern with no body} {
110    list [catch {switch a b {format 1} c} msg] $msg
111} {1 {extra switch pattern with no body}}
112test switch-4.5 {error in default command} {
113    list [catch {switch foo a {error switch1} b {error switch 3} \
114	    default {error switch2}} msg] $msg $errorInfo
115} {1 switch2 {switch2
116    while executing
117"error switch2"
118    ("default" arm line 1)
119    invoked from within
120"switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
121
122test switch-5.1 {errors in -regexp matching} {
123    list [catch {switch -regexp aaaab {
124	*b	{concat glob}
125	aaaab	{concat exact}
126	default	{concat none}
127    }} msg] $msg
128} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
129
130test switch-6.1 {backslashes in patterns} {
131    switch -exact {\a\$\.\[} {
132	\a\$\.\[	{concat first}
133	\a\\$\.\\[	{concat second}
134	\\a\\$\\.\\[	{concat third}
135	{\a\\$\.\\[}	{concat fourth}
136	{\\a\\$\\.\\[}	{concat fifth}
137	default		{concat none}
138    }
139} third
140test switch-6.2 {backslashes in patterns} {
141    switch -exact {\a\$\.\[} {
142	\a\$\.\[	{concat first}
143	{\a\$\.\[}	{concat second}
144	{{\a\$\.\[}}	{concat third}
145	default		{concat none}
146    }
147} second
148
149test switch-7.1 {"-" bodies} {
150    switch a {
151	a -
152	b -
153	c {concat 1}
154	default {concat 2}
155    }
156} 1
157test switch-7.2 {"-" bodies} {
158    list [catch {
159	switch a {
160	    a -
161	    b -
162	    c -
163	}
164    } msg] $msg
165} {1 {no body specified for pattern "c"}}
166test switch-7.3 {"-" bodies} {
167    list [catch {
168	switch a {
169	    a -
170	    b -foo
171	    c -
172	}
173    } msg] $msg
174} {1 {no body specified for pattern "c"}}
175
176test switch-8.1 {empty body} {
177    set msg {}
178    switch {2} {
179    	1 {set msg 1}
180        2 {}
181        default {set msg 2}
182    }
183} {}
184
185test switch-9.1 {empty pattern/body list} {
186    list [catch {switch x} msg] $msg
187} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
188test switch-9.2 {empty pattern/body list} {
189    list [catch {switch -- x} msg] $msg
190} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
191test switch-9.3 {empty pattern/body list} {
192    list [catch {switch x {}} msg] $msg
193} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
194test switch-9.4 {empty pattern/body list} {
195    list [catch {switch -- x {}} msg] $msg
196} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
197test switch-9.5 {unpaired pattern} {
198    list [catch {switch x a {} b} msg] $msg
199} {1 {extra switch pattern with no body}}
200test switch-9.6 {unpaired pattern} {
201    list [catch {switch x {a {} b}} msg] $msg
202} {1 {extra switch pattern with no body}}
203test switch-9.7 {unpaired pattern} {
204    list [catch {switch x a {} # comment b} msg] $msg
205} {1 {extra switch pattern with no body}}
206test switch-9.8 {unpaired pattern} {
207    list [catch {switch x {a {} # comment b}} msg] $msg
208} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
209test switch-9.9 {unpaired pattern} {
210    list [catch {switch x a {} x {} # comment b} msg] $msg
211} {1 {extra switch pattern with no body}}
212test switch-9.10 {unpaired pattern} {
213    list [catch {switch x {a {} x {} # comment b}} msg] $msg
214} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
215
216# cleanup
217::tcltest::cleanupTests
218return
219