*----------------------------------------------------------------------
 */

static int
DictionaryCompare(
    const char *left, const char *right)	/* The strings to compare. */
{
    int uniLeft, uniRight, uniLeftLower, uniRightLower;
    int diff, zeros;
    int secondaryDiff = 0;

    while (1) {
	if (isdigit(UCHAR(*right))		/* INTL: digit */
		&& isdigit(UCHAR(*left))) {	/* INTL: digit */
	    /*

	/*
	 * Convert character to Unicode for comparison purposes. If either
	 * string is at the terminating null, do a byte-wise comparison and
	 * bail out immediately.
	 */

	if ((*left != '\0') && (*right != '\0')) {
	    Tcl_UniChar lch = 0, rch = 0;
	    int len;

	    len = TclUtfToUniChar(left, &lch);
	    uniLeft = lch;
#if TCL_UTF_MAX == 4
	    if (!len) {
		len = TclUtfToUniChar(left, &lch);
		uniLeft = (((uniLeft&0x3FF)<<10) | (lch&0x3FF)) + 0x10000;
	    }
#endif
	    left += len;

	    len = TclUtfToUniChar(right, &rch);
	    uniRight = rch;
#if TCL_UTF_MAX == 4
	    if (!len) {
		len = TclUtfToUniChar(right, &rch);
		uniRight = (((uniRight&0x3FF)<<10) | (rch&0x3FF)) + 0x10000;
	    }
#endif
	    right += len;

	    /*
	     * Convert both chars to lower for the comparison, because
	     * dictionary sorts are case insensitve. Covert to lower, not
	     * upper, so chars between Z and a will sort before A (where most
	     * other interesting punctuations occur).
	     */

	    uniLeftLower = TclUCS4ToLower(uniLeft);
	    uniRightLower = TclUCS4ToLower(uniRight);
	} else {
	    diff = UCHAR(*left) - UCHAR(*right);
	    break;
	}

	diff = uniLeftLower - uniRightLower;
	if (diff) {

static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);

#if TCL_UTF_MAX == 4
static int		MemCmp(const void *s1, const void *s2, size_t n,
			    int flags);
static int		NumCodePointsUtf(const char *src, int length,
			    int *flagPtr);
static int		NumCodePointsUnicode(const Tcl_UniChar *src,
			    int length, int *flagPtr);
static int		UniCharNcmp(const Tcl_UniChar *ucs,
			    const Tcl_UniChar *uct, size_t numCp, int flags);
static int		UniCharNcasecmp(const Tcl_UniChar *ucs,
			    const Tcl_UniChar *uct, size_t numCp, int flags);
static int		UtfNcasecmp(const char *cs, const char *ct,
			    size_t numCp, int flags);
static int		UtfNcmp(const char *cs, const char *ct,
			    size_t numCp, int flags);
#endif

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
	"\x09\x0a\x0b\x0c\x0d " /* ASCII */

	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
	"\xe2\x81\xa0" /* word joiner (U+2060) */
	"\xe3\x80\x80" /* ideographic space (U+3000) */
	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
;

#if TCL_UTF_MAX == 4
/*
 *---------------------------------------------------------------------------
 *
 * MemCmp --
 *
 *	Private wrapper for memcmp(). See C library documentation.
 *
 *---------------------------------------------------------------------------
 */

static int
MemCmp(const void *s1, const void *s2, size_t n, int flags)
{
    return memcmp(s1, s2, n);
}
#endif

#if TCL_UTF_MAX == 4
/*
 *---------------------------------------------------------------------------
 *
 * NumCodePointsUtf --
 *
 *	Like Tcl_NumUtfChars() but returns the number of code points.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
NumCodePointsUtf(
    const char *src,		/* The UTF-8 string to measure. */
    int length,			/* The length of the string in bytes. */
    int *flagPtr)		/* Location to receive end flag. */
{
    Tcl_UniChar ch = 0;
    int len, i = 0;
    const char *endPtr = src + length - TCL_UTF_MAX;

    while (src < endPtr) {
	len = TclUtfToUniChar(src, &ch);
	if (len) {
	    ch = 0;
	} else {
	    len = TclUtfToUniChar(src, &ch);
	}
	src += len;
	i++;
    }
    endPtr += TCL_UTF_MAX;
    while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
	len = TclUtfToUniChar(src, &ch);
	if (len) {
	    ch = 0;
	} else {
	    len = TclUtfToUniChar(src, &ch);
	}
	src += len;
	i++;
    }
    if (src < endPtr) {
	i += endPtr - src;
    }
    return i;
}
#endif

#if TCL_UTF_MAX == 4
/*
 *----------------------------------------------------------------------
 *
 * UtfNcmp --
 *
 *	Like Tcl_UtfNcmp() but the limit is guaranteed and specified in
 *	code points.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numCp,		/* Number of code points to compare. */
    int flags)			/* Flags describing string ends. */
{
    return Tcl_UtfNcmp(cs, ct, numCp);
}
#endif

#if TCL_UTF_MAX == 4
/*
 *----------------------------------------------------------------------
 *
 * UtfNcasecmp --
 *
 *	Like Tcl_UtfNcasecmp() but the limit is guaranteed and specified in
 *	code points.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numCp,		/* Number of code points to compare. */
    int flags)			/* Flags describing string ends. */
{
    return Tcl_UtfNcasecmp(cs, ct, numCp);
}
#endif

#if TCL_UTF_MAX == 4
/*
 *---------------------------------------------------------------------------
 *
 * NumCodePointsUnicode --
 *
 *	Returns the number of code points of a Tcl_UniChar array.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
NumCodePointsUnicode(
    const Tcl_UniChar *src,	/* The array to measure. */
    int length,			/* The length of the array in elements. */
    int *flagPtr)		/* Location to receive end flag. */
{
    int i, n = 0;

    *flagPtr = 0;
    for (i = 0; i < length; i++, n++) {
	if ((src[i] & 0xFC00) == 0xD800) {
	    if (i + 1 >= length) {
		*flagPtr = 1;
	    }
	    if ((i + 1 < length) && ((src[i+1] & 0xFC00) == 0xDC00)) {
		i++;
	    }
	}
    }
    return n;
}
#endif

#if TCL_UTF_MAX == 4
/*
 *----------------------------------------------------------------------
 *
 * UniCharNcmp --
 *
 *	Like Tcl_UniCharNcmp() but the limit is guaranteed and specified in
 *	code points.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numCp,		/* Number of code points to compare. */
    int flags)			/* Flags describing string ends. */
{
    int lcs, lct;

    for ( ; numCp != 0; numCp--, ucs++, uct++) {
	lcs = *ucs;
	lct = *uct;
	if ((lcs & 0xFC00) == 0xD800) {
	    if ((flags & 1) && (numCp == 1)) {
		/* String ends with high surrogate. */
	    } else if ((ucs[1] & 0xFC00) == 0xDC00) {
		lcs = (((lcs&0x3FF)<<10) | (ucs[1]&0x3FF)) + 0x10000;
		ucs++;
	    }
	}
	if ((lct & 0xFC00) == 0xD800) {
	    if ((flags & 2) && (numCp == 1)) {
		/* String ends with high surrogate. */
	    } else if ((uct[1] & 0xFC00) == 0xDC00) {
		lct = (((lct&0x3FF)<<10) | (uct[1]&0x3FF)) + 0x10000;
		uct++;
	    }
	}
	if (lcs != lct) {
	    return (lcs - lct);
	}
    }
    return 0;
}
#endif

