diff options
-rw-r--r-- | generic/tclCmdMZ.c | 2 | ||||
-rw-r--r-- | generic/tclStringObj.c | 31 | ||||
-rw-r--r-- | tests/string.test | 8 |
3 files changed, 26 insertions, 15 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 147c2dc..817416a 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2673,7 +2673,7 @@ StringEqualCmd( */ objv += objc-2; - match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); + match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 25bf34b..723d2e5 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3859,9 +3859,10 @@ TclStringCmp( Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - int reqlength) /* requested length */ + int reqlength) /* requested length in characters; + * TCL_INDEX_NONE to compare whole strings */ { - char *s1, *s2; + const char *s1, *s2; int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; @@ -3886,10 +3887,10 @@ TclStringCmp( } else if (TclHasInternalRep(value1Ptr, &tclUniCharStringType) && TclHasInternalRep(value2Ptr, &tclUniCharStringType)) { /* - * 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. + * 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) { @@ -3903,6 +3904,9 @@ TclStringCmp( && (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; @@ -3919,6 +3923,9 @@ TclStringCmp( memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); + if (reqlength > 0) { + reqlength *= sizeof(Tcl_UniChar); + } } else { memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp; } @@ -3960,7 +3967,7 @@ TclStringCmp( s1 = TclGetStringFromObj(value1Ptr, &s1len); s2 = TclGetStringFromObj(value2Ptr, &s2len); } - if (!nocase && checkEq) { + 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 @@ -3988,19 +3995,23 @@ TclStringCmp( } } + /* 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 we ignore it by setting it - * to length + 1 so we correct the match var. + * The requested length is negative, so ignore it by setting it + * to length + 1 to correct the match var. */ reqlength = length + 1; } - if (checkEq && (s1len != s2len)) { + if (checkEq && reqlength < 0 && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* diff --git a/tests/string.test b/tests/string.test index 6623f04..ade673e 100644 --- a/tests/string.test +++ b/tests/string.test @@ -134,7 +134,7 @@ test string-2.11.3.$noComp {string compare, unicode} { run {string compare ÜÜÜüü ÜÜÜÜÜ} } 1 test string-2.12.$noComp {string compare, high bit} { - # This test will fail if the underlying comparison + # 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) run {string compare "\x80" "@"} @@ -198,10 +198,10 @@ test string-2.26.$noComp {string compare -nocase, null strings} { test string-2.27.$noComp {string compare -nocase, null strings} { run {string compare -nocase foo ""} } 1 -test string-2.28.$noComp {string compare with length, unequal strings} { +test string-2.28.$noComp {string compare with length, unequal strings, partial first string} { run {string compare -length 2 abc abde} } 0 -test string-2.29.$noComp {string compare with length, unequal strings} { +test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} { run {string compare -length 2 ab abde} } 0 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} { @@ -289,7 +289,7 @@ test string-3.19.$noComp {string equal, unicode} { run {string equal ÜÜÜüü ÜÜÜÜÜ} } 0 test string-3.20.$noComp {string equal, high bit} { - # This test will fail if the underlying comparison + # 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) run {string equal "\x80" "@"} |