diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tcl.h | 3 | ||||
| -rw-r--r-- | generic/tclCompile.c | 31 | ||||
| -rw-r--r-- | generic/tclParse.c | 66 | ||||
| -rw-r--r-- | generic/tclTest.c | 5 | ||||
| -rw-r--r-- | tests/parse.test | 4 |
6 files changed, 38 insertions, 79 deletions
@@ -1,3 +1,11 @@ +2008-11-27 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * generic/tcl.h: Alternate fix for[Bug 2251175]: missing + * generic/tclCompile.c backslash substitution on expanded literals. + * generic/tclParse.c + * generic/tclTest.c + * tests/parse.test + 2008-11-26 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclIndexObj.c: Eliminate warning: unused variable diff --git a/generic/tcl.h b/generic/tcl.h index e20964c..5354a70 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.278 2008/11/17 22:26:53 ferrieux Exp $ + * RCS: @(#) $Id: tcl.h,v 1.279 2008/11/27 08:23:51 ferrieux Exp $ */ #ifndef _TCL @@ -2004,7 +2004,6 @@ typedef struct Tcl_Token { #define TCL_TOKEN_SUB_EXPR 64 #define TCL_TOKEN_OPERATOR 128 #define TCL_TOKEN_EXPAND_WORD 256 -#define TCL_TOKEN_UNCOLLAPSED_TEXT 512 /* * Parsing error types. On any parsing error, one of these values will be diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c73be7d..94e3c61 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.162 2008/11/19 00:00:20 ferrieux Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.163 2008/11/27 08:23:51 ferrieux Exp $ */ #include "tclInt.h" @@ -1077,7 +1077,6 @@ TclWordKnownAtCompileTime( { int numComponents = tokenPtr->numComponents; Tcl_Obj *tempPtr = NULL; - char *collapsed=NULL; if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { if (valuePtr != NULL) { @@ -1101,17 +1100,6 @@ TclWordKnownAtCompileTime( } break; - case TCL_TOKEN_UNCOLLAPSED_TEXT: - if (tempPtr != NULL) { - if (collapsed) - collapsed=ckrealloc(collapsed,tokenPtr->size); - else - collapsed=ckalloc(tokenPtr->size); - Tcl_AppendToObj(tempPtr, collapsed, TclCopyAndCollapse(tokenPtr->size,tokenPtr->start,collapsed)); - } - break; - - case TCL_TOKEN_BS: if (tempPtr != NULL) { char utfBuf[TCL_UTF_MAX]; @@ -1122,14 +1110,12 @@ TclWordKnownAtCompileTime( default: if (tempPtr != NULL) { - if (collapsed) ckfree(collapsed); Tcl_DecrRefCount(tempPtr); } return 0; } tokenPtr++; } - if (collapsed) ckfree(collapsed); if (valuePtr != NULL) { Tcl_AppendObjToObj(valuePtr, tempPtr); Tcl_DecrRefCount(tempPtr); @@ -1462,7 +1448,7 @@ TclCompileScript( */ objIndex = TclRegisterNewNSLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + tokenPtr[1].start, tokenPtr[1].size); if (cmdPtr != NULL) { TclSetCmdNameObj(interp, envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr); @@ -1486,7 +1472,7 @@ TclCompileScript( * which already allows absolute counting. */ objIndex = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + tokenPtr[1].start, tokenPtr[1].size); if (eclPtr->type == TCL_LOCATION_SOURCE) { EnterCmdWordIndex(eclPtr, @@ -1623,7 +1609,6 @@ TclCompileTokens( int numObjsToConcat, nameBytes, localVarName, localVar; int length, i; unsigned char *entryCodeNext = envPtr->codeNext; - char *collapsed=NULL; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; @@ -1633,14 +1618,6 @@ TclCompileTokens( Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size); break; - case TCL_TOKEN_UNCOLLAPSED_TEXT: - if (collapsed) - collapsed=ckrealloc(collapsed,tokenPtr->size); - else - collapsed=ckalloc(tokenPtr->size); - Tcl_DStringAppend(&textBuffer, collapsed, TclCopyAndCollapse(tokenPtr->size,tokenPtr->start,collapsed)); - break; - case TCL_TOKEN_BS: length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer); Tcl_DStringAppend(&textBuffer, buffer, length); @@ -1756,8 +1733,6 @@ TclCompileTokens( } } - if (collapsed) ckfree(collapsed); - /* * Push any accumulated characters appearing at the end. */ diff --git a/generic/tclParse.c b/generic/tclParse.c index 9f10e76..be66a60 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,7 +12,6 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.75 2008/11/19 00:00:20 ferrieux Exp $ */ #include "tclInt.h" @@ -435,7 +434,7 @@ Tcl_ParseCommand( } if (isLiteral) { - int elemCount = 0, code = TCL_OK; + int elemCount = 0, code = TCL_OK, nakedbs = 0; const char *nextElem, *listEnd, *elemStart; /* @@ -457,20 +456,36 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { + int size,brace; + code = TclFindElement(NULL, nextElem, listEnd - nextElem, - &elemStart, &nextElem, NULL, NULL); + &elemStart, &nextElem, &size, &brace); if (code != TCL_OK) break; + if (!brace) + { + const char *s; + + for(s=elemStart;size>0;s++,size--) + { + if ((*s)=='\\') + { + nakedbs=1; + break; + } + } + } if (elemStart < listEnd) { elemCount++; } } - if (code != TCL_OK) { + if ((code != TCL_OK) || nakedbs) { /* - * Some list element could not be parsed. This means the - * literal string was not in fact a valid list. Defer the - * handling of this to compile/eval time, where code is - * already in place to report the "attempt to expand a + * Some list element could not be parsed, or contained + * naked backslashes. This means the literal string was + * not in fact a valid nor canonical list. Defer the + * handling of this to compile/eval time, where code is + * already in place to report the "attempt to expand a * non-list" error. */ @@ -532,29 +547,6 @@ Tcl_ParseCommand( tokenPtr[-1].size += (isspace(UCHAR( tokenPtr->start[tokenPtr->size])) == 0); } - if (tokenPtr[-1].start[0]!='{') - { - const char *s; - int n; - - for(n=tokenPtr->size,s=tokenPtr->start;n>0;n--,s++) - { - if ((*s)=='\\') { - tokenPtr->type = TCL_TOKEN_UNCOLLAPSED_TEXT; - /* - * In this case we also demote the - * enclosing token from - * SIMPLE_WORD to WORD in order to - * preserve the simplicity of all - * shortcuts made on SIMPLE_WORDs - * in clients. - */ - tokenPtr[-1].type = TCL_TOKEN_WORD; - break; - } - } - } - tokenPtr++; } } @@ -2156,7 +2148,6 @@ TclSubstTokens( { Tcl_Obj *result; int code = TCL_OK; - char *collapsed = NULL; /* * Each pass through this loop will substitute one token, and its @@ -2181,15 +2172,6 @@ TclSubstTokens( appendByteLength = tokenPtr->size; break; - case TCL_TOKEN_UNCOLLAPSED_TEXT: - if (collapsed) - collapsed=ckrealloc(collapsed,tokenPtr->size); - else - collapsed=ckalloc(tokenPtr->size); - appendByteLength=TclCopyAndCollapse(tokenPtr->size,tokenPtr->start,collapsed); - append=collapsed; - break; - case TCL_TOKEN_BS: appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL, utfCharBytes); @@ -2302,8 +2284,6 @@ TclSubstTokens( } } } - if (collapsed) ckfree(collapsed); - if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); diff --git a/generic/tclTest.c b/generic/tclTest.c index f93857a..3648f94 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.133 2008/11/26 23:44:59 nijtmans Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.134 2008/11/27 08:23:51 ferrieux Exp $ */ #define TCL_TEST @@ -3447,9 +3447,6 @@ PrintParse( case TCL_TOKEN_TEXT: typeString = "text"; break; - case TCL_TOKEN_UNCOLLAPSED_TEXT: - typeString = "text-to-collapse"; - break; case TCL_TOKEN_BS: typeString = "backslash"; break; diff --git a/tests/parse.test b/tests/parse.test index 404f0a8..9427254 100644 --- a/tests/parse.test +++ b/tests/parse.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: parse.test,v 1.35 2008/11/17 22:37:36 ferrieux Exp $ +# RCS: @(#) $Id: parse.test,v 1.36 2008/11/27 08:23:52 ferrieux Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -234,7 +234,7 @@ test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser { } {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}} test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser { testparser {{*}{a \n b}} 0 -} {- {{*}{a \n b}} 3 simple a 1 text a 0 word {\n} 1 text-to-collapse {\n} 0 simple b 1 text b 0 {}} +} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}} test parse-6.1 {ParseTokens procedure, empty word} testparser { testparser {""} 0 |