#if TCL_UTF_MAX == 4
/*
 *----------------------------------------------------------------------
 *
 * UniCharNcasecmp --
 *
 *	Like Tcl_UniCharNcasecmp() but the limit is guaranteed and specified in
 *	code points.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numCp,		/* Number of code points to compare. */
    int flags)			/* Flags describing string ends. */
{
    int lcs, lct;

    for ( ; numCp != 0; numCp--, ucs++, uct++) {
	lcs = *ucs;
	lct = *uct;
	if ((lcs & 0xFC00) == 0xD800) {
	    if ((flags & 1) && (numCp == 1)) {
		/* String ends with high surrogate. */
	    } else if ((ucs[1] & 0xFC00) == 0xDC00) {
		lcs = (((lcs&0x3FF)<<10) | (ucs[1]&0x3FF)) + 0x10000;
		ucs++;
	    }
	}
	if ((lct & 0xFC00) == 0xD800) {
	    if ((flags & 2) && (numCp == 1)) {
		/* String ends with high surrogate. */
	    } else if ((uct[1] & 0xFC00) == 0xDC00) {
		lct = (((lct&0x3FF)<<10) | (uct[1]&0x3FF)) + 0x10000;
		uct++;
	    }
	}
	if (lcs != lct) {
	    lcs = TclUCS4ToLower(lcs);
	    lct = TclUCS4ToLower(lct);
	    if (lcs != lct) {
		return (lcs - lct);
	    }
	}
    }
    return 0;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PwdObjCmd --
 *
 *	This procedure is invoked to process the "pwd" Tcl command. See the

	 * start of the string unless the previous character is a newline.
	 */

	if (offset == 0) {
	    eflags = 0;
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
		numMatchesSaved, eflags);

	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	int slen, nocase;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p;
#if TCL_UTF_MAX != 4
	Tcl_UniChar wsrclc;
#endif

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
	wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);

		    Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
		    numMatches++;
		}
		wlen = 0;
	    }
	} else {
#if TCL_UTF_MAX != 4
	    wsrclc = Tcl_UniCharToLower(*wsrc);
#endif
	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
		if (
#if TCL_UTF_MAX != 4
		    (*wstring == *wsrc ||
			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
			(slen==1 || (strCmpFn(wstring, wsrc,
				(unsigned long) slen) == 0))
#else
			!strCmpFn(wstring, wsrc, (unsigned long) slen)
#endif
		) {
		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;

	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p;
	int i, uch;
	Tcl_DString ds;

	/*
	 * Make split chars into unicode array.
	 */

	Tcl_DStringInit(&ds);
	p = splitChars;
	while (p < splitChars + splitCharLen) {
	    len = TclUtfToUniChar(p, &ch);
	    uch = ch;
#if TCL_UTF_MAX == 4
	    if (!len) {
	       	len = TclUtfToUniChar(p, &ch);
		uch = (((uch&0x3FF)<<10) | (ch&0x3FF)) + 0x10000;
	    }
#endif
	    Tcl_DStringAppend(&ds, (char *) &uch, sizeof(int));
	    p += len;
	}

	/*
	 * Now have real length of split chars.
	 */

	splitCharLen = Tcl_DStringLength(&ds) / sizeof(int);

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */



	for (element = stringPtr; stringPtr < end; stringPtr += len) {
	    len = TclUtfToUniChar(stringPtr, &ch);
	    uch = ch;
#if TCL_UTF_MAX == 4
	    if (!len) {
		len = TclUtfToUniChar(stringPtr, &ch);
		uch = (((uch&0x3FF)<<10) | (ch&0x3FF)) + 0x10000;
	    }
#endif
	    for (i = 0; i < splitCharLen; i++) {
		if (uch == ((int *)Tcl_DStringValue(&ds))[i]) {
		    TclNewStringObj(objPtr, element, stringPtr - element);
		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
		    element = stringPtr + len;
		    break;
		}
	    }
	}

	TclNewStringObj(objPtr, element, stringPtr - element);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	Tcl_DStringFree(&ds);
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	int mapLen;
	Tcl_UniChar *mapString;
#if TCL_UTF_MAX != 4
	Tcl_UniChar u2lc;
#endif

	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
#if TCL_UTF_MAX != 4
	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
#endif
	    for (; ustring1 < end; ustring1++) {
		if (
#if TCL_UTF_MAX != 4
		    ((*ustring1 == *ustring2) ||
			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
			(length2==1 || strCmpFn(ustring1, ustring2,
				(unsigned long) length2) == 0)
#else
		    !strCmpFn(ustring1, ustring2, (unsigned long) length2)
#endif
		) {
		    if (p != ustring1) {
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
#if TCL_UTF_MAX != 4
	Tcl_UniChar *u2lc = NULL;
#endif
	int *mapLens;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
#if TCL_UTF_MAX != 4
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
	}
#endif
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
#if TCL_UTF_MAX != 4
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
#endif
	}
	for (p = ustring1; ustring1 < end; ustring1++) {
	    for (index = 0; index < mapElemc; index += 2) {
		/*
		 * Get the key string to match on.
		 */

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if (
#if TCL_UTF_MAX != 4
		    (length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, (unsigned) length2))
#else
		    (length2 > 0) && (end-ustring1 >= length2) &&
			!strCmpFn(ustring2, ustring1, (unsigned) length2)
#endif
		) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;

		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }
	}
#if TCL_UTF_MAX != 4
	if (nocase) {
	    TclStackFree(interp, u2lc);
	}
#endif
	TclStackFree(interp, mapLens);
	TclStackFree(interp, mapStrings);
    }
    if (p != ustring1) {
	/*
	 * Put the rest of the unmapped chars onto result.
	 */

    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    int reqlength)		/* requested length; -1 to compare whole
				 * strings */
{
    const char *s1, *s2;
    int empty, length, match, s1len, s2len;
#if TCL_UTF_MAX == 4
    int s1flag = 0, s2flag = 0;
    typedef int (*memCmpFn_t)(const void *, const void *, size_t, int);
#else
    typedef int (*memCmpFn_t)(const void *, const void *, size_t);
#endif
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars or if it is the same obj.
	 */
	return 0;
    }

    if (!nocase && TclIsPureByteArray(value1Ptr)
	    && TclIsPureByteArray(value2Ptr)) {
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
	 */

	s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
#if TCL_UTF_MAX == 4
	memCmpFn = MemCmp;
#else
	memCmpFn = memcmp;
#endif
    } else if ((value1Ptr->typePtr == &tclStringType)
	    && (value2Ptr->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of String
	 * type. If the char length == byte length, we can do a memcmp. In
	 * benchmark testing this proved the most efficient check between the
	 * unicode and string comparison operations.
	 */

	if (nocase) {
	    s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
#if TCL_UTF_MAX == 4
	    s1len = NumCodePointsUnicode((Tcl_UniChar *) s1, s1len, &s1flag);
	    s2len = NumCodePointsUnicode((Tcl_UniChar *) s2, s2len, &s2flag);
	    memCmpFn = (memCmpFn_t) UniCharNcasecmp;
#else
	    memCmpFn = (memCmpFn_t) Tcl_UniCharNcasecmp;
#endif
	} else {
	    s1len = Tcl_GetCharLength(value1Ptr);
	    s2len = Tcl_GetCharLength(value2Ptr);
	    if ((s1len == value1Ptr->length)
		    && (value1Ptr->bytes != NULL)
		    && (s2len == value2Ptr->length)
		    && (value2Ptr->bytes != NULL)) {
		s1 = value1Ptr->bytes;
		s2 = value2Ptr->bytes;
#if TCL_UTF_MAX == 4
		memCmpFn = MemCmp;
#else
		memCmpFn = memcmp;
#endif
	    } else {
		s1 = (char *) Tcl_GetUnicode(value1Ptr);
		s2 = (char *) Tcl_GetUnicode(value2Ptr);
		if (
#ifdef WORDS_BIGENDIAN
			1
#else
			checkEq
#endif /* WORDS_BIGENDIAN */
		        ) {
#if TCL_UTF_MAX == 4
		    memCmpFn = MemCmp;
#else
		    memCmpFn = memcmp;
#endif
		    s1len *= sizeof(Tcl_UniChar);
		    s2len *= sizeof(Tcl_UniChar);
		} else {
#if TCL_UTF_MAX == 4
		    s1len = NumCodePointsUnicode((Tcl_UniChar *) s1,
			    s1len, &s1flag);
		    s2len = NumCodePointsUnicode((Tcl_UniChar *) s2,
			    s2len, &s2flag);
		    memCmpFn = (memCmpFn_t) UniCharNcmp;
#else
		    memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
#endif
		}
	    }
	}
    } else {
	/*
	 * Get the string representations, being careful in case we have
	 * special empty string objects about.

	if (!nocase && checkEq) {
	    /*
	     * When we have equal-length we can check only for (in)equality.
	     * We can use memcmp() in all (n)eq cases because we don't need to
	     * worry about lexical LE/BE variance.
	     */
#if TCL_UTF_MAX == 4
	    memCmpFn = MemCmp;
#else
	    memCmpFn = memcmp;
#endif
	} else {
	    /*
	     * As a catch-all we will work with UTF-8. We cannot use memcmp()
	     * as that is unsafe with any string containing NUL (\xC0\x80 in
	     * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
	     * we are case-sensitive and no specific length was requested.
	     */
#if TCL_UTF_MAX == 4
	    s1len = NumCodePointsUtf(s1, s1len, &s1flag);
	    s2len = NumCodePointsUtf(s2, s2len, &s2flag);
	    memCmpFn = (memCmpFn_t) (nocase ? UtfNcasecmp : UtfNcmp);
#else
	    if ((reqlength < 0) && !nocase) {
		memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
	    } else {
		s1len = Tcl_NumUtfChars(s1, s1len);
		s2len = Tcl_NumUtfChars(s2, s2len);
		memCmpFn = (memCmpFn_t)
			(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	    }
#endif
	}
    }

    length = (s1len < s2len) ? s1len : s2len;
    if (reqlength > 0 && reqlength < length) {
	length = reqlength;
    } else if (reqlength < 0) {

    if (checkEq && (s1len != s2len)) {
	match = 1;		/* This will be reversed below. */
    }  else {
	/*
	 * The comparison function should compare up to the minimum byte
	 * length only.
	 */
#if TCL_UTF_MAX == 4
	match = memCmpFn(s1, s2, (size_t) length, s1flag | (s2flag << 1));
#else
	match = memCmpFn(s1, s2, (size_t) length);
#endif
    }
    if ((match == 0) && (reqlength > length)) {
	match = s1len - s2len;
    }
    return (match > 0) ? 1 : (match < 0) ? -1 : 0;
}


	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
		O2S(valuePtr)));
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	match = 1;
	if (length > 0) {
	    end = ustring1 + length;
	    for (p=ustring1 ; p<end ; p++) {
		int ch = *p;

#if TCL_UTF_MAX == 4
		if (((ch&0xFC00)==0xD800) && (p+1<end)) {
		    if ((p[1]&0xFC00)==0xDC00) {
			ch = ((ch&0x3FF) << 10) + 0x10000 + (p[1]&0x3FF);
			p++;
		    }
		}
#endif
		if (!tclStringClassTable[opnd].comparator(ch)) {
		    match = 0;
		    break;
		}
	    }
	}
	TRACE_APPEND(("%d\n", match));
	JUMP_PEEPHOLE_F(match, 2, 1);

MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);


MODULE_SCOPE int	TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, int reqlength);
MODULE_SCOPE int	TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
			    int *nocase, int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,

MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);

#if TCL_UTF_MAX > 3
MODULE_SCOPE int	TclCollapseSurrogatePair(Tcl_Token *tokenPtr,
			    int *numReadPtr, char *buffer);
#endif
#if TCL_UTF_MAX == 4
MODULE_SCOPE int	TclUCS4ToUpper(int ch);
MODULE_SCOPE int	TclUCS4ToLower(int ch);
MODULE_SCOPE int	TclUCS4ToTitle(int ch);
#else
#define	TclUCS4ToUpper(ch) Tcl_UniCharToUpper((ch))
#define	TclUCS4ToLower(ch) Tcl_UniCharToLower((ch))
#define	TclUCS4ToTitle(ch) Tcl_UniCharToTitle((ch))
#endif

/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
 * optimization (fragile on changes) in one place.
 */

 * The following structure contains the information associated with a
 * character set.
 */

typedef struct CharSet {
    int exclude;		/* 1 if this is an exclusion set. */
    int nchars;
    int *chars;
    int nranges;
    struct Range {
	int start;
	int end;
    } *ranges;
} CharSet;

/*
 * Declarations for functions used only in this file.
 */

#undef UtfToUniChar
static int		UtfToUniChar(const char *string, int *chPtr);
static const char *	BuildCharSet(CharSet *cset, const char *format);
static int		CharInSet(CharSet *cset, int ch);
static void		ReleaseCharSet(CharSet *cset);
static int		ValidateFormat(Tcl_Interp *interp, const char *format,
			    int numVars, int *totalVars);


/*
 *----------------------------------------------------------------------
 *
 * UtfToUniChar --
 *
 *	Wrapper to Tcl_UtfToUniChar() capable of dealing with
 *	UCS4 when compiled with TCL_UTF_MAX == 4.
 *
 * Results:
 *	*chPtr is filled with the full unicode character, and the
 *	return value is the number of bytes from the UTF-8 string that
 *	were consumed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
#if TCL_UTF_MAX != 4
inline
#endif
UtfToUniChar(
    const char *src,
    int *chPtr)
{
    Tcl_UniChar ch = 0;
    int uch, len;

    len = TclUtfToUniChar(src, &ch);
    uch = ch;
#if TCL_UTF_MAX == 4
    if (!len) {
	len = TclUtfToUniChar(src + len, &ch);

	uch = ((uch & 0x3FF) << 10) + 0x10000 + (ch & 0x3FF);
    }
#endif
    *chPtr = uch;
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * BuildCharSet --
 *
 *	This function examines a character set format specification and builds

 */

static const char *
BuildCharSet(
    CharSet *cset,
    const char *format)		/* Points to first char of set. */
{
    int ch, start;
    int offset, nranges;
    const char *end;

    memset(cset, 0, sizeof(CharSet));

    offset = UtfToUniChar(format, &ch);
    if (ch == '^') {
	cset->exclude = 1;
	format += offset;
	offset = UtfToUniChar(format, &ch);
    }
    end = format + offset;

    /*
     * Find the close bracket so we can overallocate the set.
     */

    if (ch == ']') {
	end += UtfToUniChar(end, &ch);
    }
    nranges = 0;
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += UtfToUniChar(end, &ch);
    }

    cset->chars = ckalloc(sizeof(int) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */

    cset->nchars = cset->nranges = 0;
    format += UtfToUniChar(format, &ch);
    start = ch;
    if (ch == ']' || ch == '-') {
	cset->chars[cset->nchars++] = ch;
	format += UtfToUniChar(format, &ch);
    }
    while (ch != ']') {
	if (*format == '-') {
	    /*
	     * This may be the first character of a range, so don't add it
	     * yet.
	     */

	    start = ch;
	} else if (ch == '-') {
	    /*
	     * Check to see if this is the last character in the set, in which
	     * case it is not a range and we should add the previous character
	     * as well as the dash.
	     */

	    if (*format == ']' || !cset->ranges) {
		cset->chars[cset->nchars++] = start;
		cset->chars[cset->nchars++] = ch;
	    } else {
		format += UtfToUniChar(format, &ch);

		/*
		 * Check to see if the range is in reverse order.
		 */

		if (start < ch) {
		    cset->ranges[cset->nranges].start = start;
		    cset->ranges[cset->nranges].end = ch;
		} else {
		    cset->ranges[cset->nranges].start = ch;
		    cset->ranges[cset->nranges].end = start;
		}
		cset->nranges++;
	    }
	} else {
	    cset->chars[cset->nchars++] = ch;
	}
	format += UtfToUniChar(format, &ch);
    }
    return format;
}

/*
 *----------------------------------------------------------------------
 *

 *
 *----------------------------------------------------------------------
 */

static int
CharInSet(
    CharSet *cset,
    int ch)			/* Character to test. */

