Alternate fix for[Bug 2251175]: missing backslash substitution on expanded literals.

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