Attachment "expand1b.patch" to
ticket [2251175fff]
added by
ferrieux
2008-11-15 07:28:24.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.277
diff -u -r1.277 tcl.h
--- generic/tcl.h 22 Oct 2008 20:23:59 -0000 1.277
+++ generic/tcl.h 15 Nov 2008 00:24:03 -0000
@@ -2004,6 +2004,9 @@
#define TCL_TOKEN_SUB_EXPR 64
#define TCL_TOKEN_OPERATOR 128
#define TCL_TOKEN_EXPAND_WORD 256
+/* this one is a modifier to TCL_TOKEN_TEXT */
+#define TCL_TOKEN_MUSTCOLLAPSE 0x80000000
+
/*
* Parsing error types. On any parsing error, one of these values will be
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.148
diff -u -r1.148 tclCompCmds.c
--- generic/tclCompCmds.c 5 Oct 2008 20:47:52 -0000 1.148
+++ generic/tclCompCmds.c 15 Nov 2008 00:24:08 -0000
@@ -4438,7 +4438,7 @@
* Keep in sync with TclCompileRegexpCmd.
*/
- if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
+ if (bodyToken[i]->type & TCL_TOKEN_TEXT) {
Tcl_DString ds;
if (bodyToken[i]->size == 0) {
@@ -4983,8 +4983,8 @@
}
}
} else if (((n = varTokenPtr->numComponents) > 1)
- && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
- && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+ && (varTokenPtr[1].type & TCL_TOKEN_TEXT)
+ && (varTokenPtr[n].type & TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
/*
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.160
diff -u -r1.160 tclCompile.c
--- generic/tclCompile.c 26 Oct 2008 18:34:04 -0000 1.160
+++ generic/tclCompile.c 15 Nov 2008 00:24:13 -0000
@@ -1077,6 +1077,7 @@
{
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 @@
}
break;
+ case TCL_TOKEN_TEXT|TCL_TOKEN_MUSTCOLLAPSE:
+ 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 @@
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 @@
* namespaces to reduce shimmering.
*/
- objIndex = TclRegisterNewNSLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
+ if (tokenPtr[1].type & TCL_TOKEN_MUSTCOLLAPSE)
+ {
+ 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 @@
* 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_MUSTCOLLAPSE)
+ {
+ 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 @@
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 @@
Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
break;
+ case TCL_TOKEN_TEXT|TCL_TOKEN_MUSTCOLLAPSE:
+ 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 @@
}
}
+ if (collapsed) ckfree(collapsed);
+
/*
* Push any accumulated characters appearing at the end.
*/
Index: generic/tclParse.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v
retrieving revision 1.73
diff -u -r1.73 tclParse.c
--- generic/tclParse.c 26 Oct 2008 18:34:04 -0000 1.73
+++ generic/tclParse.c 15 Nov 2008 00:24:15 -0000
@@ -532,6 +532,20 @@
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_MUSTCOLLAPSE;
+ tokenPtr[-1].type = TCL_TOKEN_WORD;
+ break;
+ }
+ }
+ }
tokenPtr++;
}
@@ -546,7 +560,7 @@
tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
}
} else if ((tokenPtr->numComponents == 1)
- && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
+ && (tokenPtr[1].type & TCL_TOKEN_TEXT)) {
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
}
@@ -1961,7 +1975,7 @@
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_Panic("Tcl_SubstObj: programming error");
}
parsePtr->numTokens -= 2;
@@ -2134,6 +2148,7 @@
{
Tcl_Obj *result;
int code = TCL_OK;
+ char *collapsed = NULL;
/*
* Each pass through this loop will substitute one token, and its
@@ -2158,6 +2173,15 @@
appendByteLength = tokenPtr->size;
break;
+ case TCL_TOKEN_TEXT|TCL_TOKEN_MUSTCOLLAPSE:
+ 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 +2294,7 @@
}
}
}
+ if (collapsed) ckfree(collapsed);
if (code != TCL_ERROR) { /* Keep error message in result! */
if (result != NULL) {
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.129
diff -u -r1.129 tclTest.c
--- generic/tclTest.c 17 Oct 2008 16:32:58 -0000 1.129
+++ generic/tclTest.c 15 Nov 2008 00:24:22 -0000
@@ -3452,6 +3452,9 @@
case TCL_TOKEN_TEXT:
typeString = "text";
break;
+ case TCL_TOKEN_TEXT|TCL_TOKEN_MUSTCOLLAPSE:
+ typeString = "text-to-collapse";
+ break;
case TCL_TOKEN_BS:
typeString = "backslash";
break;
Index: tests/compile.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compile.test,v
retrieving revision 1.49
diff -u -r1.49 compile.test
--- tests/compile.test 10 Sep 2008 13:50:05 -0000 1.49
+++ tests/compile.test 15 Nov 2008 00:24:26 -0000
@@ -568,6 +568,13 @@
} -constraints $constraints -body {
run "{*}\"\{foo bar\""
} -returnCodes error -result {unmatched open brace in list}
+test compile-16.25.$noComp {TclCompileScript: word expansion, naked backslashes} $constraints {
+ run {list {*}{a \n b}}
+} {a {
+} b}
+test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslashes} $constraints {
+ run {list {*}{a {\n} b}}
+} {a {\n} b}
} ;# End of noComp loop
# These tests are messy because it wrecks the interpreter it runs in!
Index: tests/parse.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/parse.test,v
retrieving revision 1.34
diff -u -r1.34 parse.test
--- tests/parse.test 14 Jul 2008 20:29:41 -0000 1.34
+++ tests/parse.test 15 Nov 2008 00:24:27 -0000
@@ -229,6 +229,12 @@
test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser {
testparser "{*}\\\n foo bar" 0
} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+ testparser {{*}{a b}} 0
+} {- {{*}{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 {}}
test parse-6.1 {ParseTokens procedure, empty word} testparser {
testparser {""} 0
