From 1ee755b0c7f5e4fdcfcce9b291e9eef6aa37c18c Mon Sep 17 00:00:00 2001 From: stanton Date: Thu, 3 Jun 1999 18:43:30 +0000 Subject: * generic/tclCmdMZ.c (Tcl_StringObjCmd): * tests/string.test: Fixed bug where string equal/compare -nocase reported wrong result on null strings. [Bug: 2138] --- generic/tclCmdMZ.c | 13 ++++++++++++- tests/string.test | 26 ++++++++++++++++++++++---- tests/utf.test | 54 ++++++++++++++++++++++++++++++++++-------------------- 3 files changed, 68 insertions(+), 25 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index fdc89b7..19b9ece 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.11 1999/06/02 01:53:31 stanton Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.12 1999/06/03 18:43:30 stanton Exp $ */ #include "tclInt.h" @@ -876,21 +876,32 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) /* * Anything matches at 0 chars, right? */ + match = 0; } else if (nocase || ((reqlength > 0) && (reqlength <= length))) { /* * with -nocase or -length we have to check true char length * as it could be smaller than expected */ + length1 = Tcl_NumUtfChars(string1, length1); length2 = Tcl_NumUtfChars(string2, length2); length = (length1 < length2) ? length1 : length2; + /* * Do the reqlength check again, against 0 as well for * the benfit of nocase */ + if ((reqlength > 0) && (reqlength < length)) { length = reqlength; + } else if (reqlength < 0) { + /* + * The requested length is negative, so we ignore it by + * setting it to the longer of the two lengths. + */ + + reqlength = (length1 > length2) ? length1 : length2; } if (nocase) { match = Tcl_UtfNcasecmp(string1, string2, diff --git a/tests/string.test b/tests/string.test index d517db5..01ad4bf 100644 --- a/tests/string.test +++ b/tests/string.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.10 1999/05/22 01:20:14 stanton Exp $ +# RCS: @(#) $Id: string.test,v 1.11 1999/06/03 18:43:30 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -83,7 +83,7 @@ test string-2.17 {string compare -nocase with length} { } -1 test string-2.18 {string compare -nocase with length <= 0} { string compare -nocase -length -1 abcde AbCdEf -} 0 +} -1 test string-2.19 {string compare -nocase with excessive length} { string compare -nocase -length 50 AbCdEf abcde } 1 @@ -95,10 +95,28 @@ test string-2.20 {string compare -len unicode} { test string-2.21 {string compare -nocase with special index} { list [catch {string compare -nocase -length end-3 Abcde abxyz} msg] $msg } {1 {expected integer but got "end-3"}} -test string-2.22 {string equal with length, unequal strings} { +test string-2.22 {string compare, null strings} { + string compare "" "" +} 0 +test string-2.23 {string compare, null strings} { + string compare "" foo +} -1 +test string-2.24 {string compare, null strings} { + string compare foo "" +} 1 +test string-2.25 {string compare -nocase, null strings} { + string compare -nocase "" "" +} 0 +test string-2.26 {string compare -nocase, null strings} { + string compare -nocase "" foo +} -1 +test string-2.27 {string compare -nocase, null strings} { + string compare -nocase foo "" +} 1 +test string-2.28 {string equal with length, unequal strings} { string compare -length 2 abc abde } 0 -test string-2.22 {string equal with length, unequal strings} { +test string-2.29 {string equal with length, unequal strings} { string compare -length 2 ab abde } 0 diff --git a/tests/utf.test b/tests/utf.test index eb9952f..28d5643 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -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: utf.test,v 1.2 1999/04/16 00:47:36 stanton Exp $ +# RCS: @(#) $Id: utf.test,v 1.3 1999/06/03 18:43:30 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -197,66 +197,79 @@ test utf-13.4 {Tcl_UtfToTitle} { string totitle \u01f3ab } \u01f2ab -test utf-14.1 {Tcl_UniCharToUpper, negative delta} { +test utf-14.1 {Tcl_UtfNcasecmp} { + string compare -nocase a b +} -1 +test utf-14.2 {Tcl_UtfNcasecmp} { + string compare -nocase b a +} 1 +test utf-14.3 {Tcl_UtfNcasecmp} { + string compare -nocase B a +} 1 +test utf-14.4 {Tcl_UtfNcasecmp} { + string compare -nocase aBcB abca +} 1 + +test utf-15.1 {Tcl_UniCharToUpper, negative delta} { string toupper aA } AA -test utf-14.2 {Tcl_UniCharToUpper, positive delta} { +test utf-15.2 {Tcl_UniCharToUpper, positive delta} { string toupper \u0178\u00ff } \u0178\u0178 -test utf-14.3 {Tcl_UniCharToUpper, no delta} { +test utf-15.3 {Tcl_UniCharToUpper, no delta} { string toupper ! } ! -test utf-15.1 {Tcl_UniCharToLower, negative delta} { +test utf-16.1 {Tcl_UniCharToLower, negative delta} { string tolower aA } aa -test utf-15.2 {Tcl_UniCharToLower, positive delta} { +test utf-16.2 {Tcl_UniCharToLower, positive delta} { string tolower \u0178\u00ff } \u00ff\u00ff -test utf-16.1 {Tcl_UniCharToLower, no delta} { +test utf-17.1 {Tcl_UniCharToLower, no delta} { string tolower ! } ! -test utf-17.1 {Tcl_UniCharToTitle, add one for title} { +test utf-18.1 {Tcl_UniCharToTitle, add one for title} { string totitle \u01c4 } \u01c5 -test utf-17.2 {Tcl_UniCharToTitle, subtract one for title} { +test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} { string totitle \u01c6 } \u01c5 -test utf-17.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { +test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} { string totitle \u017f } \u0053 -test utf-17.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { +test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} { string totitle \u00ff } \u0178 -test utf-17.5 {Tcl_UniCharToTitle, no delta} { +test utf-18.5 {Tcl_UniCharToTitle, no delta} { string totitle ! } ! -test utf-18.1 {TclUniCharLen} { +test utf-19.1 {TclUniCharLen} { list [regexp \\d abc456def foo] $foo } {1 4} -test utf-19.1 {TclUniCharNcmp} { +test utf-20.1 {TclUniCharNcmp} { } {} -test utf-20.1 {TclUniCharIsAlnum} { +test utf-21.1 {TclUniCharIsAlnum} { } {} -test utf-21.1 {TclUniCharIsWordChar} { +test utf-22.1 {TclUniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 -test utf-21.1 {TclUniCharIsWordChar} { +test utf-22.2 {TclUniCharIsWordChar} { string wordend "x\u5080z123_bar\u203c fg" 0 } 10 -test utf-22.1 {TclUniCharIsAlpha} { +test utf-23.1 {TclUniCharIsAlpha} { } {} -test utf-23.1 {TclUniCharIsDigit} { +test utf-24.1 {TclUniCharIsDigit} { } {} -test utf-23.1 {TclUniCharIsSpace} { +test utf-24.2 {TclUniCharIsSpace} { } {} # cleanup @@ -274,3 +287,4 @@ return + -- cgit v0.12