diff options
author | dgp <dgp@users.sourceforge.net> | 2003-08-27 20:09:49 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2003-08-27 20:09:49 (GMT) |
commit | 5a18ec5dcd91fb4d266f78a72fc746153f9ae82a (patch) | |
tree | 0dda0b6ece91b722a579df0137cac2e479c987b3 | |
parent | e827dd4c1a9972c099a3c1f7844842f07cc8bdc2 (diff) | |
download | tcl-5a18ec5dcd91fb4d266f78a72fc746153f9ae82a.zip tcl-5a18ec5dcd91fb4d266f78a72fc746153f9ae82a.tar.gz tcl-5a18ec5dcd91fb4d266f78a72fc746153f9ae82a.tar.bz2 |
* generic/tclUtil.c: Corrected [Bug 411825] and other bugs in
TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped
spaces were handled incorrectly.
* tests/util.test: Added new tests util-8.[2-6].
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | generic/tclUtil.c | 61 | ||||
-rw-r--r-- | tests/util.test | 22 |
3 files changed, 61 insertions, 28 deletions
@@ -1,7 +1,9 @@ 2003-08-27 Don Porter <dgp@users.sourceforge.net> - * tests/util.test: Added new tests for remaining TclNeedSpace() - bugs discussed in [Bug 411825]. + * generic/tclUtil.c: Corrected [Bug 411825] and other bugs in + TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped + spaces were handled incorrectly. + * tests/util.test: Added new tests util-8.[2-6]. 2003-08-06 Jeff Hobbs <jeffh@ActiveState.com> diff --git a/generic/tclUtil.c b/generic/tclUtil.c index cb15ffd..fb86a03 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -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: tclUtil.c,v 1.36.2.2 2003/07/16 21:25:07 hobbs Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.36.2.3 2003/08/27 20:09:49 dgp Exp $ */ #include "tclInt.h" @@ -2001,42 +2001,53 @@ TclNeedSpace(start, end) CONST char *end; /* End of string (place where space will * be added, if appropriate). */ { - Tcl_UniChar ch; - /* * A space is needed unless either * (a) we're at the start of the string, or - * (b) the trailing characters of the string consist of one or more - * open curly braces preceded by a space or extending back to - * the beginning of the string. - * (c) the trailing characters of the string consist of a space - * preceded by a character other than backslash. */ - if (end == start) { return 0; } + + /* + * (b) we're at the start of a nested list-element, quoted with an + * open curly brace; we can be nested arbitrarily deep, so long + * as the first curly brace starts an element, so backtrack over + * open curly braces that are trailing characters of the string; and + */ + end = Tcl_UtfPrev(end, start); - if (*end != '{') { - Tcl_UtfToUniChar(end, &ch); - /* - * Direct char comparison on next line is safe as it is with - * a character in the ASCII subset, and so single-byte in UTF8. - */ - if (Tcl_UniCharIsSpace(ch) && ((end == start) || (end[-1] != '\\'))) { - return 0; - } - return 1; - } - do { + while (*end == '{') { if (end == start) { return 0; } end = Tcl_UtfPrev(end, start); - } while (*end == '{'); - Tcl_UtfToUniChar(end, &ch); - if (Tcl_UniCharIsSpace(ch)) { - return 0; + } + + /* + * (c) the trailing character of the string is already a list-element + * separator (according to TclFindElement); that is, one of these + * characters: + * \u0009 \t TAB + * \u000A \n NEWLINE + * \u000B \v VERTICAL TAB + * \u000C \f FORM FEED + * \u000D \r CARRIAGE RETURN + * \u0020 SPACE + * with the condition that the penultimate character is not a + * backslash. + */ + + switch (*end) { + case ' ': + case '\f': + case '\n': + case '\r': + case '\t': + case '\v': + if ((end == start) || (end[-1] != '\\')) { + return 0; + } } return 1; } diff --git a/tests/util.test b/tests/util.test index 9341047..a3d181c 100644 --- a/tests/util.test +++ b/tests/util.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.10.4.1 2003/08/27 17:56:46 dgp Exp $ +# RCS: @(#) $Id: util.test,v 1.10.4.2 2003/08/27 20:09:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -342,6 +342,26 @@ test util-8.4 {TclNeedSpace - correct UTF8 handling} testdstring { testdstring element foo llength [testdstring get] } 2 +test util-8.5 {TclNeedSpace - correct UTF8 handling} testdstring { + # Note that in this test TclNeedSpace actually gets it wrong, + # claiming we need a space when we really do not. Extra space + # between list elements is harmless though, and better to have + # extra space in really weird string reps of lists, than to + # invest the effort required to make TclNeedSpace foolproof. + testdstring free + testdstring append {\\ } -1 + testdstring element foo + list [llength [testdstring get]] [string length [testdstring get]] +} {2 7} +test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { + # Another example of TclNeedSpace harmlessly getting it wrong. + testdstring free + testdstring append {\\ } -1 + testdstring append \{ -1 + testdstring element foo + testdstring append \} -1 + list [llength [testdstring get]] [string length [testdstring get]] +} {2 9} # cleanup ::tcltest::cleanupTests |