summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclCompile.c31
-rw-r--r--generic/tclParse.c66
-rw-r--r--generic/tclTest.c5
-rw-r--r--tests/parse.test4
6 files changed, 38 insertions, 79 deletions
diff --git a/ChangeLog b/ChangeLog
index fe6cef8..be37c31 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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