From 94a4f5be20584689a3ab5fe061fbc304c7cd18b3 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 15:56:26 +0000 Subject: New tests demonstrating bug in TclNeedSpace(): improper handling escaped space. --- tests/util.test | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/util.test b/tests/util.test index 61a1790..294d883 100644 --- a/tests/util.test +++ b/tests/util.test @@ -522,6 +522,51 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { testdstring append \} -1 list [llength [testdstring get]] [string length [testdstring get]] } {2 9} +test util-8.7 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\ } -1 + testdstring start + testdstring end + + # Should make {\ {}} + list [llength [testdstring get]] [string index [testdstring get] 3] +} {2 \{} +test util-8.8 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\ } -1 + testdstring start + testdstring end + + # Should make {\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 3] +} {2 \{} +test util-8.9 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 5] +} {2 \{} +test util-8.10 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\\\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\\\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 9] +} {2 \{} +test util-8.11 {TclNeedSpace - watch out for escaped space} { + testdstring free + testdstring append {\\\\\\\\ } -1 + testdstring start + testdstring end + + # Should make {\\\\\\\\ {}} + list [llength [testdstring get]] [string index [testdstring get] 9] +} {2 \{} test util-9.0.0 {TclGetIntForIndex} { string index abcd 0 -- cgit v0.12 From 77dbe8dc087788e733edf13dedd31202b18fded4 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 16:24:34 +0000 Subject: [afa4b28153] Correct TclNeedSpace handling of trailing escaped space. --- generic/tclUtil.c | 44 ++++++++++++++++++++++++++++++++++++-------- tests/util.test | 10 ++-------- 2 files changed, 38 insertions(+), 16 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 874e2a5..7ec224e 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3225,25 +3225,49 @@ TclNeedSpace( /* * A space is needed unless either: * (a) we're at the start of the string, or - */ + * + * (NOTE: This check is now absorbed into the loop below.) + * 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 - */ + * + * (NOTE: Every character our parser is looking for is a proper + * single-byte encoding of an ASCII value. It does not accept + * overlong encodings. Given that, there's no benefit using + * Tcl_UtfPrev. If it would find what we seek, so would byte-by-byte + * backward scan. Save routine call overhead and risk of wrong + * results should the behavior of Tcl_UtfPrev change in unexpected ways. + * Reconsider this if we ever start treating non-ASCII Unicode + * characters as meaningful list syntax, expanded Unicode spaces as + * element separators, for example.) + * end = Tcl_UtfPrev(end, start); while (*end == '{') { - if (end == start) { - return 0; - } - end = Tcl_UtfPrev(end, start); + if (end == start) { + return 0; + } + end = Tcl_UtfPrev(end, start); + } + + * + */ + + while ((--end >= start) && (*end == '{')) { + } + if (end < start) { + return 0; } /* @@ -3278,8 +3302,12 @@ TclNeedSpace( case '\r': case '\v': case '\f': - if ((end == start) || (end[-1] != '\\')) { - return 0; + { + int result = 0; + while ((--end >= start) && (*end == '\\')) { + result = !result; + } + return result; } } return 1; diff --git a/tests/util.test b/tests/util.test index 294d883..46d9152 100644 --- a/tests/util.test +++ b/tests/util.test @@ -503,25 +503,19 @@ test util-8.4 {TclNeedSpace - correct UTF8 handling} testdstring { 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} +} {2 6} 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} +} {2 8} test util-8.7 {TclNeedSpace - watch out for escaped space} { testdstring free testdstring append {\ } -1 -- cgit v0.12 From e2b3b1edf02e0c1ab06cfe784d6a7bd76e8050d8 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 17:30:06 +0000 Subject: Guarantee TclNeedSpace and TclFindElement have common definition of whitespace by having both call the same routine. Create a macro form to contain performance costs and adapt callers. --- generic/tclCmdAH.c | 2 +- generic/tclCmdMZ.c | 2 +- generic/tclDate.c | 2 +- generic/tclInt.h | 11 ++++- generic/tclParse.c | 2 +- generic/tclStrToD.c | 6 +-- generic/tclUtf.c | 2 +- generic/tclUtil.c | 120 ++++++++++++++++++++++------------------------------ unix/tclUnixFile.c | 2 +- 9 files changed, 69 insertions(+), 80 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 06743d6..f30396b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -145,7 +145,7 @@ Tcl_CaseObjCmd( pat = TclGetString(caseObjv[i]); for (p = pat; *p != '\0'; p++) { - if (TclIsSpaceProc(*p) || (*p == '\\')) { + if (TclIsSpaceProcM(*p) || (*p == '\\')) { break; } } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 255fca1..d4fa4e9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1648,7 +1648,7 @@ StringIsCmd( * if it is the first "element" that has the failure. */ - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } TclNewStringObj(tmpStr, string1, p-string1); diff --git a/generic/tclDate.c b/generic/tclDate.c index 2cf20d6..8d37f3d 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2684,7 +2684,7 @@ TclDatelex( location->first_column = yyInput - info->dateStart; for ( ; ; ) { - while (TclIsSpaceProc(*yyInput)) { + while (TclIsSpaceProcM(*yyInput)) { yyInput++; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 06cff60..15bc000 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2608,7 +2608,6 @@ MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); -MODULE_SCOPE int TclIsSpaceProc(char byte); MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); @@ -2800,6 +2799,16 @@ MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr); MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct); /* + * Many parsing tasks need a common definition of whitespace. + * Use this routine and macro to achieve that and place + * optimization (fragile on changes) in one place. + */ + +MODULE_SCOPE int TclIsSpaceProc(char byte); +# define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) + +/* *---------------------------------------------------------------- * Command procedures in the generic core: *---------------------------------------------------------------- diff --git a/generic/tclParse.c b/generic/tclParse.c index 6f989d9..7bead99 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1809,7 +1809,7 @@ Tcl_ParseBraces( openBrace = 0; break; case '#' : - if (openBrace && TclIsSpaceProc(src[-1])) { + if (openBrace && TclIsSpaceProcM(src[-1])) { Tcl_AppendResult(parsePtr->interp, ": possible unbalanced brace in comment", NULL); goto error; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 4359829..3776521 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -533,7 +533,7 @@ TclParseNumber( * I, N, and whitespace. */ - if (TclIsSpaceProc(c)) { + if (TclIsSpaceProcM(c)) { if (flags & TCL_PARSE_NO_WHITESPACE) { goto endgame; } @@ -1053,7 +1053,7 @@ TclParseNumber( } /* FALLTHROUGH */ case sNANPAREN: - if (TclIsSpaceProc(c)) { + if (TclIsSpaceProcM(c)) { break; } if (numSigDigs < 13) { @@ -1107,7 +1107,7 @@ TclParseNumber( * Accept trailing whitespace. */ - while (len != 0 && TclIsSpaceProc(*p)) { + while (len != 0 && TclIsSpaceProcM(*p)) { p++; len--; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 7d3db57..9aaf506 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1610,7 +1610,7 @@ Tcl_UniCharIsSpace( */ if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) { - return TclIsSpaceProc((char) ch); + return TclIsSpaceProcM((char) ch); } else if ((Tcl_UniChar) ch == 0x180E || (Tcl_UniChar) ch == 0x202F) { return 1; } else { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 7ec224e..0b8ec2d 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -396,20 +396,20 @@ TclMaxListLength( } /* No list element before leading white space */ - count += 1 - TclIsSpaceProc(*bytes); + count += 1 - TclIsSpaceProcM(*bytes); /* Count white space runs as potential element separators */ while (numBytes) { if ((numBytes == -1) && (*bytes == '\0')) { break; } - if (TclIsSpaceProc(*bytes)) { + if (TclIsSpaceProcM(*bytes)) { /* Space run started; bump count */ count++; do { bytes++; numBytes -= (numBytes != -1); - } while (numBytes && TclIsSpaceProc(*bytes)); + } while (numBytes && TclIsSpaceProcM(*bytes)); if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { break; } @@ -420,7 +420,7 @@ TclMaxListLength( } /* No list element following trailing white space */ - count -= TclIsSpaceProc(bytes[-1]); + count -= TclIsSpaceProcM(bytes[-1]); done: if (endPtr) { @@ -508,7 +508,7 @@ TclFindElement( */ limit = (list + listLength); - while ((p < limit) && (TclIsSpaceProc(*p))) { + while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } if (p == limit) { /* no element found */ @@ -553,7 +553,7 @@ TclFindElement( } else if (openBraces == 1) { size = (p - elemStart); p++; - if ((p >= limit) || TclIsSpaceProc(*p)) { + if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } @@ -563,7 +563,7 @@ TclFindElement( if (interp != NULL) { p2 = p; - while ((p2 < limit) && (!TclIsSpaceProc(*p2)) + while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } @@ -595,23 +595,6 @@ TclFindElement( break; /* - * Space: ignore if element is in braces or quotes; otherwise - * terminate element. - */ - - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': - if ((openBraces == 0) && !inQuotes) { - size = (p - elemStart); - goto done; - } - break; - - /* * Double-quote: if element is in quotes then terminate it. */ @@ -619,7 +602,7 @@ TclFindElement( if (inQuotes) { size = (p - elemStart); p++; - if ((p >= limit) || TclIsSpaceProc(*p)) { + if ((p >= limit) || TclIsSpaceProcM(*p)) { goto done; } @@ -629,7 +612,7 @@ TclFindElement( if (interp != NULL) { p2 = p; - while ((p2 < limit) && (!TclIsSpaceProc(*p2)) + while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } @@ -640,6 +623,20 @@ TclFindElement( return TCL_ERROR; } break; + + default: + if (TclIsSpaceProcM(*p)) { + /* + * Space: ignore if element is in braces or quotes; + * otherwise terminate element. + */ + if ((openBraces == 0) && !inQuotes) { + size = (p - elemStart); + goto done; + } + } + break; + } p++; } @@ -666,7 +663,7 @@ TclFindElement( } done: - while ((p < limit) && (TclIsSpaceProc(*p))) { + while ((p < limit) && (TclIsSpaceProcM(*p))) { p++; } *elementPtr = elemStart; @@ -1013,12 +1010,6 @@ TclScanElement( case '[': case '$': case ';': - case ' ': - case '\f': - case '\n': - case '\r': - case '\t': - case '\v': forbidNone = 1; extra++; /* Escape sequences all one byte longer. */ #if COMPAT @@ -1056,6 +1047,15 @@ TclScanElement( } /* TODO: Panic on improper encoding? */ break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; +#endif + } + break; } length -= (length > 0); p++; @@ -1806,6 +1806,7 @@ TclTrim( */ /* The whitespace characters trimmed during [concat] operations */ +/* TODO: Find a reasonable way to guarantee in sync with TclIsSpaceProc() */ #define CONCAT_WS " \f\v\r\t\n" #define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1) @@ -3272,43 +3273,22 @@ TclNeedSpace( /* * (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. + * separator, Use the same testing routine as TclFindElement to + * enforce consistency. */ - if (*end > 0x20) { + if (TclIsSpaceProcM(*end)) { + int result = 0; + /* - * Performance tweak. All ASCII spaces are <= 0x20. So get a quick - * answer for most characters before comparing against all spaces in - * the switch below. - * - * NOTE: Remove this if other Unicode spaces ever get accepted as - * list-element separators. + * Trailing whitespace might be part of a backslash escape + * sequence. Handle that possibility. */ - return 1; - } - switch (*end) { - case ' ': - case '\t': - case '\n': - case '\r': - case '\v': - case '\f': - { - int result = 0; - while ((--end >= start) && (*end == '\\')) { - result = !result; - } - return result; + + while ((--end >= start) && (*end == '\\')) { + result = !result; } + return result; } return 1; } @@ -3448,7 +3428,7 @@ TclGetIntForIndex( * Leading whitespace is acceptable in an index. */ - while (length && TclIsSpaceProc(*bytes)) { + while (length && TclIsSpaceProcM(*bytes)) { bytes++; length--; } @@ -3461,7 +3441,7 @@ TclGetIntForIndex( if ((savedOp != '+') && (savedOp != '-')) { goto parseError; } - if (TclIsSpaceProc(opPtr[1])) { + if (TclIsSpaceProcM(opPtr[1])) { goto parseError; } *opPtr = '\0'; @@ -3607,7 +3587,7 @@ SetEndOffsetFromAny( * after "end-" to Tcl_GetInt, then reverse for offset. */ - if (TclIsSpaceProc(bytes[4])) { + if (TclIsSpaceProcM(bytes[4])) { return TCL_ERROR; } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { @@ -3672,7 +3652,7 @@ TclCheckBadOctal( * zero. Try to generate a meaningful error message. */ - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } if (*p == '+' || *p == '-') { @@ -3685,7 +3665,7 @@ TclCheckBadOctal( while (isdigit(UCHAR(*p))) { /* INTL: digit. */ p++; } - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } if (*p == '\0') { diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 65e144d..038cbf8 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -98,7 +98,7 @@ TclpFindExecutable( */ while (1) { - while (TclIsSpaceProc(*p)) { + while (TclIsSpaceProcM(*p)) { p++; } name = p; -- cgit v0.12 From 0834a2b225f7f2b09abce5ae03af5ff936f2a947 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 17:43:16 +0000 Subject: Revise two tests that were detecting and forgiving a bug. --- tests/dstring.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/dstring.test b/tests/dstring.test index 95321ec..5151d27 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -130,13 +130,13 @@ test dstring-2.12 {appending list elements} testdstring { testdstring get } {x #} test dstring-2.13 {appending list elements} testdstring { - # This test shows lack of sophistication in Tcl_DStringAppendElement's + # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring free testdstring append "x " -1 testdstring element # testdstring get -} {x {#}} +} {x #} test dstring-3.1 {nested sublists} testdstring { testdstring free @@ -227,7 +227,7 @@ test dstring-3.9 {appending list elements} testdstring { testdstring get } {x {x #}} test dstring-3.10 {appending list elements} testdstring { - # This test shows lack of sophistication in Tcl_DStringAppendElement's + # This test checks the sophistication in Tcl_DStringAppendElement's # decision about whether #-quoting can be disabled. testdstring free testdstring append x -1 @@ -236,7 +236,7 @@ test dstring-3.10 {appending list elements} testdstring { testdstring element # testdstring end testdstring get -} {x {x {#}}} +} {x {x #}} test dstring-4.1 {truncation} testdstring { testdstring free -- cgit v0.12 From 54867c8febc798f6f9002a74120d8c9c115bf6bb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 18:41:12 +0000 Subject: More tests. --- tests/dstring.test | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/dstring.test b/tests/dstring.test index 5151d27..f2d8656 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -137,6 +137,20 @@ test dstring-2.13 {appending list elements} testdstring { testdstring element # testdstring get } {x #} +test dstring-2.14 {appending list elements} testdstring { + testdstring free + testdstring append " " -1 + testdstring element # + testdstring get +} { {#}} +test dstring-2.15 {appending list elements} testdstring { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring free + testdstring append "x " -1 + testdstring element # + testdstring get +} {x #} test dstring-3.1 {nested sublists} testdstring { testdstring free @@ -237,6 +251,26 @@ test dstring-3.10 {appending list elements} testdstring { testdstring end testdstring get } {x {x #}} +test dstring-3.11 {appending list elements} testdstring { + testdstring free + testdstring append x -1 + testdstring start + testdstring append " " -1 + testdstring element # + testdstring end + testdstring get +} {x { {#}}} +test dstring-3.12 {appending list elements} testdstring { + # This test checks the sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring free + testdstring append x -1 + testdstring start + testdstring append "x " -1 + testdstring element # + testdstring end + testdstring get +} {x {x #}} test dstring-4.1 {truncation} testdstring { testdstring free -- cgit v0.12 From 6b3b5aaca5dae90f4def710e2f9d88684b039505 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 19:04:04 +0000 Subject: [085913c760] Fix Tcl_DStringAppendElement quoting of #. --- generic/tclUtil.c | 44 ++++++++++++++++++++++++++++++++------------ 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0b8ec2d..be80610 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2630,9 +2630,36 @@ Tcl_DStringAppendElement( { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); - int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; - int newSize = dsPtr->length + needSpace - + TclScanElement(element, -1, &flags); + int flags = 0, quoteHash = 1, newSize; + + if (needSpace) { + /* + * If we need a space to separate the new element from something + * already ending the string, we're not appending the first element + * of any list, so we need not quote any leading hash character. + */ + quoteHash = 0; + } else { + /* + * We don't need a space, maybe because there's some already there. + * Checking whether we might be appending a first element is a bit + * more involved. + * + * Backtrack over all whitespace. + */ + while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) { + } + + /* Call again without whitespace to confound things. */ + quoteHash = !TclNeedSpace(dsPtr->string, dst+1); + } + if (!quoteHash) { + flags |= TCL_DONT_QUOTE_HASH; + } + newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); + if (!quoteHash) { + flags |= TCL_DONT_QUOTE_HASH; + } /* * Allocate a larger buffer for the string if the current one isn't large @@ -2665,8 +2692,8 @@ Tcl_DStringAppendElement( element = dsPtr->string + offset; } } - dst = dsPtr->string + dsPtr->length; } + dst = dsPtr->string + dsPtr->length; /* * Convert the new string to a list element and copy it into the buffer at @@ -2677,15 +2704,8 @@ Tcl_DStringAppendElement( *dst = ' '; dst++; dsPtr->length++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; } + dsPtr->length += TclConvertElement(element, -1, dst, flags); dsPtr->string[dsPtr->length] = '\0'; return dsPtr->string; -- cgit v0.12 From 18e7960200db745bdfb8936ed33e4cc7cafad557 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 9 Apr 2020 19:13:48 +0000 Subject: Same trouble fixed the same way in Tcl_AppendElement(). --- generic/tclResult.c | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/generic/tclResult.c b/generic/tclResult.c index 7b58d44..1b9d5c9 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -704,6 +704,7 @@ Tcl_AppendElement( char *dst; int size; int flags; + int quoteHash = 1; /* * If the string result is empty, move the object result to the string @@ -740,9 +741,17 @@ Tcl_AppendElement( * then this element will not lead a list, and need not have it's * leading '#' quoted. */ - + quoteHash = 0; + } else { + while ((--dst >= iPtr->appendResult) && TclIsSpaceProcM(*dst)) { + } + quoteHash = !TclNeedSpace(iPtr->appendResult, dst+1); + } + dst = iPtr->appendResult + iPtr->appendUsed; + if (!quoteHash) { flags |= TCL_DONT_QUOTE_HASH; } + iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); } -- cgit v0.12