From 510815200ad3a5a5f455dc224faef6614393190f Mon Sep 17 00:00:00 2001 From: hobbs Date: Tue, 11 Feb 2003 18:35:05 +0000 Subject: * tests/stringObj.test: * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char opt of 2002-11-11 to not stop early on \x00. [Bug #684699] --- ChangeLog | 32 ++++++++++++++++++++------------ generic/tclStringObj.c | 13 ++++++------- tests/stringObj.test | 21 ++++++++------------- 3 files changed, 34 insertions(+), 32 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1d7c1e0..4dbfcf6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,17 @@ +2003-02-11 Jeff Hobbs + + * tests/stringObj.test: + * generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char + opt of 2002-11-11 to not stop early on \x00. [Bug #684699] + + * tests.parse.test: remove excess EOF whitespace + + * generic/tclParse.c (CommandComplete): more paranoid check to + break on (p >= end) instead of just (p == end). + 2003-02-11 Miguel Sofer - * generic/tclParse.c + * generic/tclParse.c (CommandComplete): * tests/parse.test: fix for [Bug 684744], by Don Porter. 2003-02-11 Jeff Hobbs @@ -9,7 +20,7 @@ (UpdateStringOfFsPath): revert the cwdLen == 0 check and instead follow a different code path in Tcl_FSJoinPath. (Tcl_FSConvertToPathType, Tcl_FSGetNormalizedPath): - (Tcl_FSGetFileSystemForPath): Update string rep path objects + (Tcl_FSGetFileSystemForPath): Update string rep of path objects before freeing the internal object. (darley) * tests/fileSystem.test: added test 8.3 @@ -45,20 +56,17 @@ * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * win/tclWinFile.c: further filesystem optimization, applying - [Patch 682500]. In particular, these code examples are + [Patch 682500]. In particular, these code examples are faster now: - - foreach f $flist { if {[file exists $f]} {file stat $f arr;...}} - - foreach f [glob -dir $dir *] { # action and/or recursion on $f } - - cd $dir + foreach f $flist { if {[file exists $f]} {file stat $f arr;...}} + foreach f [glob -dir $dir *] { # action and/or recursion on $f } + cd $dir foreach f [glob *] { # action and/or recursion on $f } cd .. - * generic/tclTest.c: Fix for [Bug 683181] where test suite + * generic/tclTest.c: Fix for [Bug 683181] where test suite left files in 'tmp'. - + 2003-02-08 Jeff Hobbs * library/safe.tcl: code cleanup of eval and string comp use. @@ -386,7 +394,7 @@ * tests/stringObj.test: removed 'knownBug' constraint from test 14.1 now that this bug is fixed. - * generic/tclInt.h: + * generic/tclInt.h: * generic/tclBasic.c: * generic/tclCmdMZ.z: * tests/trace.test: execution and command tracing bug fixes and diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 4af164c..41ecf137 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.28 2003/01/24 11:59:29 vincentdarley Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.29 2003/02/11 18:35:11 hobbs Exp $ */ #include "tclInt.h" @@ -376,7 +376,7 @@ Tcl_GetCharLength(objPtr) */ if (stringPtr->numChars == -1) { - register int i = 0; + register int i = 0, len = objPtr->length; register unsigned char *str = (unsigned char *) objPtr->bytes; /* @@ -386,14 +386,13 @@ Tcl_GetCharLength(objPtr) stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); */ - while (*str && *str < 0xC0) { i++; str++; } + while ((i < len) && (*str < 0xC0)) { i++; str++; } stringPtr->numChars = i; - if (*str) { - stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes + i, - objPtr->length - i); + if (i < len) { + stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes + i, len - i); } - if (stringPtr->numChars == objPtr->length) { + if (stringPtr->numChars == len) { /* * Since we've just calculated the number of chars, and all diff --git a/tests/stringObj.test b/tests/stringObj.test index b27557d..408bb70 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.13 2003/01/17 14:19:54 vincentdarley Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.14 2003/02/11 18:35:12 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -414,6 +414,13 @@ test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} { set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE" list [string length $a] [string length $a] } {10 10} +test encoding-14.2 {Tcl_GetCharLength with identity nulls} { + # SF bug #684699 + string length [encoding convertfrom identity \x00] +} 1 +test encoding-14.2 {Tcl_GetCharLength with identity nulls} { + string length [encoding convertfrom identity \x01\x00\x02] +} 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} { teststringobj set 1 foo @@ -431,15 +438,3 @@ testobj freeallvars # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - -- cgit v0.12