diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclTest.c | 30 | ||||
| -rw-r--r-- | generic/tclUtf.c | 7 | ||||
| -rw-r--r-- | tests/utf.test | 23 |
4 files changed, 57 insertions, 11 deletions
@@ -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} { } {} |