2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>

	* generic/tclCompCmds.c: fix for [Bug 599788] (error in element
	name causing segfault), reported by Tom Wilkason. Fixed by copying
	the tokens instead of the source string.

3 files changed, 94 insertions, 53 deletions

diff --git a/ChangeLog b/ChangeLog
index 84a2da1..69cf7f1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2002-08-26  Miguel Sofer  <msofer@users.sourceforge.net>
 
+	* generic/tclCompCmds.c: fix for [Bug 599788] (error in element
+	name causing segfault), reported by Tom Wilkason. Fixed by copying
+	the tokens instead of the source string.
+
+2002-08-26  Miguel Sofer  <msofer@users.sourceforge.net>
+
 	* generic/tclThreadAlloc.c: small optimisation, reducing the
 	new allocator's overhead.
 	
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 680061e..75234c9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.32 2002/08/05 03:24:40 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.33 2002/08/26 17:38:54 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -3106,16 +3106,16 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
     int *simpleVarNamePtr;	/* must not be NULL */
     int *isScalarPtr;		/* must not be NULL */
 {
-    Tcl_Parse elemParse;
-    int gotElemParse = 0;
     register CONST char *p;
     CONST char *name, *elName;
     register int i, n;
     int nameChars, elNameChars, simpleVarName, localIndex;
     int code = TCL_OK;
-    Tcl_DString copy;
 
-    Tcl_DStringInit(&copy);
+    Tcl_Token *elemTokenPtr = NULL;
+    int elemTokenCount = 0;
+    int allocedTokens = 0;
+    int removedParen = 0;
 
     /*
      * Decide if we can use a frame slot for the var/array name or if we
@@ -3148,8 +3148,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 
 	name = varTokenPtr[1].start;
 	nameChars = varTokenPtr[1].size;
-	/* last char is ')' => potential array reference */
 	if ( *(name + nameChars - 1) == ')') {
+	    /* 
+	     * last char is ')' => potential array reference.
+	     */
+
 	    for (i = 0, p = name;  i < nameChars;  i++, p++) {
 		if (*p == '(') {
 		    elName = p + 1;
@@ -3158,29 +3161,32 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 		    break;
 		}
 	    }
-	}
 
-	/*
-	 * If elName contains any double quotes ("), we can't inline
-	 * compile the element script using the replace '()' by '"'
-	 * technique below.
-	 */
+	    if ((elName != NULL) && elNameChars) {
+		/*
+		 * An array element, the element name is a simple
+		 * string: assemble the corresponding token.
+		 */
 
-	for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-	    if (*p == '"') {
-		simpleVarName = 0;
-		break;
+		elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
+		allocedTokens = 1;
+		elemTokenPtr->type = TCL_TOKEN_TEXT;
+		elemTokenPtr->start = elName;
+		elemTokenPtr->size = elNameChars;
+		elemTokenPtr->numComponents = 0;
+		elemTokenCount = 1;
 	    }
 	}
     } else if (((n = varTokenPtr->numComponents) > 1)
 	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
             && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
             && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
-        simpleVarName = 0;
 
         /*
 	 * Check for parentheses inside first token
 	 */
+
+        simpleVarName = 0;
         for (i = 0, p = varTokenPtr[1].start; 
 	     i < varTokenPtr[1].size; i++, p++) {
             if (*p == '(') {
@@ -3189,24 +3195,56 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
             }
         }
         if (simpleVarName) {
+	    int remainingChars;
+
+	    /*
+	     * Check the last token: if it is just ')', do not count
+	     * it. Otherwise, remove the ')' and flag so that it is
+	     * restored at the end.
+	     */
+
+	    if (varTokenPtr[n].size == 1) {
+		--n;
+	    } else {
+		--varTokenPtr[n].size;
+		removedParen = n;
+	    }
+
             name = varTokenPtr[1].start;
             nameChars = p - varTokenPtr[1].start;
             elName = p + 1;
+            remainingChars = (varTokenPtr[2].start - p) - 1;
             elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
 
-            /*
-             * If elName contains any double quotes ("), we can't inline
-             * compile the element script using the replace '()' by '"'
-             * technique below.
-             */
-
-            for (i = 0, p = elName;  i < elNameChars;  i++, p++) {
-                if (*p == '"') {
-                    simpleVarName = 0;
-                    break;
-                }
-            }
-        }
+	    if (remainingChars) {
+		/*
+		 * Make a first token with the extra characters in the first 
+		 * token.
+		 */
+
+		elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
+		allocedTokens = 1;
+		elemTokenPtr->type = TCL_TOKEN_TEXT;
+		elemTokenPtr->start = elName;
+		elemTokenPtr->size = remainingChars;
+		elemTokenPtr->numComponents = 0;
+		elemTokenCount = n;
+		
+		/*
+		 * Copy the remaining tokens.
+		 */
+		
+		memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
+		       ((n-1) * sizeof(Tcl_Token)));
+	    } else {
+		/*
+		 * Use the already available tokens.
+		 */
+		
+		elemTokenPtr = &varTokenPtr[2];
+		elemTokenCount = n - 1;	    
+	    }
+	}
     }
 
     if (simpleVarName) {
@@ -3247,25 +3285,9 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
 	 */
 
 	if (elName != NULL) {
-	    /*
-	     * Temporarily replace the '(' and ')' by '"'s.
-	     */
-	    Tcl_DStringAppend(&copy, "\"", 1);
-	    Tcl_DStringAppend(&copy, elName, elNameChars);
-	    Tcl_DStringAppend(&copy, "\"", 1);
-	    code = Tcl_ParseCommand(interp, Tcl_DStringValue(&copy),
-		    elNameChars+2, /*nested*/ 0, &elemParse);
-	    gotElemParse = 1;
-	    if ((code != TCL_OK) || (elemParse.numWords > 1)) {
-		char buffer[160];
-		sprintf(buffer, "\n    (parsing index for array \"%.*s\")",
-		        TclMin(nameChars, 100), name);
-		Tcl_AddObjErrorInfo(interp, buffer, -1);
-		code = TCL_ERROR;
-		goto done;
-	    } else if (elemParse.numWords == 1) {
-		code = TclCompileTokens(interp, elemParse.tokenPtr+1,
-                        elemParse.tokenPtr->numComponents, envPtr);
+	    if (elNameChars) {
+		code = TclCompileTokens(interp, elemTokenPtr,
+                        elemTokenCount, envPtr);
 		if (code != TCL_OK) {
 		    goto done;
 		}
@@ -3286,10 +3308,12 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
     }
 
     done:
-    if (gotElemParse) {
-        Tcl_FreeParse(&elemParse);
+    if (removedParen) {
+	++varTokenPtr[removedParen].size;
+    }
+    if (allocedTokens) {
+        ckfree((char *) elemTokenPtr);
     }
-    Tcl_DStringFree(&copy);
     *localIndexPtr	= localIndex;
     *simpleVarNamePtr	= simpleVarName;
     *isScalarPtr	= (elName == NULL);
diff --git a/tests/compile.test b/tests/compile.test
index a5abce7..f3c1a08 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -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: compile.test,v 1.22 2002/07/10 11:56:44 dgp Exp $
+# RCS: @(#) $Id: compile.test,v 1.23 2002/08/26 17:38:54 msofer Exp $
 
 package require tcltest 2
 namespace import -force ::tcltest::*
@@ -323,6 +323,17 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
     list [catch {exec [interpreter] << $script} msg] $msg
 } {0 OK}
 
+# Special test for compiling tokens from a copy of the source
+# string [Bug #599788]
+test compile-14.1 {testing errors in element name; segfault?} {} {
+     catch {set a([error])} msg1
+     catch {set bubba([join $abba $jubba]) $vol} msg2
+     list $msg1 $msg2
+} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}
+
+
+
+
 # cleanup
 catch {rename p ""}
 catch {namespace delete test_ns_compile}