* generic/tclInt.decls: move TclByteArrayMatch and TclReToGlob

	* generic/tclIntDecls.h: to tclInt.h from stubs.
	* generic/tclStubInit.c: Add flags var to TclByteArrayMatch for
	* generic/tclInt.h:      future extensibility
	* generic/tcl.h:  define TCL_MATCH_EXACT doc for Tcl_StringCaseMatch.
	* doc/StrMatch.3: It is compatible with existing usage.
	* generic/tclExecute.c (INST_STR_MATCH): flag for TclByteArrayMatch
	* generic/tclUtil.c (TclByteArrayMatch, TclStringMatchObj):
	* generic/tclRegexp.c (Tcl_RegExpExecObj):
	* generic/tclCmdMZ.c (StringMatchCmd): Use TclStringMatchObj
	* tests/string.test (11.9.* 11.10.*): more tests

9 files changed, 95 insertions, 83 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index db919dc..494e5da 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.245 2007/11/20 20:43:11 dkf Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.246 2007/12/11 02:57:39 hobbs Exp $
  */
 
 #ifndef _TCL
@@ -518,6 +518,12 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
 #define TCL_THREAD_JOINABLE	 (0001) /* Mark the thread as joinable */
 
 /*
+ * Flag values passed to Tcl_StringCaseMatch.
+ */
+
+#define TCL_MATCH_NOCASE	(1<<0)
+
+/*
  * Flag values passed to Tcl_GetRegExpFromObj.
  */
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 0d3a3a8..da03f5a 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.161 2007/12/03 13:46:28 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.162 2007/12/11 02:57:39 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1974,8 +1974,7 @@ StringMatchCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_UniChar *ustring1, *ustring2;
-    int length1, length2, nocase = 0;
+    int nocase = 0;
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
@@ -1983,21 +1982,20 @@ StringMatchCmd(
     }
 
     if (objc == 4) {
-	const char *string = TclGetStringFromObj(objv[1], &length2);
+	int length;
+	const char *string = TclGetStringFromObj(objv[1], &length);
 
-	if ((length2 > 1) &&
-	    strncmp(string, "-nocase", (size_t) length2) == 0) {
-	    nocase = 1;
+	if ((length > 1) &&
+	    strncmp(string, "-nocase", (size_t) length) == 0) {
+	    nocase = TCL_MATCH_NOCASE;
 	} else {
 	    Tcl_AppendResult(interp, "bad option \"", string,
 		    "\": must be -nocase", NULL);
 	    return TCL_ERROR;
 	}
     }
-    ustring1 = Tcl_GetUnicodeFromObj(objv[objc-1], &length1);
-    ustring2 = Tcl_GetUnicodeFromObj(objv[objc-2], &length2);
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    TclUniCharMatch(ustring1, length1, ustring2, length2, nocase)));
+		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
     return TCL_OK;
 }
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c8ec537..ff42fef 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.355 2007/12/07 21:24:41 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.356 2007/12/11 02:57:40 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -4213,7 +4213,7 @@ TclExecuteByteCode(
 
 	    string1 = Tcl_GetByteArrayFromObj(valuePtr, &length1);
 	    string2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
-	    match = TclByteArrayMatch(string1, length1, string2, length2);
+	    match = TclByteArrayMatch(string1, length1, string2, length2, 0);
 	} else {
 	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
 		    TclGetString(value2Ptr), nocase);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 5cca4c2..e90e5d6 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tclInt.decls,v 1.118 2007/12/10 15:51:15 das Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.119 2007/12/11 02:57:43 hobbs Exp $
 
 library tcl
 
@@ -701,7 +701,7 @@ declare 172 generic {
 
 declare 173 generic {
     int TclUniCharMatch(CONST Tcl_UniChar *string, int strLen,
-	    CONST Tcl_UniChar *pattern, int ptnLen, int nocase)
+	    CONST Tcl_UniChar *pattern, int ptnLen, int flags)
 }
 
 # added for 8.4.3
@@ -933,18 +933,6 @@ declare 236 generic {
     void TclBackgroundException(Tcl_Interp *interp, int code)
 }
 
-# Added for 8.5b3 to improve binary glob match case
-declare 237 generic {
-    int TclByteArrayMatch(const unsigned char *string, int strLen,
-			  const unsigned char *pattern, int ptnLen)
-}
-
-# Added for 8.5b3 to generalize check for RE to glob pattern conversion
-declare 238 generic {
-    int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen,
-		    Tcl_DString *dsPtr, int *exactPtr)
-}
-
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
diff --git a/generic/tclInt.h b/generic/tclInt.h
index c507ed3..94a56eb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.356 2007/12/06 19:34:58 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.357 2007/12/11 02:57:43 hobbs Exp $
  */
 
 #ifndef _TCLINT