{

    int i, match = 0;

    for (i = 0; i < cset->nchars; i++) {
	if (cset->chars[i] == ch) {
	    match = 1;
	    break;
	}

    Tcl_Interp *interp,		/* Current interpreter. */
    const char *format,		/* The format string. */
    int numVars,		/* The number of variables passed to the scan
				 * command. */
    int *totalSubs)		/* The number of variables that will be
				 * required. */
{
    int gotXpg, gotSequential, value, i, flags, ch;
    char *end;

    int objIndex, xpgSize, nspace = numVars;
    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
    char buf[TCL_UTF_MAX+1] = "";
    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
				 * these are messy operations because we do
				 * not want to use the formatting engine;
				 * we're inside there! */

    for (i = 0; i < nspace; i++) {
	nassign[i] = 0;
    }

    xpgSize = objIndex = gotXpg = gotSequential = 0;

    while (*format != '\0') {
	format += UtfToUniChar(format, &ch);

	flags = 0;

	if (ch != '%') {
	    continue;
	}
	format += UtfToUniChar(format, &ch);
	if (ch == '%') {
	    continue;
	}
	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += UtfToUniChar(format, &ch);
	    goto xpgCheckDone;
	}

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    /*
	     * Check for an XPG3-style %n$ specification. Note: there must
	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
	     * format string.
	     */

	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
	    if (*end != '$') {
		goto notXpg;
	    }
	    format = end+1;
	    format += UtfToUniChar(format, &ch);
	    gotXpg = 1;
	    if (gotSequential) {
		goto mixedXPG;
	    }
	    objIndex = value - 1;
	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
		goto badIndex;

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
	    flags |= SCAN_WIDTH;
	    format += UtfToUniChar(format, &ch);
	}

	/*
	 * Handle any size specifier.
	 */

	switch (ch) {
	case 'l':
	    if (*format == 'l') {
		flags |= SCAN_BIG;
		format += 1;
		format += UtfToUniChar(format, &ch);
		break;
	    }
	    /* FALLTHRU */
	case 'L':
	    flags |= SCAN_LONGER;
	    /* FALLTHRU */
	case 'h':
	    format += UtfToUniChar(format, &ch);
	}

	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
	    goto badIndex;
	}

	/*

	case '[':
	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
		goto invalidFieldSize;
	    }
	    if (*format == '\0') {
		goto badSet;
	    }
	    format += UtfToUniChar(format, &ch);
	    if (ch == '^') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += UtfToUniChar(format, &ch);
	    }
	    if (ch == ']') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += UtfToUniChar(format, &ch);
	    }
	    while (ch != ']') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += UtfToUniChar(format, &ch);
	    }
	    break;
	badSet:
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched [ in format string", -1));
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
	    goto error;

    int numVars, nconversions, totalVars = -1;
    int objIndex, offset, i, result, code;
    long value;
    const char *string, *end, *baseString;
    char op = 0;
    int width, underflow = 0;
    Tcl_WideInt wideValue;
    int ch, sch;
    Tcl_Obj **objs = NULL, *objPtr = NULL;
    int flags;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string format ?varName ...?");
	return TCL_ERROR;

     * mismatch.
     */

    objIndex = 0;
    nconversions = 0;
    while (*format != '\0') {
	int parseFlag = TCL_PARSE_NO_WHITESPACE;
	format += UtfToUniChar(format, &ch);

	flags = 0;

	/*
	 * If we see whitespace in the format, skip whitespace in the string.
	 */

	if (Tcl_UniCharIsSpace(ch)) {
	    offset = UtfToUniChar(string, &sch);
	    while (Tcl_UniCharIsSpace(sch)) {
		if (*string == '\0') {
		    goto done;
		}
		string += offset;
		offset = UtfToUniChar(string, &sch);
	    }
	    continue;
	}

	if (ch != '%') {
	literal:
	    if (*string == '\0') {
		underflow = 1;
		goto done;
	    }
	    string += UtfToUniChar(string, &sch);
	    if (ch != sch) {
		goto done;
	    }
	    continue;
	}

	format += UtfToUniChar(format, &ch);
	if (ch == '%') {
	    goto literal;
	}

	/*
	 * Check for assignment suppression ('*') or an XPG3-style assignment
	 * ('%n$').
	 */

	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += UtfToUniChar(format, &ch);
	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    char *formatEnd;
	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
	    if (*formatEnd == '$') {
		format = formatEnd+1;
		format += UtfToUniChar(format, &ch);
		objIndex = (int) value - 1;
	    }
	}

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
	    format += UtfToUniChar(format, &ch);
	} else {
	    width = 0;
	}

	/*
	 * Handle any size specifier.
	 */

	switch (ch) {
	case 'l':
	    if (*format == 'l') {
		flags |= SCAN_BIG;
		format += 1;
		format += UtfToUniChar(format, &ch);
		break;
	    }
	    /* FALLTHRU */
	case 'L':
	    flags |= SCAN_LONGER;
	    /* FALLTHRU */
	case 'h':
	    format += UtfToUniChar(format, &ch);
	}

	/*
	 * Handle the various field types.
	 */

	switch (ch) {

	/*
	 * Skip any leading whitespace at the beginning of a field unless the
	 * format suppresses this behavior.
	 */

	if (!(flags & SCAN_NOSKIP)) {
	    while (*string != '\0') {
		offset = UtfToUniChar(string, &sch);
		if (!Tcl_UniCharIsSpace(sch)) {
		    break;
		}
		string += offset;
	    }
	    if (*string == '\0') {
		underflow = 1;

	     */

	    if (width == 0) {
		width = ~0;
	    }
	    end = string;
	    while (*end != '\0') {
		offset = UtfToUniChar(end, &sch);
		if (Tcl_UniCharIsSpace(sch)) {
		    break;
		}
		end += offset;
		if (--width == 0) {
		    break;
		}

	    if (width == 0) {
		width = ~0;
	    }
	    end = string;

	    format = BuildCharSet(&cset, format);
	    while (*end != '\0') {
		offset = UtfToUniChar(end, &sch);
		if (!CharInSet(&cset, sch)) {
		    break;
		}
		end += offset;
		if (--width == 0) {
		    break;
		}
	    }

		objs[objIndex++] = objPtr;
	    }
	    string = end;

	    break;
	}
	case 'c':

	    /*
	     * Scan a single Unicode character.
	     */

	    string += UtfToUniChar(string, &sch);








	    if (!(flags & SCAN_SUPPRESS)) {
		objPtr = Tcl_NewIntObj(sch);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    break;

	case 'i':

/*
 * Functions used only in this module.
 */

static int		UtfCount(int ch);
static int		Invalid(unsigned char *src);






/*
 *---------------------------------------------------------------------------
 *
 * UtfCount --
 *
 *	Find the number of bytes in the Utf character "ch".

	len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX == 4
	upChar = ch;
	if (!len) {
	    len += TclUtfToUniChar(src, &ch);
	    upChar = (((upChar & 0x3FF) << 10) | (ch & 0x3FF)) + 0x10000;
	}
	upChar = TclUCS4ToUpper(upChar);
#else
	upChar = Tcl_UniCharToUpper(ch);
#endif
	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the upper case
	 * char to dst if its size is <= the original char.

	len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX == 4
	lowChar = ch;
	if (!len) {
	    len += TclUtfToUniChar(src, &ch);
	    lowChar = (((lowChar & 0x3FF) << 10) | (ch & 0x3FF)) + 0x10000;
	}
	lowChar = TclUCS4ToLower(lowChar);
#else
	lowChar = Tcl_UniCharToLower(ch);
#endif

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the lower case

	len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX == 4
	titleChar = ch;
	if (!len) {
	    len += TclUtfToUniChar(src, &ch);
	    titleChar = (((titleChar & 0x3FF) << 10) | (ch & 0x3FF)) + 0x10000;
	}
	titleChar = TclUCS4ToTitle(titleChar);
#else
	titleChar = Tcl_UniCharToTitle(ch);
#endif

	if (len < UtfCount(titleChar)) {
	    memmove(dst, src, len);
	    dst += len;

	/* Special exception for Georgian Asomtavruli chars, no titlecase. */
#if TCL_UTF_MAX == 4
	if (!len) {
	    len += TclUtfToUniChar(src, &ch);
	    lowChar = (((lowChar & 0x3FF) << 10) | (ch & 0x3FF)) + 0x10000;
	}
	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
	    lowChar = TclUCS4ToLower(lowChar);
	}
#else
	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
	    lowChar = Tcl_UniCharToLower(lowChar);
	}
#endif

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    int uch1, uch2, len;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
     */

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes. This should be called
	 * only when both strings are of at least n chars long (no need for \0
	 * check)
	 */

	len = TclUtfToUniChar(cs, &ch1);
	uch1 = ch1;
#if TCL_UTF_MAX == 4
	if (!len) {
	    len = TclUtfToUniChar(cs, &ch1);
	    uch1 = (((uch1&0x3FF)<<10) | (ch1&0x3FF)) + 0x10000;
	}
#endif
	cs += len;

	len = TclUtfToUniChar(ct, &ch2);
	uch2 = ch2;
#if TCL_UTF_MAX == 4


	if (!len) {
	    len = TclUtfToUniChar(ct, &ch2);



	    uch2 = (((uch2&0x3FF)<<10) | (ch2&0x3FF)) + 0x10000;
	}
#endif
	ct += len;

	if (uch1 != uch2) {
	    return (uch1 - uch2);
	}

    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    int uch1, uch2, len;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
     */

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes. This should be called
	 * only when both strings are of at least n chars long (no need for \0
	 * check)
	 */

	len = TclUtfToUniChar(cs, &ch1);
	uch1 = ch1;
#if TCL_UTF_MAX == 4
	if (!len) {
	    len = TclUtfToUniChar(cs, &ch1);
	    uch1 = (((uch1&0x3FF)<<10) | (ch1&0x3FF)) + 0x10000;
	}
#endif
	cs += len;

	len = TclUtfToUniChar(ct, &ch2);
	uch2 = ch2;
#if TCL_UTF_MAX == 4


	if (!len) {
	    len = TclUtfToUniChar(ct, &ch2);



	    uch2 = (((uch2&0x3FF)<<10) | (ch2&0x3FF)) + 0x10000;
	}
#endif
	ct += len;

	if (uch1 != uch2) {
	    uch1 = TclUCS4ToLower(uch1);
	    uch2 = TclUCS4ToLower(uch2);
	    if (uch1 != uch2) {
		return (uch1 - uch2);
	    }
	}
    }
    return 0;
}

