summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclCompile.c39
-rw-r--r--tests/compile.test11
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}