@@ -2422,6 +2422,9 @@ MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
 MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
 MODULE_SCOPE double	TclBignumToDouble(mp_int *bignum);
+MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
+			    int strLen, const unsigned char *pattern,
+			    int ptnLen, int flags);
 MODULE_SCOPE double	TclCeil(mp_int *a);
 MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,const char *value);
 MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
@@ -2625,6 +2628,8 @@ MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
 MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
 MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
+MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
+			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
 MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
 			    Tcl_Obj *cmdPrefix);
 MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
@@ -2636,6 +2641,10 @@ MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
 MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
 			    int numBytes);
+MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
+			    const char *pattern, int ptnLen, int flags);
+MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
+			    Tcl_Obj *patternObj, int flags);
 MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
 			    int count, int *tokensLeftPtr, int line);
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 8ef0cd9..863b8f3 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.109 2007/12/10 15:51:55 das Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.110 2007/12/11 02:57:44 hobbs Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -830,7 +830,7 @@ EXTERN int		TclInThreadExit (void);
 /* 173 */
 EXTERN int		TclUniCharMatch (CONST Tcl_UniChar * string, 
 				int strLen, CONST Tcl_UniChar * pattern, 
-				int ptnLen, int nocase);
+				int ptnLen, int flags);
 #endif
 /* Slot 174 is reserved */
 #ifndef TclCallVarTraces_TCL_DECLARED