/*

int
TclUtfCasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct)		/* UTF string cs is compared to. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    int uch1, uch2, len;

    while (*cs && *ct) {
	len = TclUtfToUniChar(cs, &ch1);
	uch1 = ch1;
#if TCL_UTF_MAX == 4
	if (!len) {
	    len = TclUtfToUniChar(cs, &ch1);
	    uch1 = (((uch1&0x3FF)<<10) | (ch1&0x3FF)) + 0x10000;
	}
#endif
	cs += len;

	len = TclUtfToUniChar(ct, &ch2);
	uch2 = ch2;
#if TCL_UTF_MAX == 4


	if (!len) {
	    len = TclUtfToUniChar(ct, &ch2);



	    uch2 = (((uch2&0x3FF)<<10) | (ch2&0x3FF)) + 0x10000;
	}
#endif
	ct += len;

	if (uch1 != uch2) {
	    uch1 = TclUCS4ToLower(uch1);
	    uch2 = TclUCS4ToLower(uch2);
	    if (uch1 != uch2) {
		return (uch1 - uch2);
	    }
	}
    }
    return UCHAR(*cs) - UCHAR(*ct);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToUpper --
 *
 *	Compute the uppercase equivalent of the given Unicode character.
 *
 * Results:
 *	Returns the uppercase Unicode character.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if TCL_UTF_MAX == 4
int
TclUCS4ToUpper(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
	int info = GetUniCharInfo(ch);

	if (GetCaseType(info) & 0x04) {
	    ch -= GetDelta(info);

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if TCL_UTF_MAX == 4
int
TclUCS4ToLower(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

	if ((mode & 0x02) && (mode != 0x7)) {

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if TCL_UTF_MAX == 4
int
TclUCS4ToTitle(
    int ch)			/* Unicode character to convert. */
{
    if (!UNICODE_OUT_OF_RANGE(ch)) {
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

	if (mode & 0x1) {

int
Tcl_UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#if TCL_UTF_MAX == 4
    int lcs, lct, nums = numChars, numt = numChars;

    for ( ; nums != 0 && numt != 0; nums--, numt--, ucs++, uct++) {
	lcs = *ucs;
	lct = *uct;
	if ((nums > 1) && ((lcs & 0xFC00) == 0xD800)) {
	    if ((ucs[1] & 0xFC00) == 0xDC00) {
		lcs = (((lcs&0x3FF)<<10) | (ucs[1]&0x3FF)) + 0x10000;
		ucs++;
		nums--;
	    }
	}
	if ((numt > 1) && ((lct & 0xFC00) == 0xD800)) {
	    if ((uct[1] & 0xFC00) == 0xDC00) {
		lct = (((lct&0x3FF)<<10) | (uct[1]&0x3FF)) + 0x10000;
		uct++;
		numt--;
	    }
	}
	if (lcs != lct) {
	    return (lcs - lct);
	}
    }
    return 0;
#else
#ifdef WORDS_BIGENDIAN
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));

#else /* !WORDS_BIGENDIAN */
    /*
     * We can't simply call memcmp() because that is not lexically correct.
     */

    for ( ; numChars != 0; ucs++, uct++, numChars--) {
	if (*ucs != *uct) {
	    return (*ucs - *uct);
	}
    }
    return 0;
#endif /* WORDS_BIGENDIAN */
#endif /* TCL_UTF_MAX == 4 */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharNcasecmp --
 *

int
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#if TCL_UTF_MAX == 4
    int lcs, lct, nums = numChars, numt = numChars;

    for ( ; nums != 0 && numt != 0; nums--, numt--, ucs++, uct++) {
	lcs = *ucs;
	lct = *uct;
	if ((nums > 1) && ((lcs & 0xFC00) == 0xD800)) {
	    if ((ucs[1] & 0xFC00) == 0xDC00) {
		lcs = (((lcs&0x3FF)<<10) | (ucs[1]&0x3FF)) + 0x10000;
		ucs++;
		nums--;
	    }
	}
	if ((numt > 1) && ((lct & 0xFC00) == 0xD800)) {
	    if ((uct[1] & 0xFC00) == 0xDC00) {
		lct = (((lct&0x3FF)<<10) | (uct[1]&0x3FF)) + 0x10000;
		uct++;
		numt--;
	    }
	}
	if (lcs != lct) {
	    lcs = TclUCS4ToLower(lcs);
	    lct = TclUCS4ToLower(lct);
	    if (lcs != lct) {
		return (lcs - lct);
	    }
	}
    }
#else
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
		return (lcs - lct);
	    }
	}
    }
#endif
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlnum --

Tcl_UniCharCaseMatch(
    const Tcl_UniChar *uniStr,	/* Unicode String. */
    const Tcl_UniChar *uniPattern,
				/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
#if TCL_UTF_MAX == 4
    int strLen = 0, ptnLen = 0;

    while (uniStr[strLen] != 0) {
	strLen++;
    }
    while (uniPattern[ptnLen] != 0) {
	ptnLen++;
    }
    return TclUniCharMatch(uniStr, strLen, uniPattern, ptnLen, nocase);
#else
    Tcl_UniChar ch1 = 0, p;

    while (1) {
	p = *uniPattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,

	    }
	} else if (*uniStr != *uniPattern) {
	    return 0;
	}
	uniStr++;
	uniPattern++;
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharMatch --
 *

    int strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    int ptnLen,			/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    int p;
#if TCL_UTF_MAX == 4
    int q;
#endif

    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 TCL_UTF_MAX == 4
	if ((p & 0xFC00) == 0xD800) {
	    if ((pattern + 1 < patternEnd) &&
		    ((pattern[1] & 0xFC00) == 0xDC00)) {
		p = (((p&0x3FF)<<10) | (pattern[1]&0x3FF)) + 0x10000;
		++pattern;
	    }
	}
#endif
	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

	    while (*(++pattern) == '*') {
		/* empty body */
	    }
	    if (pattern == patternEnd) {
		return 1;
	    }
	    p = *pattern;
#if TCL_UTF_MAX == 4
	    if ((p & 0xFC00) == 0xD800) {
		if ((pattern + 1 < patternEnd) &&
			((pattern[1] & 0xFC00) == 0xDC00)) {
		    p = (((p&0x3FF)<<10) | (pattern[1]&0x3FF)) + 0x10000;
		    ++pattern;
		}
	    }
