Implementation of TIP#241 from Joe Mistachkin

Also compilation of [switch -glob -nocase] from Donal Fellows

11 files changed, 240 insertions, 67 deletions

diff --git a/ChangeLog b/ChangeLog
index b00587a..6dbbf82 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2005-06-01  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclCompCmds.c (TclCompileSwitchCmd): Allow compilation
+	of -nocase -glob [switch]es (only one we know how to compile).
+
+	TIP#241 IMPLEMENTATION from Joe Mistachkin
+
+	* generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd): 
+	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Implementation of -nocase
+	option for [lsearch], [lsort] and [switch] commands.
+	* win/tclWinPort.h: Win uses nonstandard function names...
+	* tests/cmdIL.test, tests/lsearch.test, tests/switch.test: Tests
+	* doc/lsearch.n, doc/lsort.n, doc/switch.n: Docs
+
 	* generic/tclCompCmds.c (TclCompileLindexCmd): Compile the most
 	common case of [lindex] more efficiently.
 
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 823be5e..afe601f 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -7,7 +7,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: lsearch.n,v 1.24 2005/05/10 18:34:01 kennykb Exp $
+'\" RCS: @(#) $Id: lsearch.n,v 1.25 2005/06/01 11:00:33 dkf Exp $
 '\" 
 .so man.macros
 .TH lsearch n 8.5 Tcl "Tcl Built-In Commands"
@@ -95,6 +95,13 @@ dictionary-equal when exactly equal.
 .TP
 \fB\-integer\fR
 The list elements are to be compared as integers.
+.VS 8.5
+.TP
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner.  Has no
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or 
+\fB\-real\fR options.
+.VE 8.5
 .TP
 \fB\-real\fR
 The list elements are to be compared as floating-point values.
diff --git a/doc/lsort.n b/doc/lsort.n
index a921745..09962d2 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -7,10 +7,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: lsort.n,v 1.20 2005/05/10 18:34:02 kennykb Exp $
+'\" RCS: @(#) $Id: lsort.n,v 1.21 2005/06/01 11:00:33 dkf Exp $
 '\" 
 .so man.macros
-.TH lsort n 8.3 Tcl "Tcl Built-In Commands"
+.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -104,6 +104,13 @@ returns \fB{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}\fR
 This option is much more efficient than using \fB\-command\fR
 to achieve the same effect.
 .RE
+.VS 8.5
+.TP 20
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner.  Has no
+effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or 
+\fB\-real\fR options.
+.VE 8.5
 .TP 20
 \fB\-unique\fR
 If this option is specified, then only the last set of duplicate
diff --git a/doc/switch.n b/doc/switch.n
index c508262..83103cb 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -5,10 +5,10 @@
 '\" 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.8 2004/10/27 14:24:37 dkf Exp $
+'\" RCS: @(#) $Id: switch.n,v 1.9 2005/06/01 11:00:33 dkf Exp $
 '\" 
 .so man.macros
-.TH switch n 7.0 Tcl "Tcl Built-In Commands"
+.TH switch n 8.5 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -51,6 +51,9 @@ expression matching
 '\" Options defined by TIP#75
 .VS 8.5
 .TP 10
+\fB\-nocase\fR
+Causes comparisons to be handled in a case-insensitive manner.
+.TP 10
 \fB\-matchvar\fR \fIvarName\fR
 This option (only legal when \fB\-regexp\fR is also specified)
 specifies the name of a variable into which the list of matches
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b68f7ba..883ed45 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.75 2005/05/30 00:04:46 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.76 2005/06/01 11:00:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -36,6 +36,15 @@ typedef struct SortElement {
 } SortElement;
 
 /*
+ * These function pointer types are used with the "lsearch" and "lsort"
+ * commands to facilitate the "-nocase" option.
+ */
+
+typedef int (*SortStrCmpFn_t) _ANSI_ARGS_((const char *, const char *));
+typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *,
+			    size_t));
+
+/*
  * The "lsort" command needs to pass certain information down to the
  * function that compares two list elements, and the comparison function
  * needs to pass success or failure information back up to the top-level
@@ -47,6 +56,8 @@ typedef struct SortInfo {
     int isIncreasing;		/* Nonzero means sort in increasing order. */
     int sortMode;		/* The sort mode.  One of SORTMODE_*
 				 * values defined below */
