diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 11 | ||||
| -rw-r--r-- | generic/tclInt.decls | 7 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 13 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 | ||||
| -rw-r--r-- | generic/tclUtil.c | 191 |
6 files changed, 226 insertions, 5 deletions
@@ -1,5 +1,11 @@ 2007-11-07 Jeff Hobbs <jeffh@ActiveState.com> + * 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] + * generic/tclIO.c (TclGetsObjBinary): add an efficient binary path for [gets]. (DoWriteChars): special case for 1-byte channel write. 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 |