#endif

	    if (nocase) {
		p = Tcl_UniCharToLower(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 TCL_UTF_MAX == 4
		    while (string < stringEnd) {
			q = *string;
			if ((q & 0xFC00) == 0xD800) {
			    if ((string + 1 < stringEnd) &&
				    ((string[1] & 0xFC00) == 0xDC00)) {
				q = (((q&0x3FF)<<10) | (string[1]&0x3FF))
					+ 0x10000;
			    }
			}
			if ((p == q) || (nocase &&
				(p == TclUCS4ToLower(q)))) {
			    break;
			}
			if (q > 0xFFFF) {
			    string++;
			}
			string++;
		    }
#else
		    if (nocase) {
			while ((string < stringEnd) && (p != *string)
				&& (p != Tcl_UniCharToLower(*string))) {
			    string++;
			}
		    } else {
			while ((string < stringEnd) && (p != *string)) {
			    string++;
			}
		    }
#endif
		}
		if (TclUniCharMatch(string, stringEnd - string,
			pattern, patternEnd - pattern, nocase)) {
		    return 1;
		}
		if (string == stringEnd) {
		    return 0;
		}
#if TCL_UTF_MAX == 4
		if ((string[0] & 0xFC00) == 0xD800) {
		    if ((string + 1 < stringEnd) &&
			    ((string[1] & 0xFC00) == 0xDC00)) {
			string++;
		    }
		}
#endif
		string++;
	    }
	}

	/*
	 * Check for a "?" as the next pattern character. It matches any
	 * single character.
	 */

	if (p == '?') {
	    pattern++;
#if TCL_UTF_MAX == 4
	    if ((string[0] & 0xFC00) == 0xD800) {
		if ((string + 1 < stringEnd) &&
			((string[1] & 0xFC00) == 0xDC00)) {
		    string++;
		}
	    }
#endif
	    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 == '[') {
	    int ch1, startChar, endChar;

	    pattern++;
#if TCL_UTF_MAX == 4
	    ch1 = *string;
	    if ((ch1 & 0xFC00) == 0xD800) {
		if ((string + 1 < stringEnd) &&
			((string[1] & 0xFC00) == 0xDC00)) {
		    ch1 = (((ch1&0x3FF)<<10) | (string[1]&0x3FF)) + 0x10000;
		    string++;
		}
	    }
	    if (nocase) {
		ch1 = TclUCS4ToLower(ch1);
	    }
#else
	    ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
#endif
	    string++;
	    while (1) {
		if ((*pattern == ']') || (pattern == patternEnd)) {
		    return 0;
		}
#if TCL_UTF_MAX == 4
		startChar = *pattern;
		if ((startChar & 0xFC00) == 0xD800) {
		    if ((pattern + 1 < patternEnd) &&
			    ((pattern[1] & 0xFC00) == 0xDC00)) {
			startChar = (((startChar&0x3FF)<<10) |
					(pattern[1]&0x3FF)) + 0x10000;
			pattern++;
		    }
		}
	 	if (nocase) {
		    startChar = TclUCS4ToLower(startChar);
		}
#else
		startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
#endif
		pattern++;
		if (*pattern == '-') {
		    pattern++;
		    if (pattern == patternEnd) {
			return 0;
		    }
#if TCL_UTF_MAX == 4
		    endChar = *pattern;
		    if ((endChar & 0xFC00) == 0xD800) {
			if ((pattern + 1 < patternEnd) &&
				((pattern[1] & 0xFC00) == 0xDC00)) {
			    endChar = (((endChar&0x3FF)<<10) |
					    (pattern[1]&0x3FF)) + 0x10000;
			    pattern++;
			}
		    }
		    if (nocase) {
			endChar = TclUCS4ToLower(endChar);
		    }
#else
		    endChar = (nocase ? Tcl_UniCharToLower(*pattern)
			    : *pattern);
#endif
		    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++;
	    }
#if TCL_UTF_MAX == 4
	    if ((pattern[0] & 0xFC00) == 0xD800) {
		if ((pattern + 1 < patternEnd) &&
			((pattern[1] & 0xFC00) == 0xDC00)) {
		    pattern++;
		}
	    }
#endif
	    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 TCL_UTF_MAX == 4
	p = *pattern;
	if ((p & 0xFC00) == 0xD800) {
	    if ((pattern + 1 < patternEnd) &&
		    ((pattern[1] & 0xFC00) == 0xDC00)) {
		p = (((p&0x3FF)<<10) | (pattern[1]&0x3FF)) + 0x10000;
		pattern++;
	    }
	}
	q = *string;
	if ((q & 0xFC00) == 0xD800) {
	    if ((string + 1 < stringEnd) &&
		    ((string[1] & 0xFC00) == 0xDC00)) {
		q = (((q&0x3FF)<<10) | (string[1]&0x3FF)) + 0x10000;
		string++;
	    }
	}
	if (nocase) {
	    if (TclUCS4ToLower(q) != TclUCS4ToLower(p)) {
		return 0;
	    }
	} else if (q != p) {
	    return 0;
	}
#else
	if (nocase) {
	    if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
		return 0;
	    }
	} else if (*string != *pattern) {
	    return 0;
	}
#endif
	string++;
	pattern++;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 * closely tied together with the rules for parsing and evaluating scripts,
 * and will need to evolve in sync.
 */

/*
 *----------------------------------------------------------------------
 *
 * UtfToUniChar --
 *
 *	Wrapper to Tcl_UtfToUniChar() capable of dealing with
 *	UCS4 when compiled with TCL_UTF_MAX > 3.
 *
 * Results:
 *	*chPtr is filled with the full unicode character, and the
 *	return value is the number of bytes from the UTF-8 string that
 *	were consumed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
#if TCL_UTF_MAX != 4
inline
#endif
UtfToUniChar(
    const char *src,
    int *chPtr)
{
    Tcl_UniChar ch = 0;
    int uch, len;

    len = TclUtfToUniChar(src, &ch);
    uch = ch;
#if TCL_UTF_MAX == 4
    if (!len) {
	len = TclUtfToUniChar(src, &ch);
	uch = ((uch & 0x3FF) << 10) + 0x10000 + (ch & 0x3FF);
    }
#endif
    *chPtr = uch;
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMaxListLength --
 *
 *	Given 'bytes' pointing to 'numBytes' bytes, scan through them and
 *	count the number of whitespace runs that could be list element
 *	separators. If 'numBytes' is -1, scan to the terminating '\0'. Not a
 *	full list parser. Typically used to get a quick and dirty overestimate
 *	of length size in order to allocate space for an actual list parser to

Tcl_Backslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr)		/* Fill in with number of characters read from
				 * src, unless NULL. */
{
    char buf[TCL_UTF_MAX*2];
    int ch;

    buf[0] = '\0';
    Tcl_UtfBackslash(src, readPtr, buf);
    UtfToUniChar(buf, &ch);
    return (char) ch;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimRight --

 *----------------------------------------------------------------------
 */

int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
			/* Calls to UtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
			/* Calls to UtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *pp, *p = bytes + numBytes, *q;
    int i;
    Tcl_DString ds;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * See if we can optimize.
     */

    for (i = 0; i < numTrim; i++) {
	if (UCHAR(trim[i]) >= 0x80) {
	    goto slowPath;
	}
    }

    /*
     * Same logic as below, but working with plain ASCII trim string.
     */
 
    do {
	for (i = 0; i < numTrim; i++) {
	    if (p[-1] == trim[i]) {
		break;
	    }
	}
	if (i >= numTrim) {
	    break;
	}
	p--;
    } while (p > bytes);

    goto done;

    /*
     * Make trim string into unicode array.
     */

slowPath:
    Tcl_DStringInit(&ds);
    q = trim;
    do {
	int uch = 0, qInc = UtfToUniChar(q, &uch);

	q += qInc;
	Tcl_DStringAppend(&ds, (char *) &uch, sizeof(int));
    } while (q < trim + numTrim);
    numTrim = Tcl_DStringLength(&ds) / sizeof(int);

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	int uch, pInc = 0;

	pp = TclUtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = UtfToUniChar(pp, &uch);
	} while (pp + pInc < p);


	/*
	 * Inner loop: scan trim string for match to current character.
	 */



	for (i = 0; i < numTrim; i++) {
	    if (uch == ((int *)Tcl_DStringValue(&ds))[i]) {
		break;
	    }
	}




	if (i >= numTrim) {
	    /*
	     * No match; trim task done; *p is last non-trimmed char.
	     */

	    break;
	}
	p = pp;
    } while (p > bytes);

    Tcl_DStringFree(&ds);

