diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tcl.h | 3 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 8 | ||||
| -rw-r--r-- | generic/tclCompile.c | 59 | ||||
| -rw-r--r-- | generic/tclParse.c | 39 | ||||
| -rw-r--r-- | generic/tclTest.c | 5 |
6 files changed, 106 insertions, 14 deletions
@@ -12,6 +12,12 @@ * tests/for.test: Check for uncompiled-for-continue [Bug 2186888] fixed earlier. + * generic/tcl.h: Fix [Bug 2251175]: missing backslash + * generic/tclCompCmds.c substitution on expanded literals. + * generic/tclCompile.c + * generic/tclParse.c + * generic/tclTest.c + 2008-11-16 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclTest.c: replace two times Tcl_SetResult with diff --git a/generic/tcl.h b/generic/tcl.h index b418aa7..e20964c 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.277 2008/10/22 20:23:59 nijtmans Exp $ + * RCS: @(#) $Id: tcl.h,v 1.278 2008/11/17 22:26:53 ferrieux Exp $ */ #ifndef _TCL @@ -2004,6 +2004,7 @@ 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/tclCompCmds.c b/generic/tclCompCmds.c index 4f7f230..e36d546 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -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: tclCompCmds.c,v 1.148 2008/10/05 20:47:52 nijtmans Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.149 2008/11/17 22:26:53 ferrieux Exp $ */ #include "tclInt.h" @@ -4438,7 +4438,7 @@ TclCompileSwitchCmd( * Keep in sync with TclCompileRegexpCmd. */ - if (bodyToken[i]->type == TCL_TOKEN_TEXT) { + if (bodyToken[i]->type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT)) { Tcl_DString ds; if (bodyToken[i]->size == 0) { @@ -4983,8 +4983,8 @@ PushVarName( } } } else if (((n = varTokenPtr->numComponents) > 1) - && (varTokenPtr[1].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].type == TCL_TOKEN_TEXT) + && (varTokenPtr[1].type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT)) + && (varTokenPtr[n].type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT)) && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index adaa38b..fe282d4 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.160 2008/10/26 18:34:04 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.161 2008/11/17 22:26:53 ferrieux Exp $ */ #include "tclInt.h" @@ -1077,6 +1077,7 @@ TclWordKnownAtCompileTime( { int numComponents = tokenPtr->numComponents; Tcl_Obj *tempPtr = NULL; + char *collapsed=NULL; if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { if (valuePtr != NULL) { @@ -1100,6 +1101,17 @@ 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]; @@ -1110,12 +1122,14 @@ 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); @@ -1447,8 +1461,20 @@ TclCompileScript( * namespaces to reduce shimmering. */ - objIndex = TclRegisterNewNSLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + if (tokenPtr[1].type & TCL_TOKEN_UNCOLLAPSED_TEXT) + { + char *s; + int n; + + s=ckalloc(tokenPtr[1].size); + n=TclCopyAndCollapse(tokenPtr[1].size,tokenPtr[1].start,s); + objIndex = TclRegisterLiteral(envPtr,s,n,LITERAL_NS_SCOPE|LITERAL_ON_HEAP); + } + else + { + objIndex = TclRegisterNewNSLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + } if (cmdPtr != NULL) { TclSetCmdNameObj(interp, envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr); @@ -1471,8 +1497,20 @@ TclCompileScript( * unmodified. We care only if the we are in a context * which already allows absolute counting. */ - objIndex = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + if (tokenPtr[1].type & TCL_TOKEN_UNCOLLAPSED_TEXT) + { + char *s; + int n; + + s=ckalloc(tokenPtr[1].size); + n=TclCopyAndCollapse(tokenPtr[1].size,tokenPtr[1].start,s); + objIndex = TclRegisterLiteral(envPtr,s,n,LITERAL_ON_HEAP); + } + else + { + objIndex = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); + } if (eclPtr->type == TCL_LOCATION_SOURCE) { EnterCmdWordIndex(eclPtr, @@ -1609,6 +1647,7 @@ TclCompileTokens( int numObjsToConcat, nameBytes, localVarName, localVar; int length, i; unsigned char *entryCodeNext = envPtr->codeNext; + char *collapsed=NULL; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; @@ -1618,6 +1657,14 @@ 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); @@ -1733,6 +1780,8 @@ TclCompileTokens( } } + if (collapsed) ckfree(collapsed); + /* * Push any accumulated characters appearing at the end. */ diff --git a/generic/tclParse.c b/generic/tclParse.c index c730eaa..e1278a0 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -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: tclParse.c,v 1.73 2008/10/26 18:34:04 dkf Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.74 2008/11/17 22:26:54 ferrieux Exp $ */ #include "tclInt.h" @@ -532,6 +532,28 @@ 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++; } @@ -546,7 +568,7 @@ Tcl_ParseCommand( tokenPtr->type = TCL_TOKEN_EXPAND_WORD; } } else if ((tokenPtr->numComponents == 1) - && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { + && (tokenPtr[1].type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT))) { tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; } @@ -1961,7 +1983,7 @@ Tcl_SubstObj( if (varTokenPtr->type != TCL_TOKEN_VARIABLE) { Tcl_Panic("Tcl_SubstObj: programming error"); } - if (varTokenPtr[1].type != TCL_TOKEN_TEXT) { + if (!(varTokenPtr[1].type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT))) { Tcl_Panic("Tcl_SubstObj: programming error"); } parsePtr->numTokens -= 2; @@ -2134,6 +2156,7 @@ TclSubstTokens( { Tcl_Obj *result; int code = TCL_OK; + char *collapsed = NULL; /* * Each pass through this loop will substitute one token, and its @@ -2158,6 +2181,15 @@ 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); @@ -2270,6 +2302,7 @@ TclSubstTokens( } } } + if (collapsed) ckfree(collapsed); if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { diff --git a/generic/tclTest.c b/generic/tclTest.c index 515d922..c097363 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.130 2008/11/16 22:22:11 nijtmans Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.131 2008/11/17 22:26:54 ferrieux Exp $ */ #define TCL_TEST @@ -3452,6 +3452,9 @@ 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; |