From 629ca8e4ee0dc3109e8120b6e015b8840dc1838f Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 3 Dec 2007 13:46:27 +0000
Subject: Make two-arg switch work reliably (and actually as documented!) [Bug
 1836519]

---
 ChangeLog             |   8 ++
 doc/switch.n          |  11 +-
 generic/tclCmdMZ.c    |  83 +++++++-----
 generic/tclCompCmds.c |  43 ++++--
 tests/switch.test     | 367 +++++++++++++++++++++++++-------------------------
 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}
-- 
cgit v0.12