done:
    return numBytes - (p - bytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimLeft --

 *----------------------------------------------------------------------
 */

int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
			/* Calls to UtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    int numTrim)	/* ...and its length in bytes */
			/* Calls to UtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *p = bytes, *q;
    int i;
    Tcl_DString ds;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * See if we can optimize.
     */

    for (i = 0; i < numTrim; i++) {
	if (UCHAR(trim[i]) >= 0x80) {
	    goto slowPath;
	}
    }

    /*
     * Same logic as below, but working with plain ASCII trim string.
     */

    do {
	for (i = 0; i < numTrim; i++) {
	    if (p[0] == trim[i]) {
		break;
	    }
	}
	if (i >= numTrim) {
	    break;
	}
	p++;
	numBytes--;
    } while (numBytes > 0);

    goto done;

    /*
     * Make trim string into unicode array.
     */

slowPath:
    Tcl_DStringInit(&ds);
    q = trim;
    do {
	int uch = 0, qInc = UtfToUniChar(q, &uch);

	q += qInc;
	Tcl_DStringAppend(&ds, (char *) &uch, sizeof(int));
    } while (q < trim + numTrim);
    numTrim = Tcl_DStringLength(&ds) / sizeof(int);

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {

	int uch = 0, pInc = UtfToUniChar(p, &uch);



	/*
	 * Inner loop: scan trim string for match to current character.
	 */



	for (i = 0; i < numTrim; i++) {
	    if (uch == ((int *)Tcl_DStringValue(&ds))[i]) {
		break;
	    }
	}




	if (i >= numTrim) {
	    /*
	     * No match; trim task done; *p is first non-trimmed char.
	     */

	    break;
	}

	p += pInc;
	numBytes -= pInc;
    } while (numBytes > 0);

    Tcl_DStringFree(&ds);

done:
    return p - bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrim --

	/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
	trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
	numBytes -= trimLeft;

	/* If we did not trim the whole string, it starts with a character
	 * that we will not trim. Skip over it. */
	if (numBytes > 0) {

	    int len, uch;
	    const char *first = bytes + trimLeft;

	    len = UtfToUniChar(first, &uch);





	    bytes += len;
	    numBytes -= (bytes - first);

	    if (numBytes > 0) {
		/* When bytes is NUL-terminated, returns
		 * 0 <= trimRight <= numBytes */
		trimRight = TclTrimRight(bytes, numBytes, trim, numTrim);

int
Tcl_StringCaseMatch(
    const char *str,		/* String. */
    const char *pattern,	/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    int p, charLen, ch1, ch2;


    while (1) {
	p = *pattern;

	/*
	 * 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

	    }

	    /*
	     * This is a special case optimization for single-byte utf.
	     */

	    if (UCHAR(*pattern) < 0x80) {
		ch2 = (int)
			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
	    } else {
		UtfToUniChar(pattern, &ch2);
		if (nocase) {
		    ch2 = TclUCS4ToLower(ch2);
		}
	    }

	    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 (*str) {
			    charLen = UtfToUniChar(str, &ch1);
			    if (ch2==ch1 || ch2==TclUCS4ToLower(ch1)) {
				break;
			    }
			    str += charLen;
			}
		    } else {
			/*
			 * There's no point in trying to make this code
			 * shorter, as the number of bytes you want to compare
			 * each time is non-constant.
			 */

			while (*str) {
			    charLen = UtfToUniChar(str, &ch1);
			    if (ch2 == ch1) {
				break;
			    }
			    str += charLen;
			}
		    }
		}
		if (Tcl_StringCaseMatch(str, pattern, nocase)) {
		    return 1;
		}
		if (*str == '\0') {
		    return 0;
		}
		str += UtfToUniChar(str, &ch1);
	    }
	}

	/*
	 * Check for a "?" as the next pattern character. It matches any
	 * single character.
	 */

	if (p == '?') {
	    pattern++;
	    str += UtfToUniChar(str, &ch1);
	    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 == '[') {
	    int startChar = 0, endChar = 0;

	    pattern++;
	    if (UCHAR(*str) < 0x80) {
		ch1 = (int)
			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
		str++;
	    } else {
		str += UtfToUniChar(str, &ch1);
		if (nocase) {
		    ch1 = TclUCS4ToLower(ch1);
		}
	    }
	    while (1) {
		if ((*pattern == ']') || (*pattern == '\0')) {
		    return 0;
		}
		if (UCHAR(*pattern) < 0x80) {
		    startChar = (int) (nocase
			    ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
		    pattern++;
		} else {
		    pattern += UtfToUniChar(pattern, &startChar);
		    if (nocase) {
			startChar = TclUCS4ToLower(startChar);
		    }
		}
		if (*pattern == '-') {
		    pattern++;
		    if (*pattern == '\0') {
			return 0;
		    }
		    if (UCHAR(*pattern) < 0x80) {
			endChar = (int) (nocase
				? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
			pattern++;
		    } else {
			pattern += UtfToUniChar(pattern, &endChar);
			if (nocase) {
			    endChar = TclUCS4ToLower(endChar);
			}
		    }
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

	}

	/*
	 * There's no special character. Just make sure that the next bytes of
	 * each string match.
	 */

	str += UtfToUniChar(str, &ch1);
	pattern += UtfToUniChar(pattern, &ch2);
	if (nocase) {
	    if (TclUCS4ToLower(ch1) != TclUCS4ToLower(ch2)) {
		return 0;
	    }
	} else if (ch1 != ch2) {
	    return 0;
	}
    }
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
testConstraint testobj [llength [info commands testobj]]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]

test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort
} -result {wrong # args: should be "lsort ?-option value ...? list"}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort -foo {1 3 2 5}
} -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique}

    test_lsort 0
} -result 0 -cleanup {
    rename test_lsort ""
}
test cmdIL-5.6 {lsort with multiple list-style index options} {
    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
} {{a b} {b e} {c d}}
test cmdIL-5.7 {lsort unicode beyond U+FFFF} fullutf {
    lsort {\uD83D\uDE03 \uD83D\uDE02 \uD83D\uDE04}
} "\uD83D\uDE02 \uD83D\uDE03 \uD83D\udE04"
test cmdIL-5.7 {lsort unicode beyond U+FFFF} fullutf {
    lsort -decreasing {\uD83D\uDE03 \uD83D\uDE02 \uD83D\uDE04}
} "\uD83D\uDE04 \uD83D\uDE03 \uD83D\udE02"
test cmdIL-5.8 {lsort unicode beyond U+FFFF} fullutf {
    lsort -nocase {\U0001F603 \U0001F602 \U0001F604}
} "\U0001F602 \U0001F603 \U0001F604"
test cmdIL-5.9 {lsort unicode beyond U+FFFF} fullutf {
    lsort -dictionary {\U0001F603x1 \U0001F602y1 \U0001F602y \U0001F603xx}
} "\U0001F602y \U0001F602y1 \U0001F603x1 \U0001F603xx"
test cmdIL-5.9 {lsort unicode beyond U+FFFF} fullutf {
    lsort -dictionary {b\U0001F60320 c\U0001F60230 c\U0001F6023x b\U0001F6032}
} "b\U0001F6032 b\U0001F60320 c\U0001F6023x c\U0001F60230"
test cmdIL-5.10 {lsort unicode beyond U+FFFF} fullutf {
    lsort -nocase {b\U00010428a B\U00010400C}
} "b\U00010428a B\U00010400C"
test cmdIL-5.11 {lsort unicode beyond U+FFFF} fullutf {
    lsort -dictionary -nocase {b\U00010428a B\U00010400C}
} "b\U00010428a B\U00010400C"

# Compiled version
test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
    apply {{} { lassign }}
} -result {wrong # args: should be "lassign list ?varName ...?"}
test cmdIL-6.2 {lassign command syntax} {
    apply {{} { lassign x }}

	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}

    return $d
} Inf
test scan-14.2 {negative infinity} {
    scan -Inf %g d
    return $d
} -Inf

# scan unicode

