From 4ba38844faf91c00b0df311fbfa958e36a216475 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 8 Oct 2003 14:24:40 +0000
Subject: Made Tcl_NumUtfChars do the right thing with \u0000 when guessing the
 length because of a negative 'length' parameter. [Bug 769812]

---
 ChangeLog         |  8 ++++++++
 generic/tclTest.c | 30 ++++++++++++++++++++++++++++--
 generic/tclUtf.c  |  7 ++-----
 tests/utf.test    | 23 +++++++++++++++++++----
 4 files changed, 57 insertions(+), 11 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 69bc280..68ebe18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2003-10-08  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tclTest.c (TestNumUtfCharsCmd): Command to allow finer
+	access to Tcl_NumUtfChars for testing.
+	* generic/tclUtf.c (Tcl_NumUtfChars): Corrected string length
+	determining when the length parameter is negative; the terminator
+	is a zero byte, not (necessarily) a \u0000 character. [Bug 769812]
+
 2003-10-07  Don Porter  <dgp@users.sourceforge.net>
 
 	* tests/cmdAH.test:
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 6d04c6e..8f322fc 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.67 2003/04/16 23:33:44 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.68 2003/10/08 14:24:41 dkf Exp $
  */
 
 #define TCL_TEST
@@ -420,6 +420,9 @@ static Tcl_Obj*         SimpleListVolumes _ANSI_ARGS_ ((void));
 static int              SimplePathInFilesystem _ANSI_ARGS_ ((
 			    Tcl_Obj *pathPtr, ClientData *clientDataPtr));
 static Tcl_Obj*         SimpleCopy _ANSI_ARGS_ ((Tcl_Obj *pathPtr));
+static int              TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData,
+                            Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
 
 static Tcl_Filesystem testReportingFilesystem = {
     "reporting",
@@ -654,6 +657,9 @@ Tcltest_Init(interp)
     Tcl_CreateObjCommand(interp, "testsetobjerrorcode", 
 	    TestsetobjerrorcodeCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testnumutfchars",
+	    TestNumUtfCharsCmd, (ClientData) 0, 
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
@@ -6413,4 +6419,24 @@ SimpleListVolumes(void)
     Tcl_IncrRefCount(retVal);
     return retVal;
 }
-
+
+/*
+ * Used to check correct string-length determining in Tcl_NumUtfChars
+ */
+static int
+TestNumUtfCharsCmd(clientData, interp, objc, objv)
+    ClientData clientData;
+    Tcl_Interp *interp;
+    int objc;
+    Tcl_Obj *CONST objv[];
+{
+    if (objc > 1) {
+	int len = -1;
+	if (objc > 2) {
+	    (void) Tcl_GetStringFromObj(objv[1], &len);
+	}
+	len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
+    }
+    return TCL_OK;
+}
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 2e464ed..f0acdd2 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.31 2003/03/06 23:27:14 dgp Exp $
+ * RCS: @(#) $Id: tclUtf.c,v 1.32 2003/10/08 14:24:41 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -501,11 +501,8 @@ Tcl_NumUtfChars(str, len)
 
     i = 0;
     if (len < 0) {
-	while (1) {
+	while (*str != '\0') {
 	    str += TclUtfToUniChar(str, chPtr);
-	    if (ch == '\0') {
-		break;
-	    }
 	    i++;
 	}
     } else {
diff --git a/tests/utf.test b/tests/utf.test
index 3482c22..94f99e8 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.10 2003/03/27 13:19:15 dkf Exp $
+# RCS: @(#) $Id: utf.test,v 1.11 2003/10/08 14:24:41 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -59,14 +59,29 @@ test utf-3.1 {Tcl_UtfCharComplete} {
 } {}
 
 test utf-4.1 {Tcl_NumUtfChars: zero length} {
-    string length ""
+    testnumutfchars ""
 } {0}
 test utf-4.2 {Tcl_NumUtfChars: length 1} {
-    string length [bytestring "\xC2\xA2"]
+    testnumutfchars [bytestring "\xC2\xA2"]
 } {1}
 test utf-4.3 {Tcl_NumUtfChars: long string} {
-    string length [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
+    testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
 } {7}
+test utf-4.4 {Tcl_NumUtfChars: #u0000} {
+    testnumutfchars [bytestring "\xC0\x80"]
+} {1}
+test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} {
+    testnumutfchars "" 1
+} {0}
+test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {
+    testnumutfchars [bytestring "\xC2\xA2"] 1
+} {1}
+test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {
+    testnumutfchars [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 1
+} {7}
+test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {
+    testnumutfchars [bytestring "\xC0\x80"] 1
+} {1}
 
 test utf-5.1 {Tcl_UtfFindFirsts} {
 } {}
-- 
cgit v0.12