diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclCompile.c | 39 | ||||
| -rw-r--r-- | tests/compile.test | 11 |
3 files changed, 44 insertions, 14 deletions
@@ -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} |