summaryrefslogtreecommitdiffstats
path: root/generic/tclUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclUtil.c')
-rw-r--r--generic/tclUtil.c61
1 files changed, 58 insertions, 3 deletions
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