+    SortStrCmpFn_t strCmpFn;     /* Basic string compare command (used with
+				 * ASCII mode). */
     Tcl_Obj *compareCmdPtr;     /* The Tcl comparison command when sortMode
 				 * is SORTMODE_COMMAND.  Pre-initialized to
 				 * hold base of command.*/
@@ -3201,7 +3212,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     char *bytes, *patternBytes;
     int i, match, mode, index, result, listc, length, elemLen;
     int dataType, isIncreasing, lower, upper, patInt, objInt;
-    int offset, allMatches, inlineReturn, negatedMatch, returnSubindices;
+    int offset, allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
     double patDouble, objDouble;
     SortInfo sortInfo;
     Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
@@ -3209,15 +3220,17 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     static CONST char *options[] = {
 	"-all",	    "-ascii",   "-decreasing", "-dictionary",
 	"-exact",   "-glob",    "-increasing", "-index",
-	"-inline",  "-integer", "-not",        "-real",
-	"-regexp",  "-sorted",  "-start",      "-subindices",
+	"-inline",  "-integer", "-nocase",     "-not",
+	"-real",    "-regexp",  "-sorted",     "-start",
+	"-subindices",
 	NULL
     };
     enum options {
 	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
 	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
-	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL,
-	LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START, LSEARCH_SUBINDICES
+	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
+	LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
+	LSEARCH_SUBINDICES
     };
     enum datatypes {
 	ASCII, DICTIONARY, INTEGER, REAL
@@ -3225,6 +3238,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     enum modes {
 	EXACT, GLOB, REGEXP, SORTED
     };
+    SortStrCmpFn_t strCmpFn = strcmp;
 
     mode = GLOB;
     dataType = ASCII;
@@ -3236,6 +3250,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     listPtr = NULL;
     startPtr = NULL;
     offset = 0;
+    noCase = 0;
     sortInfo.compareCmdPtr = NULL;
     sortInfo.isIncreasing = 0;
     sortInfo.sortMode = 0;
@@ -3288,6 +3303,10 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	case LSEARCH_INTEGER:		/* -integer */
 	    dataType = INTEGER;
 	    break;
+	case LSEARCH_NOCASE:		/* -nocase */
+	    strCmpFn = strcasecmp;
+	    noCase = 1;
+	    break;
 	case LSEARCH_NOT:		/* -not */
 	    negatedMatch = 1;
 	    break;
@@ -3422,7 +3441,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	 * regexp rep before the list rep.
 	 */
 	regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
-		TCL_REG_ADVANCED | TCL_REG_NOSUB);
+		TCL_REG_ADVANCED | TCL_REG_NOSUB |
+		(noCase ? TCL_REG_NOCASE : 0));
 	if (regexp == NULL) {
 	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
@@ -3531,7 +3551,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    switch ((enum datatypes) dataType) {
 	    case ASCII:
 		bytes = TclGetString(itemPtr);
-		match = strcmp(patternBytes, bytes);
+		match = strCmpFn(patternBytes, bytes);
 		break;
 	    case DICTIONARY:
 		bytes = TclGetString(itemPtr);
@@ -3629,8 +3649,16 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 		case ASCII:
 		    bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
 		    if (length == elemLen) {
-			match = (memcmp(bytes, patternBytes,
-				(size_t) length) == 0);
+			/*
+			 * This split allows for more optimal
+			 * compilation of memcmp
+			 */
+			if (noCase) {
+			    match = (strcasecmp(bytes, patternBytes) == 0);
+			} else {
+			    match = (memcmp(bytes, patternBytes,
+				    (size_t) length) == 0);
+			}
 		    }
 		    break;
 		case DICTIONARY:
@@ -3669,7 +3697,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 		break;
 
 	    case GLOB:
-		match = Tcl_StringMatch(TclGetString(itemPtr), patternBytes);
+		match = Tcl_StringCaseMatch(TclGetString(itemPtr),
+			patternBytes, noCase);
 		break;
 	    case REGEXP:
 		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
@@ -3871,12 +3900,13 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 					 * comparison function */
     static CONST char *switches[] = {
 	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-indices", "-integer", "-real", "-unique", (char *) NULL
+	"-index", "-indices", "-integer", "-nocase", "-real", "-unique",
+	(char *) NULL
     };
     enum Lsort_Switches {
 	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
 	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
-	LSORT_REAL, LSORT_UNIQUE
+	LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE
     };
 
     if (objc < 2) {
@@ -3890,6 +3920,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 
     sortInfo.isIncreasing = 1;
     sortInfo.sortMode = SORTMODE_ASCII;
+    sortInfo.strCmpFn = strcmp;
     sortInfo.indexv = NULL;
     sortInfo.indexc = 0;
     sortInfo.interp = interp;
@@ -3988,6 +4019,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 	case LSORT_INTEGER:
 	    sortInfo.sortMode = SORTMODE_INTEGER;
 	    break;
+	case LSORT_NOCASE:
+	    sortInfo.strCmpFn = strcasecmp;
+	    break;
 	case LSORT_REAL:
 	    sortInfo.sortMode = SORTMODE_REAL;
 	    break;
@@ -4262,7 +4296,7 @@ SortCompare(objPtr1, objPtr2, infoPtr)
     }
 
     if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(TclGetString(objPtr1), TclGetString(objPtr2));
+	order = infoPtr->strCmpFn(TclGetString(objPtr1), TclGetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
 	order = DictionaryCompare(
 		TclGetString(objPtr1), TclGetString(objPtr2));
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index b507fe5..99182f3 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.122 2005/05/25 19:27:10 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.123 2005/06/01 11:00:34 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2520,7 +2520,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int i, j, index, mode, result, splitObjs, numMatchesSaved;
+    int i, j, index, mode, result, splitObjs, numMatchesSaved, noCase;
     char *pattern;
     Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
     Tcl_Obj *CONST *savedObjv = objv;
@@ -2531,17 +2531,21 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
      * parser as well.
      */
     static CONST char *options[] = {
-	"-exact", "-glob", "-indexvar", "-matchvar", "-regexp", "--", 
-	NULL
+	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
+	"--", NULL
     };
     enum options {
-	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_REGEXP, OPT_LAST
+	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
+	OPT_LAST
     };
+    typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *));
+    strCmpFn_t strCmpFn = strcmp;
 
     mode = OPT_EXACT;
     indexVarObj = NULL;
     matchVarObj = NULL;
     numMatchesSaved = 0;
+    noCase = 0;
     for (i = 1; i < objc; i++) {
 	if (TclGetString(objv[i])[0] != '-') {
 	    break;
@@ -2580,6 +2584,9 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	    }
 	    matchVarObj = objv[i];
 	    numMatchesSaved = -1;
+	} else if (index == OPT_NOCASE) {
+	    strCmpFn = strcasecmp;
+	    noCase = 1;
 	} else {
 	    mode = index;
 	}
@@ -2718,18 +2725,19 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	} else {
 	    switch (mode) {
 	    case OPT_EXACT:
-		if (strcmp(TclGetString(stringObj), pattern) == 0) {
+		if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
 		    goto matchFound;
 		}
 		break;
 	    case OPT_GLOB:
-		if (Tcl_StringMatch(TclGetString(stringObj), pattern)) {
+		if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern,
+			noCase)) {
 		    goto matchFound;
 		}
 		break;
 	    case OPT_REGEXP:
 		regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
-			TCL_REG_ADVANCED);
+			TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
 		if (regExpr == NULL) {
 		    return TCL_ERROR;
 		} else {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c412329..9598d84 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.69 2005/06/01 10:02:19 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.70 2005/06/01 11:00:35 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2723,6 +2723,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
 				 * to the current (or next) real body. */
 
     int savedStackDepth = envPtr->currStackDepth;
+    int noCase;
     int i;
 
     /*
@@ -2753,50 +2754,55 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
      * 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).
-     *
-     * Note that this parsing would probably be better done with a
-     * loop, but it works for now...
      */
 
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    } else {
-	register int size = tokenPtr[1].size;
+    noCase = 0;
+    mode = Switch_Exact;
+    for (; numWords>=3 ; tokenPtr+=2,numWords--) {
+	register unsigned size = tokenPtr[1].size;
 	register CONST char *chrs = tokenPtr[1].start;
 
 	/*
-	 * Assume that -e and -g are unique prefixes of -exact and -glob
+	 * We only process literal options, and we assume that -e, -g
+	 * and -n are unique prefixes of -exact, -glob and -nocase
+	 * respectively (true at time of writing).
 	 */
-	if (size < 2) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
 	    return TCL_ERROR;
 	}
-	if ((size <= 6) && (numWords >= 4)
-		&& !strncmp(chrs, "-exact", (unsigned) TclMin(size, 6))) {
+
+	if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
 	    mode = Switch_Exact;
-	    tokenPtr += 2;
-	    numWords--;
-	} else if ((size <= 5) && (numWords >= 4)
-		&& !strncmp(chrs, "-glob", (unsigned) TclMin(size, 5))) {
+	    continue;
+	} else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
 	    mode = Switch_Glob;
-	    tokenPtr += 2;
-	    numWords--;
-	} else if ((size == 2) && (numWords >= 3) && !strncmp(chrs, "--", 2)) {
-	    /*
-	     * If no control flag present, use exact matching (the default).
-	     *
-	     * We end up re-checking this word, but that's the way things are.
-	     */
-	    mode = Switch_Exact;
-	} else {
-	    return TCL_ERROR;
+	    continue;
+	} else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
+	    noCase = 1;
+	    continue;
+	} else if ((size == 2) && !memcmp(chrs, "--", 2)) {
+	    break;
 	}
