Tcl Source Code

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

int
TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    int reqlength)		/* requested length in characters; -1 to
				 * compare whole strings */
{
    const char *s1, *s2;
    int empty, length, match, s1len, s2len;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*

	s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	memCmpFn = memcmp;
    } 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);
	    memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
	} else {
	    s1len = Tcl_GetCharLength(value1Ptr);
	    s2len = Tcl_GetCharLength(value2Ptr);
	    if ((s1len == value1Ptr->length)
		    && (value1Ptr->bytes != NULL)
		    && (s2len == value2Ptr->length)
		    && (value2Ptr->bytes != NULL)) {
		/* each byte represents one character so s1l3n, s2l3n, and
		 * reqlength are in both bytes and characters
		 */
		s1 = value1Ptr->bytes;
		s2 = value2Ptr->bytes;
		memCmpFn = memcmp;
	    } else {
		s1 = (char *) Tcl_GetUnicode(value1Ptr);
		s2 = (char *) Tcl_GetUnicode(value2Ptr);
		if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4)
		    1
#else
		    checkEq
#endif /* WORDS_BIGENDIAN */
		) {
		    memCmpFn = memcmp;
		    s1len *= sizeof(Tcl_UniChar);
		    s2len *= sizeof(Tcl_UniChar);
		    if (reqlength > 0) {
			reqlength *= sizeof(Tcl_UniChar);
		    }
		} else {
		    memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
		}
	    }
	}
    } else {
	/*

		return 0;
	    }
	} else {
	    s1 = TclGetStringFromObj(value1Ptr, &s1len);
	    s2 = TclGetStringFromObj(value2Ptr, &s2len);
	}

	if (!nocase && checkEq && reqlength < 0) {
	    /*
	     * 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.
	     */
	    memCmpFn = memcmp;
	} 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 ((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);
	    }
	}
    }

    /* At this point s1len, s2len, and reqlength should by now have been
     * adjusted so that they are all in the units expected by the selected
     * comparison function.
     */

    length = (s1len < s2len) ? s1len : s2len;
    if (reqlength > 0 && reqlength < length) {
	length = reqlength;
    } else if (reqlength < 0) {
	/*
	 * The requested length is negative, so ignore it by setting it to
	 * length + 1 to correct the match var.
	 */

	reqlength = length + 1;
    }

    if (checkEq && reqlength < 0 && (s1len != s2len)) {
	match = 1;		/* This will be reversed below. */
    } else {
	/*
	 * The comparison function should compare up to the minimum byte
	 * length only.
	 */
	match = memCmpFn(s1, s2, length);

    {unicode} {
	string compare ab\u7266 ab\u7267
    } {-1} {}
    {unicode} {string compare \334 \u00dc} 0 {}
    {unicode} {string compare \334 \u00fc} -1 {}
    {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
    {high bit} {
	# This test fails if the underlying comparison
	# is using signed chars instead of unsigned chars.
	# (like SunOS's default memcmp thus the compat/memcmp.c)
	string compare "\x80" "@"
	# Nb this tests works also in utf-8 space because \x80 is
	# translated into a 2 or more bytelength but whose first byte has
	# the high bit set.
    } {1} {}

    } 0 {}
    {-nocase null strings} {
	string compare -nocase "" foo
    } -1 {}
    {-nocase null strings} {
	string compare -nocase foo ""
    } 1 {}
    {with length, unequal strings, partial first string} {
	string compare -length 2 abc abde
    } 0 {}
    {with length, unequal strings 2, full first string} {
	string compare -length 2 ab abde
    } 0 {}
    {with NUL character vs. other ASCII} {
	# Be careful here, since UTF-8 rep comparison with memcmp() of
	# these puts chars in the wrong order
	string compare \x00 \x01
    } -1 {}