Tcl Source Code

Artifact [fe13cc86bb]
Login

Artifact fe13cc86bb60628e5b87f998b8db89b6a5a503af:

Attachment "expand1c.patch" to ticket [2251175fff] added by ferrieux 2008-11-16 18:18:18.
? a
? expand1.patch
? expand1b.patch
? expand1c.patch
Index: tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.277
diff -u -r1.277 tcl.h
--- tcl.h	22 Oct 2008 20:23:59 -0000	1.277
+++ tcl.h	16 Nov 2008 11:16:11 -0000
@@ -2004,6 +2004,7 @@
 #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
Index: tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.148
diff -u -r1.148 tclCompCmds.c
--- tclCompCmds.c	5 Oct 2008 20:47:52 -0000	1.148
+++ tclCompCmds.c	16 Nov 2008 11:16:18 -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_TOKEN_UNCOLLAPSED_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|TCL_TOKEN_UNCOLLAPSED_TEXT))
+	    && (varTokenPtr[n].type & (TCL_TOKEN_TEXT|TCL_TOKEN_UNCOLLAPSED_TEXT))
 	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
 
 	/*
Index: tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.160
diff -u -r1.160 tclCompile.c
--- tclCompile.c	26 Oct 2008 18:34:04 -0000	1.160
+++ tclCompile.c	16 Nov 2008 11:16:24 -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_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 @@
 
 	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_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 @@
 		     * 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 @@
     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_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 @@
 	}
     }
 
+    if (collapsed) ckfree(collapsed);
+
     /*
      * Push any accumulated characters appearing at the end.
      */
Index: tclParse.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v
retrieving revision 1.73
diff -u -r1.73 tclParse.c
--- tclParse.c	26 Oct 2008 18:34:04 -0000	1.73
+++ tclParse.c	16 Nov 2008 11:16:27 -0000
@@ -532,6 +532,28 @@
 			    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 @@
 		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 @@
 		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 @@
 {
     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 @@
 	    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 @@
 	    }
 	}
     }
+    if (collapsed) ckfree(collapsed);
 
     if (code != TCL_ERROR) {		/* Keep error message in result! */
 	if (result != NULL) {
Index: tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.129
diff -u -r1.129 tclTest.c
--- tclTest.c	17 Oct 2008 16:32:58 -0000	1.129
+++ tclTest.c	16 Nov 2008 11:16:35 -0000
@@ -3452,6 +3452,9 @@
 	case TCL_TOKEN_TEXT:
 	    typeString = "text";
 	    break;
+	case TCL_TOKEN_UNCOLLAPSED_TEXT:
+	    typeString = "text-to-collapse";
+	    break;
 	case TCL_TOKEN_BS:
 	    typeString = "backslash";
 	    break;