+
+	/*
+	 * The switch command has many flags we cannot compile at all
+	 * (e.g. all the RE-related ones) which we must have
+	 * encountered. Either that or we have run off the end. The
+	 * action here is the same: punt to interpreted version.
+	 */
+	return TCL_ERROR;
     }
-    if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (tokenPtr[1].size != 2)
-	    || strncmp(tokenPtr[1].start, "--", 2)) {
+    if (numWords < 3) {
 	return TCL_ERROR;
     }
     tokenPtr += 2;
     numWords--;
+    if (noCase && (mode == Switch_Exact)) {
+	/*
+	 * Can't compile this case!
+	 */
+	return TCL_ERROR;
+    }
 
     /*
      * The value to test against is going to always get pushed on the
@@ -2902,6 +2908,14 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
 	    return TCL_ERROR;
 	}
     } else if (numWords % 2 || numWords == 0) {
+	/*
+	 * Odd number of words (>1) available, or no words at all
+	 * available. Both are error cases, so punt and let the
+	 * interpreted-version generate the error message. Note that
+	 * the second case probably should get caught earlier, but
+	 * it's easy to check here again anyway because it'd cause a
+	 * nasty crash otherwise.
+	 */
 	return TCL_ERROR;
     } else {
 	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
@@ -2962,7 +2976,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
 	int nextArmFixupIndex = -1;
 	envPtr->currStackDepth = savedStackDepth + 1;
 	if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
-		strncmp(bodyToken[numWords-2]->start, "default", 7)) {
+		memcmp(bodyToken[numWords-2]->start, "default", 7)) {
 	    /*
 	     * Generate the test for the arm. This code is slightly
 	     * inefficient, but much simpler than the first version.
@@ -2975,7 +2989,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
 		TclEmitOpcode(INST_STR_EQ, envPtr);
 		break;
 	    case Switch_Glob:
-		TclEmitInstInt1(INST_STR_MATCH, /*nocase*/0, envPtr);
+		TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
 		break;
 	    default:
 		Tcl_Panic("unknown switch mode: %d",mode);
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 644111e..f1653b4 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdIL.test,v 1.25 2005/05/10 18:35:01 kennykb Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.26 2005/06/01 11:00:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -23,7 +23,7 @@ test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
 } {1 {wrong # args: should be "lsort ?options? list"}}
 test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
     list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique}}
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
 test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
     lsort {d e c b a \{ d35 d300}
 } {a b c d d300 d35 e \{}
@@ -383,6 +383,12 @@ test cmdIL-4.32 {DictionaryCompare procedure, chars between Z and a in ASCII} {
 test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} {
     lsort -dictionary [list AA ! c CC `]
 } [list ! ` AA c CC]
+test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
+    lsort -ascii -nocase {d e c b a d35 d300 100 20}
+} {100 20 a b c d d300 d35 e}
+test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
+    lsort -ascii -nocase {d E c B a D35 d300 100 20}
+} {100 20 a B c d d300 D35 E}
 
 test cmdIL-5.1 {lsort with list style index} {
     lsort -ascii -decreasing -index {0 1} {
diff --git a/tests/lsearch.test b/tests/lsearch.test
index ec04689..0155bdd 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.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: lsearch.test,v 1.15 2005/05/10 18:35:22 kennykb Exp $
+# RCS: @(#) $Id: lsearch.test,v 1.16 2005/06/01 11:00:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -61,7 +61,25 @@ test lsearch-2.9 {search modes} {
 } 1
 test lsearch-2.10 {search modes} {
     list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+test lsearch-2.11 {search modes with -nocase} {
+    lsearch -exact -nocase {a b c A B C} A
+} 0
+test lsearch-2.12 {search modes with -nocase} {
+    lsearch -glob -nocase {a b c A B C} A*
+} 0
+test lsearch-2.13 {search modes with -nocase} {
+    lsearch -regexp -nocase {a b c A B C} ^A\$
+} 0
+test lsearch-2.14 {search modes without -nocase} {
+    lsearch -exact {a b c A B C} A
+} 3
+test lsearch-2.15 {search modes without -nocase} {
+    lsearch -glob {a b c A B C} A*
+} 3
+test lsearch-2.16 {search modes without -nocase} {
+    lsearch -regexp {a b c A B C} ^A\$
+} 3
 
 test lsearch-3.1 {lsearch errors} {
     list [catch lsearch msg] $msg
@@ -71,10 +89,10 @@ test lsearch-3.2 {lsearch errors} {
 } {1 {wrong # args: should be "lsearch ?options? list pattern"}}
 test lsearch-3.3 {lsearch errors} {
     list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
 test lsearch-3.4 {lsearch errors} {
     list [catch {lsearch a b c d} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
 test lsearch-3.5 {lsearch errors} {
     list [catch {lsearch "\{" b} msg] $msg
 } {1 {unmatched open brace in list}}
@@ -320,6 +338,15 @@ test lsearch-13.1 {search for all matches} {
 test lsearch-13.2 {search for all matches} {
     lsearch -all {a b a c a d} a
 } {0 2 4}
+test lsearch-13.3 {search for all matches with -nocase} {
+    lsearch -all -exact -nocase {a b c A B C} A
+} {0 3}
+test lsearch-13.4 {search for all matches with -nocase} {
+    lsearch -all -glob -nocase {a b c A B C} A*
+} {0 3}
+test lsearch-13.5 {search for all matches with -nocase} {
+    lsearch -all -regexp -nocase {a b c A B C} ^A\$
+} {0 3}
 
 test lsearch-14.1 {combinations: -all and -inline} {
     lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
diff --git a/tests/switch.test b/tests/switch.test
index b06155c..e05f2ca 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.12 2005/05/10 18:35:24 kennykb Exp $
+# RCS: @(#) $Id: switch.test,v 1.13 2005/06/01 11:00:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -39,6 +39,18 @@ test switch-1.6 {simple patterns} {
 test switch-1.7 {simple patterns} {
     switch x a {format 1} default {format 2} c {format 3} default {format 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}
+} 2
+test switch-1.9 {simple patterns with -nocase} {
+    switch -nocase B a {format 1} b {format 2} c {format 3} default {format 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}
+} 2
+test switch-1.11 {simple patterns with -nocase} {
+    switch -nocase x a {format 1} default {format 2} c {format 3} default {format 4}
+} 4
 
 test switch-2.1 {single-argument form for pattern/command pairs} {
     switch b {
@@ -89,7 +101,43 @@ test switch-3.5 {-exact vs. -glob vs. -regexp} {
 } 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, -regexp, or --}}
+} {1 {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}
+    }
+} 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}
+    }
+} 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}
+    }
+} 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}
+} 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}
+    }
+} exact
 
 test switch-4.1 {error in executed command} {
     list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ac82929..1263e12 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinPort.h,v 1.43 2004/11/03 21:07:01 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.44 2005/06/01 11:00:36 dkf Exp $
  */
 
 #ifndef _TCLWINPORT
@@ -45,6 +45,13 @@
 #include <string.h>
 
 /*
+ * These string functions are not defined with the same names on Windows.
+ */
+
+#define strcasecmp stricmp
+#define strncasecmp strnicmp
+
+/*
  * Need to block out these includes for building extensions with MetroWerks
  * compiler for Win32.
  */