Fix [Bug 1891827]

3 files changed, 30 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index e42a3f8..82ab3ea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,19 +1,22 @@
 2008-02-12  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for
+	* tests/switch.test (switch-10.15): handling -nocase compilation; the
+	-exact -nocase option cannot be compiled currently. [Bug 1891827]
+
 	* unix/README: Documented missing configure flags. [Bug 1799011]
 
 2008-02-06  Kevin B. Kenny  <kennykb@acm.org>
 
-	* doc/clock.n (%N):
+	* doc/clock.n (%N): Corrected an error in the explanation of the %N
+	format group.
 	* generic/tclClock.c (ClockParseformatargsObjCmd):
 	* library/clock.tcl (::tcl::clock::format):
 	* tests/clock.test (clock-1.0, clock-1.4):
-		Performance enhancements in [clock format] (moving
-		the analysis of $args into C code, holding on to
-		Tcl_Objs with resolved command names, [lassign]
-		in place of [foreach], avoiding [namespace which]
-		for command resolution).  Corrected an error in the
-		explanation of the %N format group.
+	Performance enhancements in [clock format] (moving the analysis of
+	$args into C code, holding on to Tcl_Objs with resolved command names,
+	[lassign] in place of [foreach], avoiding [namespace which] for
+	command resolution).
 
 2008-02-04  Don Porter	<dgp@users.sourceforge.net>
 
@@ -33,8 +36,8 @@
 
 2008-02-04  Miguel Sofer  <msofer@users.sf.net>
 
-	* generic/tclExecute.c (INST_CONCAT1): fix optimisation for
-	in-place concatenation (was going over String type)
+	* generic/tclExecute.c (INST_CONCAT1): fix optimisation for in-place
+	concatenation (was going over String type)
 
 2008-02-02  Daniel Steffen  <das@users.sourceforge.net>
 
@@ -45,8 +48,8 @@
 
 2008-01-30  Miguel Sofer  <msofer@users.sf.net>
 
-	* generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373],
-	thanks go to an00na
+	* generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], thanks go
+	to an00na
 
 2008-01-30  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5b5cd93..82edcd7 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.140 2008/01/23 19:41:27 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.141 2008/02/12 10:27:26 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3967,7 +3967,7 @@ TclCompileSwitchCmd(
     }
     tokenPtr = TokenAfter(tokenPtr);
     numWords--;
-    if (noCase && (mode != Switch_Exact)) {
+    if (noCase && (mode == Switch_Exact)) {
 	/*
 	 * Can't compile this case; no opcode for case-insensitive equality!
 	 */
@@ -4376,6 +4376,7 @@ TclCompileSwitchCmd(
     foundDefault = 0;
     for (i=0 ; i<numWords ; i+=2) {
 	int nextArmFixupIndex = -1;
+
 	envPtr->currStackDepth = savedStackDepth + 1;
 	if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
 		memcmp(bodyToken[numWords-2]->start, "default", 7)) {
@@ -4400,6 +4401,7 @@ TclCompileSwitchCmd(
 		/*
 		 * Keep in sync with TclCompileRegexpCmd.
 		 */
+
 		if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
 		    Tcl_DString ds;
 
@@ -4439,13 +4441,15 @@ TclCompileSwitchCmd(
 		    }
 		} else {
 		    /*
-		     * Pass correct RE compile flags.  We use only Int1
+		     * Pass correct RE compile flags. We use only Int1
 		     * (8-bit), but that handles all the flags we want to
-		     * pass.  Don't use TCL_REG_NOSUB as we may have backrefs
+		     * pass. Don't use TCL_REG_NOSUB as we may have backrefs
 		     * or capture vars.
 		     */
+
 		    int cflags = TCL_REG_ADVANCED
-			| (noCase ? TCL_REG_NOCASE : 0);
+			    | (noCase ? TCL_REG_NOCASE : 0);
+
 		    TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
 		}
 		break;
diff --git a/tests/switch.test b/tests/switch.test
index 8b1a4a5..45f494f 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -11,7 +11,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.test,v 1.19 2007/12/19 21:09:38 hobbs Exp $
+# RCS: @(#) $Id: switch.test,v 1.20 2008/02/12 10:27:27 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -501,6 +501,12 @@ rename cswtest-exact {}
 rename iswtest-exact {}
 rename cswtest2-exact {}
 rename iswtest2-exact {}
+# Bug 1891827
+test switch-10.15 {(not) compiled exact nocase regression} {
+    apply {{} {
+	switch -nocase -- A { a {return yes} default {return no} }
+    }}
+} yes
 
 # Added due to TIP#75
 test switch-11.1 {regexp matching with -matchvar} {