Attachment "1236896.patch" to
ticket [1236896fff]
added by
dgp
2005-07-18 21:46:05.
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.78
diff -u -r1.78 tclCmdIL.c
--- generic/tclCmdIL.c 17 Jul 2005 21:17:30 -0000 1.78
+++ generic/tclCmdIL.c 18 Jul 2005 14:34:22 -0000
@@ -3305,7 +3305,7 @@
dataType = INTEGER;
break;
case LSEARCH_NOCASE: /* -nocase */
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
break;
case LSEARCH_NOT: /* -not */
@@ -3661,7 +3661,7 @@
*/
if (noCase) {
- match = (strcasecmp(bytes, patternBytes) == 0);
+ match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
@@ -4040,7 +4040,7 @@
sortInfo.sortMode = SORTMODE_INTEGER;
break;
case LSORT_NOCASE:
- sortInfo.strCmpFn = strcasecmp;
+ sortInfo.strCmpFn = TclUtfCasecmp;
break;
case LSORT_REAL:
sortInfo.sortMode = SORTMODE_REAL;
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.127
diff -u -r1.127 tclCmdMZ.c
--- generic/tclCmdMZ.c 17 Jul 2005 21:17:37 -0000 1.127
+++ generic/tclCmdMZ.c 18 Jul 2005 14:34:23 -0000
@@ -2633,7 +2633,7 @@
matchVarObj = objv[i];
numMatchesSaved = -1;
} else if (index == OPT_NOCASE) {
- strCmpFn = strcasecmp;
+ strCmpFn = TclUtfCasecmp;
noCase = 1;
} else {
if (foundmode) {
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.90
diff -u -r1.90 tclInt.decls
--- generic/tclInt.decls 5 Jul 2005 18:15:55 -0000 1.90
+++ generic/tclInt.decls 18 Jul 2005 14:34:23 -0000
@@ -897,6 +897,10 @@
TclPlatformType *TclGetPlatform(void)
}
+declare 225 generic {
+ int TclUtfCasecmp( CONST char *cs, CONST char *ct )
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.81
diff -u -r1.81 tclIntDecls.h
--- generic/tclIntDecls.h 5 Jul 2005 18:15:56 -0000 1.81
+++ generic/tclIntDecls.h 18 Jul 2005 14:34:24 -0000
@@ -1157,6 +1157,12 @@
/* 224 */
EXTERN TclPlatformType * TclGetPlatform _ANSI_ARGS_((void));
#endif
+#ifndef TclUtfCasecmp_TCL_DECLARED
+#define TclUtfCasecmp_TCL_DECLARED
+/* 225 */
+EXTERN int TclUtfCasecmp _ANSI_ARGS_((CONST char * cs,
+ CONST char * ct));
+#endif
typedef struct TclIntStubs {
int magic;
@@ -1402,6 +1408,7 @@
int (*tclBN_mp_init) _ANSI_ARGS_((mp_int * a)); /* 222 */
int (*tclBN_mp_read_radix) _ANSI_ARGS_((mp_int * a, const char * str, int radix)); /* 223 */
TclPlatformType * (*tclGetPlatform) _ANSI_ARGS_((void)); /* 224 */
+ int (*tclUtfCasecmp) _ANSI_ARGS_((CONST char * cs, CONST char * ct)); /* 225 */
} TclIntStubs;
#ifdef __cplusplus
@@ -2177,6 +2184,10 @@
#define TclGetPlatform \
(tclIntStubsPtr->tclGetPlatform) /* 224 */
#endif
+#ifndef TclUtfCasecmp
+#define TclUtfCasecmp \
+ (tclIntStubsPtr->tclUtfCasecmp) /* 225 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.119
diff -u -r1.119 tclStubInit.c
--- generic/tclStubInit.c 5 Jul 2005 18:15:58 -0000 1.119
+++ generic/tclStubInit.c 18 Jul 2005 14:34:24 -0000
@@ -309,6 +309,7 @@
TclBN_mp_init, /* 222 */
TclBN_mp_read_radix, /* 223 */
TclGetPlatform, /* 224 */
+ TclUtfCasecmp, /* 225 */
};
TclIntPlatStubs tclIntPlatStubs = {
Index: generic/tclUtf.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtf.c,v
retrieving revision 1.34
diff -u -r1.34 tclUtf.c
--- generic/tclUtf.c 10 May 2005 18:34:51 -0000 1.34
+++ generic/tclUtf.c 18 Jul 2005 14:34:24 -0000
@@ -1103,6 +1103,73 @@
/*
*----------------------------------------------------------------------
*
+ * TclUtfCasecmp --
+ *
+ * Compare string cs to string ct case insensitively.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUtfCasecmp(cs, ct)
+ CONST char *cs; /* UTF string to compare to ct. */
+ CONST char *ct; /* UTF string cs is compared to. */
+{
+ char s, t;
+ while ((s = *cs) != '\0' && (t = *ct) != '\0') {
+
+ if (((s | t) & 0x80) == 0) {
+ /* We have 7bit ASCII characters in both strings */
+ if (s == t) {
+ cs++; ct++;
+ } else {
+ if (s >= 'A' && s <= 'Z') {
+ s |= 0x20;
+ }
+ if (t >= 'A' && t <= 'Z') {
+ t |= 0x20;
+ }
+ if (s == t) {
+ cs++; ct++;
+ } else {
+ return (s-t);
+ }
+ }
+ } else {
+ Tcl_UniChar ch1, ch2;
+ 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 (s != '\0') {
+ /* ct is a prefix of cs */
+ return 1;
+ }
+ if (*ct == '\0') {
+ /* the strings are equivalent */
+ return 0;
+ } else {
+ /* cs is a prefix of ct */
+ 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 -r1.26 cmdIL.test
--- tests/cmdIL.test 1 Jun 2005 11:00:35 -0000 1.26
+++ tests/cmdIL.test 18 Jul 2005 14:34:26 -0000
@@ -431,6 +431,12 @@
} -result 0 -cleanup {
rename test_lsort ""
}
+test cmdIL-5.6 {lsort -nocase with non-ASCII characters} -body {
+ lsort -nocase {\u00c4a \u20aca \u00c4c \u00e4b Ac ab Aa}
+} -result "Aa ab Ac \u00c4a \u00e4b \u00c4c \u20aca"
+test cmdIL-5.6 {lsort -nocase with ASCII non-letter characters} {
+ list [lsort -nocase {@ `}] [lsort -nocase {` @}]
+} {{@ `} {@ `}}
# Compiled version
test cmdIL-6.1 {lassign command syntax} -body {
