diff options
author | hobbs <hobbs> | 2007-12-11 02:57:38 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2007-12-11 02:57:38 (GMT) |
commit | cf51bd54b5a287a462f703664196dbbfbfc072f1 (patch) | |
tree | e2366f37f9aceb9a418cb4d9a8a7ddfaed064e61 | |
parent | be008511dcfa73424dbbe3a12cdf3890759977ba (diff) | |
download | tcl-cf51bd54b5a287a462f703664196dbbfbfc072f1.zip tcl-cf51bd54b5a287a462f703664196dbbfbfc072f1.tar.gz tcl-cf51bd54b5a287a462f703664196dbbfbfc072f1.tar.bz2 |
* 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
-rw-r--r-- | ChangeLog | 14 | ||||
-rw-r--r-- | doc/StrMatch.3 | 20 | ||||
-rw-r--r-- | generic/tcl.h | 8 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 18 | ||||
-rw-r--r-- | generic/tclExecute.c | 4 | ||||
-rw-r--r-- | generic/tclInt.decls | 16 | ||||
-rw-r--r-- | generic/tclInt.h | 11 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 30 | ||||
-rw-r--r-- | generic/tclRegexp.c | 26 | ||||
-rw-r--r-- | generic/tclStubInit.c | 4 | ||||
-rw-r--r-- | generic/tclUtil.c | 61 | ||||
-rw-r--r-- | tests/string.test | 62 |
12 files changed, 180 insertions, 94 deletions
@@ -1,3 +1,17 @@ +2007-12-10 Jeff Hobbs <jeffh@ActiveState.com> + + * 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 2372c46..6c9cfa8 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.12 2007/10/28 14:17:39 dkf Exp $ +'\" RCS: @(#) $Id: StrMatch.3,v 1.13 2007/12/11 02:57:39 hobbs 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/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 diff --git a/tests/string.test b/tests/string.test index 921efe8..c175dca 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.69 2007/11/23 15:00:25 dkf Exp $ +# RCS: @(#) $Id: string.test,v 1.70 2007/12/11 02:57:45 hobbs 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 |