summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclStringObj.c31
-rw-r--r--tests/string.test8
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" "@"}