@@ -1082,20 +1082,6 @@ EXTERN void		TclInitVarHashTable (TclVarHashTable * tablePtr,
 EXTERN void		TclBackgroundException (Tcl_Interp * interp, 
 				int code);
 #endif
-#ifndef TclByteArrayMatch_TCL_DECLARED
-#define TclByteArrayMatch_TCL_DECLARED
-/* 237 */
-EXTERN int		TclByteArrayMatch (const unsigned char * string, 
-				int strLen, const unsigned char * pattern, 
-				int ptnLen);
-#endif
-#ifndef TclReToGlob_TCL_DECLARED
-#define TclReToGlob_TCL_DECLARED
-/* 238 */
-EXTERN int		TclReToGlob (Tcl_Interp * interp, const char * reStr, 
-				int reStrLen, Tcl_DString * dsPtr, 
-				int * exactPtr);
-#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1298,7 +1284,7 @@ typedef struct TclIntStubs {
     int (*tclCheckInterpTraces) (Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 170 */
     int (*tclCheckExecutionTraces) (Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 171 */
     int (*tclInThreadExit) (void); /* 172 */
-    int (*tclUniCharMatch) (CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int nocase); /* 173 */
+    int (*tclUniCharMatch) (CONST Tcl_UniChar * string, int strLen, CONST Tcl_UniChar * pattern, int ptnLen, int flags); /* 173 */
     void *reserved174;
     int (*tclCallVarTraces) (Interp * iPtr, Var * arrayPtr, Var * varPtr, CONST char * part1, CONST char * part2, int flags, int leaveErrMsg); /* 175 */
     void (*tclCleanupVar) (Var * varPtr, Var * arrayPtr); /* 176 */
@@ -1362,8 +1348,6 @@ typedef struct TclIntStubs {
     Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */
     void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */
     void (*tclBackgroundException) (Tcl_Interp * interp, int code); /* 236 */
-    int (*tclByteArrayMatch) (const unsigned char * string, int strLen, const unsigned char * pattern, int ptnLen); /* 237 */
-    int (*tclReToGlob) (Tcl_Interp * interp, const char * reStr, int reStrLen, Tcl_DString * dsPtr, int * exactPtr); /* 238 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -2115,14 +2099,6 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclBackgroundException \
 	(tclIntStubsPtr->tclBackgroundException) /* 236 */
 #endif
-#ifndef TclByteArrayMatch
-#define TclByteArrayMatch \
-	(tclIntStubsPtr->tclByteArrayMatch) /* 237 */
-#endif
-#ifndef TclReToGlob
-#define TclReToGlob \
-	(tclIntStubsPtr->tclReToGlob) /* 238 */
-#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index d24e9a8..3f064bf 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -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: tclRegexp.c,v 1.26 2007/11/12 02:07:20 hobbs Exp $
+ * RCS: @(#) $Id: tclRegexp.c,v 1.27 2007/12/11 02:57:44 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -448,33 +448,15 @@ Tcl_RegExpExecObj(
     if ((offset == 0) && (nmatches == 0) && (flags == 0)
 	    && !(reflags & ~TCL_REG_GLOBOK_FLAGS)
 	    && (regexpPtr->globObjPtr != NULL)) {
-	int match, nocase = (reflags & TCL_REG_NOCASE);
+	int nocase = (reflags & TCL_REG_NOCASE) ? TCL_MATCH_NOCASE : 0;
 
 	/*
-	 * Promote based on the type of incoming object.
+	 * Pass to TclStringMatchObj for obj-specific handling.
 	 * XXX: Currently doesn't take advantage of exact-ness that
 	 * XXX: TclReToGlob tells us about
 	 */
 
-	if (textObj->typePtr == &tclStringType) {
-	    Tcl_UniChar *uptn;
-	    int plen;
-
-	    udata = Tcl_GetUnicodeFromObj(textObj, &length);
-	    uptn  = Tcl_GetUnicodeFromObj(regexpPtr->globObjPtr, &plen);
-	    match = TclUniCharMatch(udata, length, uptn, plen, nocase);
-	} else if ((textObj->typePtr == &tclByteArrayType) && !nocase) {
-	    unsigned char *data, *ptn;
-	    int plen;
-
-	    data = Tcl_GetByteArrayFromObj(textObj, &length);
-	    ptn  = Tcl_GetByteArrayFromObj(regexpPtr->globObjPtr, &plen);
-	    match = TclByteArrayMatch(data, length, ptn, plen);
-	} else {
-	    match = Tcl_StringCaseMatch(TclGetString(textObj),
-		    TclGetString(regexpPtr->globObjPtr), nocase);
-	}
-	return match;
+	return TclStringMatchObj(textObj, regexpPtr->globObjPtr, nocase);
     }
 
     /*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 4fc5e7c..7ce2229 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -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: tclStubInit.c,v 1.147 2007/12/10 15:51:56 das Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.148 2007/12/11 02:57:44 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -335,8 +335,6 @@ TclIntStubs tclIntStubs = {
     TclVarHashCreateVar, /* 234 */
     TclInitVarHashTable, /* 235 */
     TclBackgroundException, /* 236 */
-    TclByteArrayMatch, /* 237 */
-    TclReToGlob, /* 238 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 09ecc7d..35efcfd 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.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: tclUtil.c,v 1.93 2007/11/18 21:59:25 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.94 2007/12/11 02:57:44 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1576,7 +1576,8 @@ TclByteArrayMatch(
     int strLen,				/* Length of String */
     const unsigned char *pattern,	/* Pattern, which may contain special
 					 * characters. */
-    int ptnLen)				/* Length of Pattern */
+    int ptnLen,				/* Length of Pattern */
+    int flags)
 {
     const unsigned char *stringEnd, *patternEnd;
     unsigned char p;
@@ -1632,7 +1633,7 @@ TclByteArrayMatch(
 		    }
 		}
 		if (TclByteArrayMatch(string, stringEnd - string,
-			pattern, patternEnd - pattern)) {
+				pattern, patternEnd - pattern, 0)) {
 		    return 1;
 		}
 		if (string == stringEnd) {
@@ -1727,6 +1728,60 @@ TclByteArrayMatch(
 /*
  *----------------------------------------------------------------------
  *
+ * TclStringMatchObj --
+ *
+ *	See if a particular string matches a particular pattern.
+ *	Allows case insensitivity.  This is the generic multi-type handler
+ *	for the various matching algorithms.
+ *
+ * Results:
+ *	The return value is 1 if string matches pattern, and 0 otherwise. The
+ *	matching operation permits the following special characters in the
+ *	pattern: *?\[] (see the manual entry for details on what these mean).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStringMatchObj(
+    Tcl_Obj *strObj,	/* string object. */
+    Tcl_Obj *ptnObj,	/* pattern object. */
+    int flags)		/* Only TCL_MATCH_NOCASE should be passed or 0. */
+{
+    int match, length, plen;
+
+    /*
+     * Promote based on the type of incoming object.
+     * XXX: Currently doesn't take advantage of exact-ness that
+     * XXX: TclReToGlob tells us about
+    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
+     */
+
+    if ((strObj->typePtr == &tclStringType)) {
+	Tcl_UniChar *udata, *uptn;
+
+	udata = Tcl_GetUnicodeFromObj(strObj, &length);
+	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
+	match = TclUniCharMatch(udata, length, uptn, plen, flags);
+    } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+	unsigned char *data, *ptn;
+
+	data = Tcl_GetByteArrayFromObj(strObj, &length);
+	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);
+	match = TclByteArrayMatch(data, length, ptn, plen, 0);
+    } else {
+	match = Tcl_StringCaseMatch(TclGetString(strObj),
+		TclGetString(ptnObj), flags);
+    }
+    return match;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DStringInit --
  *
  *	Initializes a dynamic string, discarding any previous contents of the