* generic/tclStubInit.c:

	* generic/tclInt.decls, generic/tclIntDecls.h: added TclByteArrayMatch
	* generic/tclUtil.c (TclByteArrayMatch):       for efficient glob
	* generic/tclExecute.c (TclExecuteByteCode):   matching of ByteArray
	Tcl_Objs, used in INST_STR_MATCH. [Bug 1827996]

5 files changed, 220 insertions, 5 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 17919db..6cac511 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.339 2007/10/20 02:15:05 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.340 2007/11/08 00:50:31 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -4063,6 +4063,15 @@ TclExecuteByteCode(
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
+	} else if ((valuePtr->typePtr == &tclByteArrayType)
+		|| (value2Ptr->typePtr == &tclByteArrayType)) {
+	    unsigned char *string1, *string2;
+	    int length1, length2;
+
+	    string1 = Tcl_GetByteArrayFromObj(valuePtr, &length1);
+	    string2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
+	    match = TclByteArrayMatch(string1, length1, string2, length2,
+		    nocase);
 	} else {
 	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
 		    TclGetString(value2Ptr), nocase);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 57611b9..bf92b7b 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.114 2007/09/06 18:13:20 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.115 2007/11/08 00:50:31 hobbs Exp $
 
 library tcl
 
@@ -942,6 +942,11 @@ 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 char *string, int strLen,
+	    CONST char *pattern, int ptnLen, int nocase)
+}
 
 ##############################################################################
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 157b189..76297aa 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.105 2007/09/06 18:13:20 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.106 2007/11/08 00:50:32 hobbs Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -1057,6 +1057,12 @@ 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 char * string, int strLen, 
+				CONST char * pattern, int ptnLen, int nocase);
+#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1314,6 +1320,7 @@ 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 char * string, int strLen, CONST char * pattern, int ptnLen, int nocase); /* 237 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -2047,6 +2054,10 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclBackgroundException \
 	(tclIntStubsPtr->tclBackgroundException) /* 236 */
 #endif
+#ifndef TclByteArrayMatch
+#define TclByteArrayMatch \
+	(tclIntStubsPtr->tclByteArrayMatch) /* 237 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 15e963b..bfb17fd 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.144 2007/09/06 18:13:23 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.145 2007/11/08 00:50:32 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -326,6 +326,7 @@ TclIntStubs tclIntStubs = {
     TclVarHashCreateVar, /* 234 */
     TclInitVarHashTable, /* 235 */
     TclBackgroundException, /* 236 */
+    TclByteArrayMatch, /* 237 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 54e8a04..a95f250 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.84 2007/10/28 03:17:00 msofer Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.85 2007/11/08 00:50:32 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -1553,6 +1553,195 @@ Tcl_StringCaseMatch(
 /*
  *----------------------------------------------------------------------
  *
+ * TclByteArrayMatch --
+ *
+ *	See if a particular string matches a particular pattern. Allows case
+ *	insensitivity.
+ *	Parallels tclUtf.c:TclUniCharMatch, adjusted for char*.
+ *
+ * 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
+TclByteArrayMatch(
+    CONST char *string,		/* String. */
+    int strLen,			/* Length of String */
+    CONST char *pattern,	/* Pattern, which may contain special
+				 * characters. */
+    int ptnLen,			/* Length of Pattern */
+    int nocase)			/* 0 for case sensitive, 1 for insensitive */
+{
+    CONST char *stringEnd, *patternEnd;
+    char p;
+
+    stringEnd = string + strLen;
+    patternEnd = pattern + ptnLen;
+
+    while (1) {
+	/*
+	 * See if we're at the end of both the pattern and the string. If so,
+	 * we succeeded. If we're at the end of the pattern but not at the end
+	 * of the string, we failed.
+	 */
+
+	if (pattern == patternEnd) {
+	    return (string == stringEnd);
+	}
+	p = *pattern;
+	if ((string == stringEnd) && (p != '*')) {
+	    return 0;
+	}
+
+	/*
+	 * Check for a "*" as the next pattern character. It matches any
+	 * substring. We handle this by skipping all the characters up to the
+	 * next matching one in the pattern, and then calling ourselves
+	 * recursively for each postfix of string, until either we match or we
+	 * reach the end of the string.
+	 */
+
+	if (p == '*') {
+	    /*
+	     * Skip all successive *'s in the pattern.
+	     */
+
+	    while (*(++pattern) == '*') {
+		/* empty body */
+	    }
+	    if (pattern == patternEnd) {
+		return 1;
+	    }
+	    p = *pattern;
+	    if (nocase) {
+		p = tolower(p);
+	    }
+	    while (1) {
+		/*
+		 * Optimization for matching - cruise through the string
+		 * quickly if the next char in the pattern isn't a special
+		 * character.
+		 */
+
+		if ((p != '[') && (p != '?') && (p != '\\')) {
+		    if (nocase) {
+			while ((string < stringEnd) && (p != *string)
+				&& (p != tolower(*string))) {
+			    string++;
+			}
+		    } else {
+			while ((string < stringEnd) && (p != *string)) {
+			    string++;
+			}
+		    }
+		}
+		if (TclByteArrayMatch(string, stringEnd - string,
+			pattern, patternEnd - pattern, nocase)) {
+		    return 1;
+		}
+		if (string == stringEnd) {
+		    return 0;
+		}
+		string++;
+	    }
+	}
+
+	/*
+	 * Check for a "?" as the next pattern character. It matches any
+	 * single character.
+	 */
+
+	if (p == '?') {
+	    pattern++;
+	    string++;
+	    continue;
+	}
+
+	/*
+	 * Check for a "[" as the next pattern character. It is followed by a
+	 * list of characters that are acceptable, or by a range (two
+	 * characters separated by "-").
+	 */
+
+	if (p == '[') {
+	    char ch1, startChar, endChar;
+
+	    pattern++;
+	    ch1 = (nocase ? tolower(*string) : *string);
+	    string++;
+	    while (1) {
+		if ((*pattern == ']') || (pattern == patternEnd)) {
+		    return 0;
+		}
+		startChar = (nocase ? tolower(*pattern) : *pattern);
+		pattern++;
+		if (*pattern == '-') {
+		    pattern++;
+		    if (pattern == patternEnd) {
+			return 0;
+		    }
+		    endChar = (nocase ? tolower(*pattern) : *pattern);
+		    pattern++;
+		    if (((startChar <= ch1) && (ch1 <= endChar))
+			    || ((endChar <= ch1) && (ch1 <= startChar))) {
+			/*
+			 * Matches ranges of form [a-z] or [z-a].
+			 */
+			break;
+		    }
+		} else if (startChar == ch1) {
+		    break;
+		}
+	    }
+	    while (*pattern != ']') {
+		if (pattern == patternEnd) {
+		    pattern--;
+		    break;
+		}
+		pattern++;
+	    }
+	    pattern++;
+	    continue;
+	}
+
+	/*
+	 * If the next pattern character is '\', just strip off the '\' so we
+	 * do exact matching on the character that follows.
+	 */
+
+	if (p == '\\') {
+	    if (++pattern == patternEnd) {
+		return 0;
+	    }
+	}
+
+	/*
+	 * There's no special character. Just make sure that the next bytes of
+	 * each string match.
+	 */
+
+	if (nocase) {
+	    if (tolower(*string) != tolower(*pattern)) {
+		return 0;
+	    }
+	} else if (*string != *pattern) {
+	    return 0;
+	}
+	string++;
+	pattern++;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_DStringInit --
  *
  *	Initializes a dynamic string, discarding any previous contents of the