* generic/tclCmdMZ.c (Tcl_StringObjCmd):

* tests/string.test: Fixed bug where string equal/compare -nocase
reported wrong result on null strings. [Bug: 2138]

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
 
 
 
+