Make two-arg switch work reliably (and actually as documented!) [Bug 1836519]

2 files changed, 77 insertions, 49 deletions

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);