merge updates from HEAD

13 files changed, 192 insertions, 101 deletions

diff --git a/ChangeLog b/ChangeLog
index dc09943..55b0c7e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2007-12-10  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* generic/tclUtil.c (TclReToGlob): reduce escapes in conversion
+	when not necessary
+
+	* 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
+	
 2007-12-10  Joe English  <jenglish@users.sourceforge.net>
 
 	* doc/string.n, doc/UniCharIsAlpha.3: Fix markup errors.
diff --git a/doc/StrMatch.3 b/doc/StrMatch.3
index d17c9d0..a00f863 100644
--- a/doc/StrMatch.3
+++ b/doc/StrMatch.3
@@ -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: StrMatch.3,v 1.9.8.1 2007/11/01 16:25:47 dgp Exp $
+'\" RCS: @(#) $Id: StrMatch.3,v 1.9.8.2 2007/12/11 16:19:54 dgp Exp $
 '\" 
 .so man.macros
-.TH Tcl_StringMatch 3 8.1 Tcl "Tcl Library Procedures"
+.TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
 Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
@@ -20,7 +20,7 @@ int
 \fBTcl_StringMatch\fR(\fIstr\fR, \fIpattern\fR)
 .sp
 int
-\fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fInocase\fR)
+\fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fIflags\fR)
 .SH ARGUMENTS
 .AS "const char" *pattern
 .AP "const char" *str in
@@ -28,9 +28,9 @@ String to test.
 .AP "const char" *pattern in
 Pattern to match against string.  May contain special
 characters from the set *?\e[].
-.AP int nocase in
-Specifies whether the match should be done case-sensitive (0) or
-case-insensitive (1).
+.AP int flags in
+OR-ed combination of match flags, currently only \fBTCL_MATCH_NOCASE\fR.
+0 specifies a case-sensitive search.
 .BE
 
 .SH DESCRIPTION
@@ -42,10 +42,10 @@ used for matching is the same algorithm used in the \fBstring match\fR
 Tcl command and is similar to the algorithm used by the C-shell
 for file name matching;  see the Tcl manual entry for details.
 .PP
-In \fBTcl_StringCaseMatch\fR, the algorithm is the same, but you have
-the option to make the matching case-insensitive.  If you choose this
-(by passing \fBnocase\fR as 1), then the string and pattern are
-essentially matched in the lower case.
+In \fBTcl_StringCaseMatch\fR, the algorithm is
+the same, but you have the option to make the matching case-insensitive.
+If you choose this (by passing \fBTCL_MATCH_NOCASE\fR), then the string and
+pattern are essentially matched in the lower case.
 
 .SH KEYWORDS
 match, pattern, string
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 95e37e7..774b6ee 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -4,13 +4,13 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: StringObj.3,v 1.20.8.3 2007/12/10 19:13:40 dgp Exp $
+'\" RCS: @(#) $Id: StringObj.3,v 1.20.8.4 2007/12/11 16:19:54 dgp Exp $
 '\" 
 .so man.macros
 .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendObjToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
+Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
diff --git a/generic/tcl.h b/generic/tcl.h
index 309fa88..36083d0 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.231.2.12 2007/11/21 06:44:31 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.231.2.13 2007/12/11 16:19:54 dgp 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 c8a9cb2..cae1e32 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.150.2.10 2007/12/04 16:55:53 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.11 2007/12/11 16:19:54 dgp 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 5103ce0..f0d74c1 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.285.2.26 2007/12/10 18:32:55 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.285.2.27 2007/12/11 16:19:54 dgp 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 55274ae..608413b 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.108.2.6 2007/12/10 18:32:56 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.108.2.7 2007/12/11 16:19:55 dgp 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 a06bc2f..e0f716d 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.310.2.22 2007/12/10 18:32:56 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.310.2.23 2007/12/11 16:19:55 dgp 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 899e279..e17987e 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.99.2.6 2007/12/10 18:32:56 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.99.2.7 2007/12/11 16:19:55 dgp 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 ec7da0b..0816003 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.24.2.1 2007/11/12 19:18:20 dgp Exp $
+ * RCS: @(#) $Id: tclRegexp.c,v 1.24.2.2 2007/12/11 16:19:56 dgp 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 37d1a2e..3e2be97 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.140.2.5 2007/12/10 18:32:56 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.140.2.6 2007/12/11 16:19:56 dgp 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 9fc9a58..b490e55 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.82.2.5 2007/11/21 06:30:55 dgp Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.82.2.6 2007/12/11 16:19:56 dgp 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
@@ -3285,17 +3340,19 @@ TclReToGlob(
 	    case 'v':
 		*dsStr++ = '\v';
 		break;
-	    case 'B':
+	    case 'B': case '\\':
 		*dsStr++ = '\\';
 		*dsStr++ = '\\';
 		anchorLeft = 0; /* prevent exact match */
 		break;
-	    case '\\': case '*': case '+': case '?':
-	    case '{': case '}': case '(': case ')': case '[': case ']':
-	    case '.': case '|': case '^': case '$':
+	    case '*': case '[': case ']': case '?':
+		/* Only add \ where necessary for glob */
 		*dsStr++ = '\\';
-		*dsStr++ = *p;
 		anchorLeft = 0; /* prevent exact match */
+		/* fall through */
+	    case '{': case '}': case '(': case ')': case '+':
+	    case '.': case '|': case '^': case '$':
+		*dsStr++ = *p;
 		break;
 	    default:
 		msg = "invalid escape sequence";
diff --git a/tests/string.test b/tests/string.test
index 29dafcf..d7d20f2 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -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: string.test,v 1.62.2.6 2007/11/25 06:45:45 dgp Exp $
+# RCS: @(#) $Id: string.test,v 1.62.2.7 2007/12/11 16:19:56 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -887,9 +887,54 @@ test string-11.8 {string match} {
 test string-11.9 {string match} {
     string match *3*6*9 0123456789
 } 1
+test string-11.9.1 {string match} {
+    string match *3*6*89 0123456789
+} 1
+test string-11.9.2 {string match} {
+    string match *3*456*89 0123456789
+} 1
+test string-11.9.3 {string match} {
+    string match *3*6* 0123456789
+} 1
+test string-11.9.4 {string match} {
+    string match *3*56* 0123456789
+} 1
+test string-11.9.5 {string match} {
+    string match *3*456*** 0123456789
+} 1
+test string-11.9.6 {string match} {
+    string match **3*456** 0123456789
+} 1
+test string-11.9.7 {string match} {
+    string match *3***456* 0123456789
+} 1
+test string-11.9.8 {string match} {
+    string match *3***\[456]* 0123456789
+} 1
+test string-11.9.9 {string match} {
+    string match *3***\[4-6]* 0123456789
+} 1
+test string-11.9.10 {string match} {
+    string match *3***\[4-6] 0123456789
+} 0
+test string-11.9.11 {string match} {
+    string match *3***\[4-6] 0123456
+} 1
 test string-11.10 {string match} {
     string match *3*6*9 01234567890
 } 0
+test string-11.10.1 {string match} {
+    string match *3*6*89 01234567890
+} 0
+test string-11.10.2 {string match} {
+    string match *3*456*89 01234567890
+} 0
+test string-11.10.3 {string match} {
+    string match **3*456*89 01234567890
+} 0
+test string-11.10.4 {string match} {
+    string match *3*456***89 01234567890
+} 0
 test string-11.11 {string match} {
     string match a?c abc
 } 1
@@ -980,6 +1025,21 @@ test string-11.38 {string match case, reverse range} {
 test string-11.39 {string match, *\ case} {
     string match {*\abc} abc
 } 1
+test string-11.39.1 {string match, *\ case} {
+    string match {*ab\c} abc
+} 1
+test string-11.39.2 {string match, *\ case} {
+    string match {*ab\*} ab*
+} 1
+test string-11.39.3 {string match, *\ case} {
+    string match {*ab\*} abc
+} 0
+test string-11.39.4 {string match, *\ case} {
+    string match {*ab\\*} {ab\c}
+} 1
+test string-11.39.5 {string match, *\ case} {
+    string match {*ab\\*} {ab\*}
+} 1
 test string-11.40 {string match, *special case} {
     string match {*[ab]} abc
 } 0