Tcl Source Code

Artifact 87296a1392b3c65eafcf83922d8a67b688965791:

Attachment "casecmp.patch" to ticket [699042ffff] added by dgp 2003-03-07 06:29:18.

---

Index: generic/tclUtf.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtf.c,v
retrieving revision 1.30
diff -u -r1.30 tclUtf.c
--- generic/tclUtf.c	18 Feb 2003 02:25:45 -0000	1.30
+++ generic/tclUtf.c	6 Mar 2003 23:17:10 -0000
@@ -1294,9 +1294,12 @@
     unsigned long n;			/* Number of unichars to compare. */
 {
     for ( ; n != 0; n--, cs++, ct++) {
-	if ((*cs != *ct) &&
-		(Tcl_UniCharToLower(*cs) != Tcl_UniCharToLower(*ct))) {
-	    return (*cs - *ct);
+	if (*cs != *ct) {
+	    Tcl_UniChar lcs = Tcl_UniCharToLower(*cs);
+	    Tcl_UniChar lct = Tcl_UniCharToLower(*ct);
+	    if (lcs != lct) {
+		return (lcs - lct);
+	    }
 	}
     }
     return 0;
Index: tests/utf.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/utf.test,v
retrieving revision 1.8
diff -u -r1.8 utf.test
--- tests/utf.test	28 May 2001 04:31:14 -0000	1.8
+++ tests/utf.test	6 Mar 2003 23:17:11 -0000
@@ -11,7 +11,7 @@
 # RCS: @(#) $Id: utf.test,v 1.8 2001/05/28 04:31:14 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -298,6 +298,40 @@
     # this returns 1 with Unicode 3 compliance
     list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
 } {1 1}
+
+testConstraint teststringobj [llength [info commands teststringobj]]
+test utf-25.1 {Tcl_UniCharNcasecmp} teststringobj {
+    testobj freeallvars
+    teststringobj set 1 a
+    teststringobj set 2 b
+    teststringobj getunicode 1
+    teststringobj getunicode 2
+    string compare -nocase [teststringobj get 1] [teststringobj get 2]
+} -1
+test utf-25.2 {Tcl_UniCharNcasecmp} teststringobj {
+    testobj freeallvars
+    teststringobj set 1 b
+    teststringobj set 2 a
+    teststringobj getunicode 1
+    teststringobj getunicode 2
+    string compare -nocase [teststringobj get 1] [teststringobj get 2]
+} 1
+test utf-25.3 {Tcl_UniCharNcasecmp} teststringobj {
+    testobj freeallvars
+    teststringobj set 1 B
+    teststringobj set 2 a
+    teststringobj getunicode 1
+    teststringobj getunicode 2
+    string compare -nocase [teststringobj get 1] [teststringobj get 2]
+} 1
+test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj {
+    testobj freeallvars
+    teststringobj set 1 aBcB
+    teststringobj set 2 abca
+    teststringobj getunicode 1
+    teststringobj getunicode 2
+    string compare -nocase [teststringobj get 1] [teststringobj get 2]
+} 1
 
 # cleanup
 ::tcltest::cleanupTests