[Bug 569438] in the processing of dollar variables

3 files changed, 44 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 786f579..c0d6acb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,10 @@
-2002-06-14  Miguel Sofer  <msofer@users.sourceforge.net>
+2002-06-16  Miguel Sofer  <msofer@users.sourceforge.net>
+
+	* generic/tclCompile.c (TclCompileTokens): 
+	* tests/compile.test: [Bug 569438] in the processing of dollar
+	variables; report by Georgios Petasis. 
+	
+2002-06-16  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* generic/tclExecute.c: bug in the consolidation of the
 	INCR_..._STK instructions; the bug could not be exercised as the
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3c3a7ff..2ed6ee0 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.34 2002/06/11 15:42:20 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.35 2002/06/16 22:24:12 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1203,20 +1203,35 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
 
 		/*
 		 * Either push the variable's name, or find its index in
-		 * the array of local variables in a procedure frame.
+		 * the array of local variables in a procedure frame. 
 		 */
 
-		if ((envPtr->procPtr == NULL) || hasNsQualifiers) {
-		    localVar = -1;
-		    TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes,
-		            /*onHeap*/ 0), envPtr);
-		} else {
+		localVar = -1;
+		if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
+		    int createVar = 1;
+		    char *p;
+		    
+		    if ((tokenPtr->numComponents == 1) 
+		            && (*(name + nameBytes - 1) == ')')) {
+			/*
+			 * Do not attempt to use a compiled local if the
+			 * name has a single component that looks like
+			 * an array element (see [Bug 569438]).
+			 */
+
+			for (p = name; p < name + nameBytes; p++) {
+			    if (*p == '(') {
+				createVar = 0;
+				break;
+			    }
+			}
+		    }			
 		    localVar = TclFindCompiledLocal(name, nameBytes, 
-			    /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
-		    if (localVar < 0) {
-			TclEmitPush(TclRegisterLiteral(envPtr, name,
-			        nameBytes, /*onHeap*/ 0), envPtr); 
-		    }
+			        createVar, /*flags*/ 0, envPtr->procPtr);
+		}
+		if (localVar < 0) {
+		    TclEmitPush(TclRegisterLiteral(envPtr, name,
+		            nameBytes, /*onHeap*/ 0), envPtr); 
 		}
 
 		/*
diff --git a/tests/compile.test b/tests/compile.test
index aef9ac0..64a72f7 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.19 2002/04/15 17:32:18 msofer Exp $
+# RCS: @(#) $Id: compile.test,v 1.20 2002/06/16 22:24:12 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -72,6 +72,15 @@ test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
     }
     list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
 } {1 1 1}
+test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} {
+    catch {unset a}
+    proc p {} {
+	global a
+        set a(1) 1
+        return ${a(1)}$::a(1)$a(1)
+    }
+    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
+} {111 1 1}
 
 test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} {
     catch {unset a}