diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclUtf.c | 11 | ||||
| -rw-r--r-- | tests/utf.test | 38 |
3 files changed, 49 insertions, 6 deletions
@@ -1,3 +1,9 @@ +2003-03-06 Don Porter <dgp@users.sourceforge.net> + + * generic/TclUtf.c (Tcl_UniCharNcasecmp): Corrected failure to + * tests/utf.test (utf-25.*): properly compare Unicode strings of + different case in a case insensitive manner. [Bug 699042] + 2003-03-03 Jeff Hobbs <jeffh@ActiveState.com> *** 8.4.2 TAGGED FOR RELEASE *** diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6c6835c..cc8c3c7 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtf.c,v 1.30 2003/02/18 02:25:45 hobbs Exp $ + * RCS: @(#) $Id: tclUtf.c,v 1.30.2.1 2003/03/06 23:24:17 dgp Exp $ */ #include "tclInt.h" @@ -1294,9 +1294,12 @@ Tcl_UniCharNcasecmp(cs, ct, n) 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; diff --git a/tests/utf.test b/tests/utf.test index 0ba2414..9929482 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -8,10 +8,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: utf.test,v 1.8 2001/05/28 04:31:14 hobbs Exp $ +# RCS: @(#) $Id: utf.test,v 1.8.14.1 2003/03/06 23:24:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } @@ -299,6 +299,40 @@ test utf-24.2 {unicode space char in regc_locale.c} { 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 return |