test scan-15.1 {full unicode} fullutf {
    scan X\U1F602 X%c a
    return $a
} [expr {0x1F602}]
test scan-15.2 {full unicode} fullutf {
    scan \U1F602\uD83D\uDE04Hello %c%\[\U0001F604\]%s a b c
    return [list $a $b $c]
} [list [expr {0x1F602}] \uD83D\uDE04 Hello]
test scan-15.3 {full unicode} fullutf {
    scan \U1F602Hello\uD83D\uDE04 %c%\[^\U0001F604\]%s a b c
    return [list $a $b $c]
} [list [expr {0x1F602}] Hello \uD83D\uDE04]
test scan-15.4 {full unicode} fullutf {
    scan \U1F602\uD83D\uDE03Hello %\[\U0001F602-\U0001F604\] a
    return $a
} \uD83D\uDE02\U1F603
test scan-15.5 {full unicode} fullutf {
    scan \U1F602\uD83D\uDE03Hello123 %\[\U0001F602-\U0001F604a-zA-Z\] a
    return $a
} \uD83D\uDE02\U1F603Hello

# TODO - also need to scan NaN's

catch {rename int_range {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]

test split-1.1 {basic split commands} {
    split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}
test split-1.2 {basic split commands} {
    split "word 1xyzword 2zword 3" xyz
} {{word 1} {} {} {word 2} {word 3}}

} {{} ab cd {} ef {}}
test split-1.13 {basic split commands} {
    split "12,34,56," {,}
} {12 34 56 {}}
test split-1.14 {basic split commands} {
    split ",12,,,34,56," {,}
} {{} 12 {} {} 34 56 {}}
test split-1.15 {basic split commands} fullutf {
    split "a\U0001F4A9b" {}
} "a \U0001F4A9 b"
test split-1.16 {basic split commands} fullutf {
    split "\uD83D\uDE02Hello\uD83D\uDE02World\uD83D\uDE02" \U0001F602
} {{} Hello World {}}
test split-1.17 {basic split commands} fullutf {
    split "\U0001F602Hello\U0001F602World\U0001F602" \uD83D\uDE02
} {{} Hello World {}}
test split-1.18 {basic split commands} fullutf {
    split "\U0001F602\U0001F602\U0001F602" \uD83D\uDE02
} {{} {} {} {}}
test split-1.19 {basic split commands} fullutf {
    proc foo args {
        tailcall split {*}$args
    }
    foo "\U0001F602Hello\U0001F602World\U0001F602" \U0001F602
} {{} Hello World {}}

test split-2.1 {split errors} {
    list [catch split msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
test split-2.2 {split errors} {
    list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint testbytestring  [expr {[info commands testbytestring] != {}}]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

test string-1.1 {error conditions} {

} 6
test string-21.13 {string wordend, unicode} {
    string wordend "xyz\u2045de fg" 0
} 3
test string-21.14 {string wordend, unicode} {
    string wordend "\uC700\uC700 abc" 8
} 6
test string-21.15 {string trim, unicode} fullutf {
    string trim "\U1F602Hello world!\U1F602" \U1F602
} "Hello world!"
test string-21.16 {string trimleft, unicode} fullutf {
    string trimleft "\U1F602Hello world!\U1F602" \U1F602
} "Hello world!\U1F602"
test string-21.17 {string trimright, unicode} fullutf {
    string trimright "\U1F602Hello world!\U1F602" \U1F602
} "\U1F602Hello world!"

test string-22.1 {string wordstart} {
    list [catch {string word a} msg] $msg
} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2 {string wordstart} {
    list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {

    } 0 {}
    {binary neq} {
	string compare [binary format a100a 0 1] [binary format a100a 0 0]
    } 1 {}
    {binary neq inequal length} {
	string compare [binary format a20a 0 1] [binary format a100a 0 0]
    } 1 {}
    {unicode corner cases} {
	string compare \uD7FF \uD800]
    } -1 {}
    {unicode corner cases} {
	string compare \uD800\uD7FF \uD800\uD800]
    } -1 {}
    {unicode corner cases} {
	string compare \uD800\uD800 \uD800\uD7FF]
    } 1 {}
    {unicode corner cases} {
	string compare \uDBFF \uDC00
    } -1 {}
    {unicode corner cases} {
	string compare \uD83D \uDE00
    } -1 {}
    {unicode corner cases} {
	string compare \uE000 \uDFFF
    } 1 {}
    {unicode beyond U+FFFF} {
	string compare \uFFFF \U00010000
    } -1 {}
    {unicode beyond U+FFFF} {
	string compare \U00010000 \U0000FFFF
    } 1 {}
    {unicode beyond U+FFFF} {
	string compare ab \U0001F600\U0001F601\U0001F602\U0001F603
    } -1 {}
    {unicode beyond U+FFFF} {
	string compare \U0001F600\U0001F601\U0001F602\U0001F603 ab
    } 1 {}
    {unicode beyond U+FFFF} {
	string compare \U0001F601\U0001F602 \U0001F600\U0001F601
    } 1 {}
    {unicode beyond U+FFFF} {
	string compare \uD83D\uDE00\uD83D\uDE01 \U0001F600\U0001F601
    } 0 {}
    {unicode beyond U+FFFF} {
	string compare \uD83D\uDE00 \uD83D\uDE01\U0001F600\U0001F601
    } -1 {}
} {
    if {$tname eq ""} { continue }
    if {$tcode eq ""} { set tcode ok }
    # not nice but...
    if {$tname in {{unicode corner cases} {unicode beyond U+FFFF}}} {
        set cnstr fullutf
    } else {
        set cnstr {}
    }
    test stringComp-2.[incr i] "string compare, $tname" \
	-body [list eval $tbody] \
	-returnCodes $tcode -result $tresult -constraints $cnstr
    test stringComp-2.[incr i] "string compare bc, $tname" \
	-body "[list proc foo {} $tbody];foo" \
	-returnCodes $tcode -result $tresult -constraints $cnstr
    if {"error" ni $tcode} {
	set tresult [expr {!$tresult}]
    } else {
	set tresult [string map {compare equal} $tresult]
    }
    set tbody [string map {compare equal} $tbody]
    test stringComp-2.[incr i] "string equal, $tname" \
	-body [list eval $tbody] \
	-returnCodes $tcode -result $tresult -constraints $cnstr
    test stringComp-2.[incr i] "string equal bc, $tname" \
	-body "[list proc foo {} $tbody];foo" \
	-returnCodes $tcode -result $tresult -constraints $cnstr
}

# need a few extra tests short abbr cmd
test stringComp-3.1 {string compare, shortest method name} {
    proc foo {} {string co abcde ABCDE}
    foo
} 1

		[string match *a*l*\u0000*123 $longString] \
		[string match *a*l*\u0000*123* $longString] \
		[string match *a*l*\u0000*cba* $longString] \
		[string match *===* $longString]
    }
    foo
} {0 1 1 1 0 0}
test stringComp-11.55 {string match, unicode} fullutf {
    string match *\U1F602* Hello\U1F602World
} 1
test stringComp-11.56 {string match, unicode} fullutf {
    string match *\[\U1F602\]* Hello\U1F602World
} 1
test stringComp-11.57 {string match, unicode} fullutf {
    string match *\[\U1F602-\U1F604\]* Hello\U1F603World
} 1
test stringComp-11.58 {string match, unicode} fullutf {
    proc foo {p s} {
        return [string match $p $s]
    }
    list \
        [foo *\[\U1F602-\U1F604\]* Hello\uD83D\uDE03World] \
        [foo *\[\U1F602-\U1F604\]* Hello\uD83D\uDE05World] \
        [foo *\[\U1F602-\U1F604\]* Hello\uD83DWorld] \
        [foo *\[\U1F602-\U1F604\]* Hello\uDE02World\uDE04] \
        [foo *\[\U1F602-\U1F604\]* Hello\uD83DW\uDE03]
} {1 0 0 0 0}

## string range
test stringComp-12.1 {Bug 3588366: end-offsets before start} {
    apply {s {
	string range $s 0 end-5
    }} 12345
} {}

    incr count
}
variable count 1
UniCharCaseCmpTest < a b
UniCharCaseCmpTest > b a
UniCharCaseCmpTest > B a
UniCharCaseCmpTest > aBcB abca
UniCharCaseCmpTest < \uFFFF [format %c 0x10000] fullutf
UniCharCaseCmpTest < \uFFFF \U10000		fullutf
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF	fullutf
UniCharCaseCmpTest > \U10000 \uFFFF		fullutf





unset count
rename UniCharCaseCmpTest {}