summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorferrieux <ferrieux@users.sourceforge.net>2008-11-17 22:26:53 (GMT)
committerferrieux <ferrieux@users.sourceforge.net>2008-11-17 22:26:53 (GMT)
commitdee5b7a791b4b64cdfe7ae6c9981aff8d85848d5 (patch)
tree2feeafa4d0aa3b3a07938ff5db6643a4ee5dc488
parentdb2e6bf825388498ab5798bbeca26fce23d4286f (diff)
downloadtcl-dee5b7a791b4b64cdfe7ae6c9981aff8d85848d5.zip
tcl-dee5b7a791b4b64cdfe7ae6c9981aff8d85848d5.tar.gz
tcl-dee5b7a791b4b64cdfe7ae6c9981aff8d85848d5.tar.bz2
Fix [Bug 2251175]: missing backslash substitution on expanded literals.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclCompCmds.c8
-rw-r--r--generic/tclCompile.c59
-rw-r--r--generic/tclParse.c39
-rw-r--r--generic/tclTest.c5
6 files changed, 106 insertions, 14 deletions
diff --git a/ChangeLog b/ChangeLog
index 3f01f47..13cc2a4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;