Tcl Source Code

Artifact 739c2cf737a035df615636779de95336d27fb5be:

Attachment "Tcl_Utfcasecmp.patch" to ticket [1236896fff] added by rmax 2005-07-13 20:57:43.

---

--- generic/tcl.decls	6 Jun 2005 23:45:42 -0000	1.112
+++ generic/tcl.decls	12 Jul 2005 18:32:00 -0000
@@ -2013,6 +2013,10 @@
 	    Tcl_ChannelType *chanTypePtr)
 }
 
+declare 561 generic {
+    int Tcl_UtfCasecmp( CONST char *cs, CONST char *ct )
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
--- generic/tclCmdIL.c	1 Jun 2005 11:00:34 -0000	1.76
+++ generic/tclCmdIL.c	12 Jul 2005 18:32:00 -0000
@@ -3304,7 +3304,7 @@
 	    dataType = INTEGER;
 	    break;
 	case LSEARCH_NOCASE:		/* -nocase */
-	    strCmpFn = strcasecmp;
+	    strCmpFn = Tcl_UtfCasecmp;
 	    noCase = 1;
 	    break;
 	case LSEARCH_NOT:		/* -not */
@@ -3654,7 +3654,7 @@
 			 * compilation of memcmp
 			 */
 			if (noCase) {
-			    match = (strcasecmp(bytes, patternBytes) == 0);
+			    match = (Tcl_UtfCasecmp(bytes, patternBytes) == 0);
 			} else {
 			    match = (memcmp(bytes, patternBytes,
 				    (size_t) length) == 0);
@@ -4020,7 +4020,7 @@
 	    sortInfo.sortMode = SORTMODE_INTEGER;
 	    break;
 	case LSORT_NOCASE:
-	    sortInfo.strCmpFn = strcasecmp;
+	    sortInfo.strCmpFn = Tcl_UtfCasecmp;
 	    break;
 	case LSORT_REAL:
 	    sortInfo.sortMode = SORTMODE_REAL;
--- generic/tclCmdMZ.c	20 Jun 2005 07:49:11 -0000	1.126
+++ generic/tclCmdMZ.c	12 Jul 2005 18:32:00 -0000
@@ -2586,7 +2586,7 @@
 	    matchVarObj = objv[i];
 	    numMatchesSaved = -1;
 	} else if (index == OPT_NOCASE) {
-	    strCmpFn = strcasecmp;
+	    strCmpFn = Tcl_UtfCasecmp;
 	    noCase = 1;
 	} else {
 	    if ( foundmode ) {
--- generic/tclUtf.c	10 May 2005 18:34:51 -0000	1.34
+++ generic/tclUtf.c	12 Jul 2005 18:32:01 -0000
@@ -1103,6 +1103,49 @@
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_UtfCasecmp --
+ *
+ *	Compare string cs to string ct case insensitive.
+ *
+ * Results:
+ *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfCasecmp(cs, ct)
+    CONST char *cs;		/* UTF string to compare to ct. */
+    CONST char *ct;		/* UTF string cs is compared to. */
+{
+    Tcl_UniChar ch1, ch2;
+    while (*cs != '\0' && *ct != '\0') {
+
+	cs += TclUtfToUniChar(cs, &ch1);
+	ct += TclUtfToUniChar(ct, &ch2);
+	if (ch1 != ch2) {
+	    ch1 = Tcl_UniCharToLower(ch1);
+	    ch2 = Tcl_UniCharToLower(ch2);
+	    if (ch1 != ch2) {
+		return (ch1 - ch2);
+	    }
+	}
+    }
+    if (*cs == *ct) {
+	return 0;
+    } else if (*cs == '\0') {
+	return -1;
+    } else {
+	return 1;
+    }	    
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_UniCharToUpper --
  *
  *	Compute the uppercase equivalent of the given Unicode character.
Index: tests/cmdIL.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdIL.test,v
retrieving revision 1.26
diff -u -u -r1.26 cmdIL.test
--- tests/cmdIL.test	1 Jun 2005 11:00:35 -0000	1.26
+++ tests/cmdIL.test	12 Jul 2005 18:32:01 -0000
@@ -431,6 +431,9 @@
 } -result 0 -cleanup {
     rename test_lsort ""
 }
+test cmdIL-5.6 {lsort -nocase with non-ASCII characters} -body {
+    lsort -nocase {Äb Äc äa}
+} -result {äa Äb Äc}
 
 # Compiled version
 test cmdIL-6.1 {lassign command syntax} -body {