summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-12-03 13:46:27 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-12-03 13:46:27 (GMT)
commit629ca8e4ee0dc3109e8120b6e015b8840dc1838f (patch)
tree66a144b459981c7033d8fba61e0fbe74b8faed43
parent23c757e1987a037c346e5d77c4997c9aaf692b9d (diff)
downloadtcl-629ca8e4ee0dc3109e8120b6e015b8840dc1838f.zip
tcl-629ca8e4ee0dc3109e8120b6e015b8840dc1838f.tar.gz
tcl-629ca8e4ee0dc3109e8120b6e015b8840dc1838f.tar.bz2
Make two-arg switch work reliably (and actually as documented!) [Bug 1836519]
-rw-r--r--ChangeLog8
-rw-r--r--doc/switch.n11
-rw-r--r--generic/tclCmdMZ.c83
-rw-r--r--generic/tclCompCmds.c43
-rw-r--r--tests/switch.test367
5 files changed, 274 insertions, 238 deletions
diff --git a/ChangeLog b/ChangeLog
index 56412d3..b273bd4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-12-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Adjusted the [switch]
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): command so that when
+ passed two arguments, no check for options are performed. This is OK
+ since in the two-arg case, detecting an option would definitely lead
+ to a syntax error. [Bug 1836519]
+
2007-11-29 Jeff Hobbs <jeffh@ActiveState.com>
* win/makefile.vc: add ws2_32.lib to baselibs
diff --git a/doc/switch.n b/doc/switch.n
index 62db89b..b63f402 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: switch.n,v 1.15 2007/10/29 16:00:04 dkf Exp $
+'\" RCS: @(#) $Id: switch.n,v 1.16 2007/12/03 13:46:27 dkf Exp $
'\"
.so man.macros
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
@@ -85,6 +85,10 @@ time as the \fB\-matchvar\fR option.
\fB\-\|\-\fR
Marks the end of options. The argument following this one will
be treated as \fIstring\fR even if it starts with a \fB\-\fR.
+.VS 8.5
+This is not required when the matching patterns and bodies are grouped
+together in a single argument.
+.VE 8.5
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
@@ -138,7 +142,7 @@ Whenever nothing matches, the \fBdefault\fR clause (which must be
last) is taken. This example has a result of \fI3\fR:
.CS
\fBswitch\fR xyz {
- a \-
+ a \-
b {
# Correct Comment Placement
expr {1}
@@ -171,3 +175,6 @@ exactly matched is easily obtained using the \fB\-matchvar\fR option:
for(n), if(n), regexp(n)
.SH KEYWORDS
switch, match, regular expression
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 724c35e..0d3a3a8 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.160 2007/11/23 15:00:23 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.161 2007/12/03 13:46:28 dkf Exp $
*/
#include "tclInt.h"
@@ -3469,7 +3469,7 @@ Tcl_SwitchObjCmd(
matchVarObj = NULL;
numMatchesSaved = 0;
noCase = 0;
- for (i = 1; i < objc; i++) {
+ for (i = 1; i < objc-2; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
@@ -3477,40 +3477,24 @@ Tcl_SwitchObjCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
- if (index == OPT_LAST) {
- i++;
- break;
- }
-
- /*
- * Check for TIP#75 options specifying the variables to write regexp
- * information into.
- */
+ switch ((enum options) index) {
+ /*
+ * General options.
+ */
- if (index == OPT_INDEXV) {
+ case OPT_LAST:
i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -indexvar option",
- NULL);
- return TCL_ERROR;
- }
- indexVarObj = objv[i];
- numMatchesSaved = -1;
- } else if (index == OPT_MATCHV) {
- i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -matchvar option",
- NULL);
- return TCL_ERROR;
- }
- matchVarObj = objv[i];
- numMatchesSaved = -1;
- } else if (index == OPT_NOCASE) {
+ goto finishedOptions;
+ case OPT_NOCASE:
strCmpFn = strcasecmp;
noCase = 1;
- } else {
+ break;
+
+ /*
+ * Handle the different switch mode options.
+ */
+
+ default:
if (foundmode) {
/*
* Mode already set via -exact, -glob, or -regexp.
@@ -3520,12 +3504,41 @@ Tcl_SwitchObjCmd(
TclGetString(objv[i]), "\": ", options[mode],
" option already found", NULL);
return TCL_ERROR;
+ } else {
+ foundmode = 1;
+ mode = index;
+ break;
+ }
+
+ /*
+ * Check for TIP#75 options specifying the variables to write
+ * regexp information into.
+ */
+
+ case OPT_INDEXV:
+ i++;
+ if (i >= objc-2) {
+ Tcl_AppendResult(interp, "missing variable name argument to ",
+ "-indexvar", " option", NULL);
+ return TCL_ERROR;
}
- foundmode = 1;
- mode = index;
+ indexVarObj = objv[i];
+ numMatchesSaved = -1;
+ break;
+ case OPT_MATCHV:
+ i++;
+ if (i >= objc-2) {
+ Tcl_AppendResult(interp, "missing variable name argument to ",
+ "-matchvar", " option", NULL);
+ return TCL_ERROR;
+ }
+ matchVarObj = objv[i];
+ numMatchesSaved = -1;
+ break;
}
}
+ finishedOptions:
if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?switches? string pattern body ... ?default body?");
@@ -3545,7 +3558,7 @@ Tcl_SwitchObjCmd(
stringObj = objv[i];
objc -= i + 1;
objv += i + 1;
- bidx = i+1; /* First after the match string. */
+ bidx = i + 1; /* First after the match string. */
/*
* If all of the pattern/command pairs are lumped into a single argument,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0c603c5..c47d4a1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.132 2007/11/24 12:57:56 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.133 2007/12/03 13:46:28 dkf Exp $
*/
#include "tclInt.h"
@@ -3856,14 +3856,14 @@ TclCompileSwitchCmd(
/*
* Only handle the following versions:
- * switch -- word {pattern body ...}
- * switch -exact -- word {pattern body ...}
- * switch -glob -- word {pattern body ...}
- * switch -regexp -- word {pattern body ...}
- * switch -- word simpleWordPattern simpleWordBody ...
- * switch -exact -- word simpleWordPattern simpleWordBody ...
- * switch -glob -- word simpleWordPattern simpleWordBody ...
- * switch -regexp -- word simpleWordPattern simpleWordBody ...
+ * switch ?--? word {pattern body ...}
+ * switch -exact ?--? word {pattern body ...}
+ * switch -glob ?--? word {pattern body ...}
+ * switch -regexp ?--? word {pattern body ...}
+ * switch -- word simpleWordPattern simpleWordBody ...
+ * switch -exact -- word simpleWordPattern simpleWordBody ...
+ * switch -glob -- word simpleWordPattern simpleWordBody ...
+ * switch -regexp -- word simpleWordPattern simpleWordBody ...
* When the mode is -glob, can also handle a -nocase flag.
*
* First off, we don't care how the command's word was generated; we're
@@ -3875,15 +3875,29 @@ TclCompileSwitchCmd(
numWords = parsePtr->numWords-1;
/*
- * Check for options. There must be at least one, --, because without that
- * there is no way to statically avoid the problems you get from strings-
- * -to-be-matched that start with a - (the interpreted code falls apart if
- * it encounters them, so we punt if we *might* encounter them as that is
- * the easiest way of emulating the behaviour).
+ * Check for options.
*/
noCase = 0;
mode = Switch_Exact;
+ if (numWords == 2) {
+ /*
+ * There's just the switch value and the bodies list. In that case, we
+ * can skip all option parsing and move on to consider switch values
+ * and the body list.
+ */
+
+ goto finishedOptionParse;
+ }
+
+ /*
+ * There must be at least one option, --, because without that there is no
+ * way to statically avoid the problems you get from strings-to-be-matched
+ * that start with a - (the interpreted code falls apart if it encounters
+ * them, so we punt if we *might* encounter them as that is the easiest
+ * way of emulating the behaviour).
+ */
+
for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
register unsigned size = tokenPtr[1].size;
register const char *chrs = tokenPtr[1].start;
@@ -3960,6 +3974,7 @@ TclCompileSwitchCmd(
* compilable too.
*/
+ finishedOptionParse:
valueTokenPtr = tokenPtr;
/* For valueIndex, see previous loop. */
tokenPtr = TokenAfter(tokenPtr);
diff --git a/tests/switch.test b/tests/switch.test
index 830f400..e42f1a1 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -11,180 +11,173 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: switch.test,v 1.16 2006/10/09 19:15:45 msofer Exp $
+# RCS: @(#) $Id: switch.test,v 1.17 2007/12/03 13:46:28 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
test switch-1.1 {simple patterns} {
- switch a a {format 1} b {format 2} c {format 3} default {format 4}
+ switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 1
test switch-1.2 {simple patterns} {
- switch b a {format 1} b {format 2} c {format 3} default {format 4}
+ switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.3 {simple patterns} {
- switch x a {format 1} b {format 2} c {format 3} default {format 4}
+ switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 4
test switch-1.4 {simple patterns} {
- switch x a {format 1} b {format 2} c {format 3}
+ switch x a {subst 1} b {subst 2} c {subst 3}
} {}
test switch-1.5 {simple pattern matches many times} {
- switch b a {format 1} b {format 2} b {format 3} b {format 4}
+ switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4}
} 2
test switch-1.6 {simple patterns} {
- switch default a {format 1} default {format 2} c {format 3} default {format 4}
+ switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.7 {simple patterns} {
- switch x a {format 1} default {format 2} c {format 3} default {format 4}
+ switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 4
test switch-1.8 {simple patterns with -nocase} {
- switch -nocase b a {format 1} b {format 2} c {format 3} default {format 4}
+ switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.9 {simple patterns with -nocase} {
- switch -nocase B a {format 1} b {format 2} c {format 3} default {format 4}
+ switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.10 {simple patterns with -nocase} {
- switch -nocase b a {format 1} B {format 2} c {format 3} default {format 4}
+ switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.11 {simple patterns with -nocase} {
- switch -nocase x a {format 1} default {format 2} c {format 3} default {format 4}
+ switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 4
test switch-2.1 {single-argument form for pattern/command pairs} {
switch b {
- a {format 1}
- b {format 2}
- default {format 6}
+ a {subst 1}
+ b {subst 2}
+ default {subst 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-2.2 {single-argument form for pattern/command pairs} -body {
+ switch z {a 2 b}
+} -returnCodes error -result {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}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} exact
test switch-3.2 {-exact vs. -glob vs. -regexp} {
switch -regexp aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst 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}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst 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}
+ switch aaaab {^a*b$} {subst regexp} *b {subst glob} \
+ aaaab {subst exact} default {subst 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}
+ ^g.*b$ {subst regexp}
+ -* {subst glob}
+ -glob {subst exact}
+ default {subst 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, -indexvar, -matchvar, -nocase, -regexp, or --}}
+test switch-3.6 {-exact vs. -glob vs. -regexp} -body {
+ switch -foo a b c
+} -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}
test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} {
switch -exact -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} exact
test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} {
switch -regexp -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} regexp
test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} {
switch -glob -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} glob
test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} {
- switch -nocase aaaab {^a*b$} {concat regexp} *b {concat glob} \
- aaaab {concat exact} default {concat none}
+ switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \
+ aaaab {subst exact} default {subst none}
} exact
test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} {
switch -nocase -- -glob {
- ^g.*b$ {concat regexp}
- -* {concat glob}
- -glob {concat exact}
- default {concat none}
+ ^g.*b$ {subst regexp}
+ -* {subst glob}
+ -glob {subst exact}
+ default {subst none}
}
} exact
-
test switch-3.12 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exa Foo Foo {set result OK}} msg] $msg
-} {0 OK}
-
+ switch -exa Foo Foo {set result OK}
+} OK
test switch-3.13 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -gl Foo Fo? {set result OK}} msg] $msg
-} {0 OK}
-
+ switch -gl Foo Fo? {set result OK}
+} OK
test switch-3.14 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -re Foo Fo. {set result OK}} msg] $msg
-} {0 OK}
-
-test switch-3.15 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exact -exact Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-exact": -exact option already found}}
-
-test switch-3.16 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exact -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -exact option already found}}
-
-test switch-3.17 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -glob -regexp Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-regexp": -glob option already found}}
-
-test switch-3.18 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -regexp -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -regexp option already found}}
+ switch -re Foo Fo. {set result OK}
+} OK
+test switch-3.15 {-exact vs. -glob vs. -regexp} -body {
+ switch -exact -exact Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-exact": -exact option already found}
+test switch-3.16 {-exact vs. -glob vs. -regexp} -body {
+ switch -exact -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -exact option already found}
+test switch-3.17 {-exact vs. -glob vs. -regexp} -body {
+ switch -glob -regexp Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-regexp": -glob option already found}
+test switch-3.18 {-exact vs. -glob vs. -regexp} -body {
+ switch -regexp -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -regexp option already found}
test switch-4.1 {error in executed command} {
- list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
+ list [catch {switch a a {error "Just a test"} default {subst 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}}
+"switch a a {error "Just a test"} default {subst 1}"}}
+test switch-4.2 {error: not enough args} -returnCodes error -body {
+ switch
+} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
+test switch-4.3 {error: pattern with no body} -body {
+ switch a b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-4.4 {error: pattern with no body} -body {
+ switch a b {subst 1} c
+} -returnCodes error -result {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
@@ -195,30 +188,30 @@ test switch-4.5 {error in default command} {
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: quantifier operand invalid}}
+test switch-5.1 {errors in -regexp matching} -returnCodes error -body {
+ switch -regexp aaaab {
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
+ }
+} -result {couldn't compile regular expression pattern: quantifier operand invalid}
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}
+ \a\$\.\[ {subst first}
+ \a\\$\.\\[ {subst second}
+ \\a\\$\\.\\[ {subst third}
+ {\a\\$\.\\[} {subst fourth}
+ {\\a\\$\\.\\[} {subst fifth}
+ default {subst none}
}
} third
test switch-6.2 {backslashes in patterns} {
switch -exact {\a\$\.\[} {
- \a\$\.\[ {concat first}
- {\a\$\.\[} {concat second}
- {{\a\$\.\[}} {concat third}
- default {concat none}
+ \a\$\.\[ {subst first}
+ {\a\$\.\[} {subst second}
+ {{\a\$\.\[}} {subst third}
+ default {subst none}
}
} second
@@ -226,37 +219,31 @@ test switch-7.1 {"-" bodies} {
switch a {
a -
b -
- c {concat 1}
- default {concat 2}
+ c {subst 1}
+ default {subst 2}
}
} 1
-test switch-7.2 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -
- c -
- }
- } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.3 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -foo
- c -
- }
- } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.4 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -foo
- c {}
- }
- } msg] $msg
-} {1 {invalid command name "-foo"}}
+test switch-7.2 {"-" bodies} -body {
+ switch a {
+ a -
+ b -
+ c -
+ }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.3 {"-" bodies} -body {
+ switch a {
+ a -
+ b -foo
+ c -
+ }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.4 {"-" bodies} -body {
+ switch a {
+ a -
+ b -foo
+ c {}
+ }
+} -returnCodes error -result {invalid command name "-foo"}
test switch-8.1 {empty body} {
set msg {}
@@ -266,18 +253,15 @@ test switch-8.1 {empty body} {
default {set msg 2}
}
} {}
-
proc test_switch_body {} {
return "INVOKED"
}
-
test switch-8.2 {weird body text, variable} {
set cmd {test_switch_body}
switch Foo {
Foo $cmd
}
} {INVOKED}
-
test switch-8.3 {weird body text, variable} {
set cmd {test_switch_body}
switch Foo {
@@ -285,54 +269,63 @@ test switch-8.3 {weird body text, variable} {
}
} {INVOKED}
-test switch-9.1 {empty pattern/body list} {
- list [catch {switch x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.2 {empty pattern/body list} {
- list [catch {switch -- x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.3 {empty pattern/body list} {
- list [catch {switch x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.4 {empty pattern/body list} {
- list [catch {switch -- x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.5 {unpaired pattern} {
- list [catch {switch x a {} b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.6 {unpaired pattern} {
- list [catch {switch x {a {} b}} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.7 {unpaired pattern} {
- list [catch {switch x a {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.8 {unpaired pattern} {
- list [catch {switch x {a {} # comment b}} msg] $msg
-} {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}}
-test switch-9.9 {unpaired pattern} {
- list [catch {switch x a {} x {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.10 {unpaired pattern} {
- list [catch {switch x {a {} x {} # comment b}} msg] $msg
-} {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}}
+test switch-9.1 {empty pattern/body list} -returnCodes error -body {
+ switch x
+} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
+test switch-9.2 {unpaired pattern} -returnCodes error -body {
+ switch -- x
+} -result {extra switch pattern with no body}
+test switch-9.3 {empty pattern/body list} -body {
+ switch x {}
+} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
+test switch-9.4 {empty pattern/body list} -body {
+ switch -- x {}
+} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
+test switch-9.5 {unpaired pattern} -body {
+ switch x a {} b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.6 {unpaired pattern} -body {
+ switch x {a {} b}
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.7 {unpaired pattern} -body {
+ switch x a {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.8 {unpaired pattern} -returnCodes error -body {
+ switch x {a {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
+test switch-9.9 {unpaired pattern} -body {
+ switch x a {} x {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.10 {unpaired pattern} -returnCodes error -body {
+ switch x {a {} x {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
test switch-10.1 {compiled -exact switch} {
- if 1 {switch -exact -- a {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- a {a {subst 1} b {subst 2}}}
+} 1
+test switch-10.1a {compiled -exact switch} {
+ if 1 {switch -exact a {a {subst 1} b {subst 2}}}
} 1
test switch-10.2 {compiled -exact switch} {
- if 1 {switch -exact -- b {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- b {a {subst 1} b {subst 2}}}
+} 2
+test switch-10.2a {compiled -exact switch} {
+ if 1 {switch -exact b {a {subst 1} b {subst 2}}}
} 2
test switch-10.3 {compiled -exact switch} {
- if 1 {switch -exact -- c {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- c {a {subst 1} b {subst 2}}}
+} {}
+test switch-10.3a {compiled -exact switch} {
+ if 1 {switch -exact c {a {subst 1} b {subst 2}}}
} {}
test switch-10.4 {compiled -exact switch} {
if 1 {
set x 0
- switch -exact -- c {a {format 1} b {format 2}}
+ switch -exact -- c {a {subst 1} b {subst 2}}
}
} {}
test switch-10.5 {compiled -exact switch} {
- if 1 {switch -exact -- a {a - aa {format 1} b {format 2}}}
+ if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}}
} 1
test switch-10.6 {compiled -exact switch} {
if 1 {switch -exact -- b {a {
@@ -344,7 +337,7 @@ test switch-10.6 {compiled -exact switch} {
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
- } b {format 2}}}
+ } b {subst 2}}}
} 2
# Command variants are:
@@ -354,7 +347,7 @@ test switch-10.6 {compiled -exact switch} {
proc cswtest-glob s {
set x 0; set y 0
foreach c [split $s {}] {
- switch -glob -- $c {
+ switch -glob $c {
a {incr x}
b {incr y}
}
@@ -368,7 +361,7 @@ proc cswtest-glob s {
proc iswtest-glob s {
set x 0; set y 0; set switch switch
foreach c [split $s {}] {
- $switch -glob -- $c {
+ $switch -glob $c {
a {incr x}
b {incr y}
}
@@ -382,7 +375,7 @@ proc iswtest-glob s {
proc cswtest-exact s {
set x 0; set y 0
foreach c [split $s {}] {
- switch -exact -- $c {
+ switch -exact $c {
a {incr x}
b {incr y}
}
@@ -396,7 +389,7 @@ proc cswtest-exact s {
proc iswtest-exact s {
set x 0; set y 0; set switch switch
foreach c [split $s {}] {
- $switch -exact -- $c {
+ $switch -exact $c {
a {incr x}
b {incr y}
}
@@ -410,7 +403,7 @@ proc iswtest-exact s {
proc cswtest2-glob s {
set x 0; set y 0; set z 0
foreach c [split $s {}] {
- switch -glob -- $c {
+ switch -glob $c {
a {incr x}
b {incr y}
default {incr z}
@@ -425,7 +418,7 @@ proc cswtest2-glob s {
proc iswtest2-glob s {
set x 0; set y 0; set z 0; set switch switch
foreach c [split $s {}] {
- $switch -glob -- $c {
+ $switch -glob $c {
a {incr x}
b {incr y}
default {incr z}
@@ -440,7 +433,7 @@ proc iswtest2-glob s {
proc cswtest2-exact s {
set x 0; set y 0; set z 0
foreach c [split $s {}] {
- switch -exact -- $c {
+ switch -exact $c {
a {incr x}
b {incr y}
default {incr z}
@@ -455,7 +448,7 @@ proc cswtest2-exact s {
proc iswtest2-exact s {
set x 0; set y 0; set z 0; set switch switch
foreach c [split $s {}] {
- $switch -exact -- $c {
+ $switch -exact $c {
a {incr x}
b {incr y}
default {incr z}