diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | doc/global.n | 6 | ||||
| -rw-r--r-- | doc/upvar.n | 6 | ||||
| -rw-r--r-- | generic/tclVar.c | 26 | ||||
| -rw-r--r-- | tests/upvar.test | 7 | ||||
| -rw-r--r-- | tests/var.test | 7 |
6 files changed, 54 insertions, 7 deletions
@@ -1,3 +1,12 @@ +2004-04-28 Miguel Sofer <msofer@users.sf.net> + + * doc/global.n: + * doc/upvar.n: + * generic/tclVar.c (ObjMakeUpvar): + * tests/upvar.test (upvar-8.11): + * tests/var.test (var-3.11): Avoid creation of unusable variables: + [Bug 600812] [TIP 184]. + 2004-04-28 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/lsearch.n: Fixed fault in documentation of -index option [943448] diff --git a/doc/global.n b/doc/global.n index d4fd4c0..f8e502e 100644 --- a/doc/global.n +++ b/doc/global.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: global.n,v 1.4 2002/06/11 13:22:35 msofer Exp $ +'\" RCS: @(#) $Id: global.n,v 1.5 2004/04/28 13:11:33 msofer Exp $ '\" .so man.macros .TH global n "" Tcl "Tcl Built-In Commands" @@ -28,6 +28,10 @@ For the duration of the current procedure any reference to any of the \fIvarname\fRs will refer to the global variable by the same name. .PP +\fIvarname\fR is always treated as the name of a variable, not an +array element. An error is returned if the name looks like an array element, +such as \fBa(b)\fR. + .SH "SEE ALSO" namespace(n), upvar(n), variable(n) diff --git a/doc/upvar.n b/doc/upvar.n index 2b2175e..84399c7 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: upvar.n,v 1.5 2000/11/21 15:56:21 dkf Exp $ +'\" RCS: @(#) $Id: upvar.n,v 1.6 2004/04/28 13:11:33 msofer Exp $ '\" .so man.macros .TH upvar n "" Tcl "Tcl Built-In Commands" @@ -35,8 +35,8 @@ call; it will be created the first time \fImyVar\fR is referenced, just like an ordinary variable. There must not exist a variable by the name \fImyVar\fR at the time \fBupvar\fR is invoked. \fIMyVar\fR is always treated as the name of a variable, not an -array element. Even if the name looks like an array element, -such as \fBa(b)\fR, a regular variable is created. +array element. An error is returned if the name looks like an array element, +such as \fBa(b)\fR. \fIOtherVar\fR may refer to a scalar variable, an array, or an array element. \fBUpvar\fR returns an empty string. diff --git a/generic/tclVar.c b/generic/tclVar.c index 1b3068b..b3dbbee 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.78 2004/04/06 22:25:56 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.79 2004/04/28 13:11:33 msofer Exp $ */ #include "tclInt.h" @@ -3321,6 +3321,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, Var *otherPtr, *varPtr, *arrayPtr; CallFrame *varFramePtr; CONST char *errMsg; + CONST char *p; /* * Find "other" in "framePtr". If not looking up other in just the @@ -3367,6 +3368,29 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, } /* + * Do not permit the new variable to look like an array reference, + * as it will not be reachable in that case [Bug 600812, TIP 184]. + * The "definition" of what "looks like an array reference" is + * consistent (and must remain consistent) with the code in + * TclObjLookupVar(). + */ + + p = strstr(myName, "("); + if (p != NULL) { + p += strlen(p)-1; + if (*p == ')') { + /* + * myName looks like an array reference. + */ + + Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", + myName, "\": upvar won't create a scalar variable that ", + "looks like an array element", (char *) NULL); + return TCL_ERROR; + } + } + + /* * Lookup and eventually create the new variable. Set the flag bit * LOOKUP_FOR_UPVAR to indicate the special resolution rules for * upvar purposes: diff --git a/tests/upvar.test b/tests/upvar.test index dcc2e23..ed9ce1d 100644 --- a/tests/upvar.test +++ b/tests/upvar.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: upvar.test,v 1.8 2003/11/14 20:44:47 dgp Exp $ +# RCS: @(#) $Id: upvar.test,v 1.9 2004/04/28 13:11:35 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -336,6 +336,11 @@ test upvar-8.10 {upvar will create element alias for new array element} { array set upvarArray {} catch {upvar 0 upvarArray(elem) upvarArrayElemAlias} } {0} +test upvar-8.11 {upvar will not create a variable that looks like an array} -body { + catch {unset upvarArray} + array set upvarArray {} + upvar 0 upvarArray(elem) upvarArrayElemAlias(elem) +} -returnCodes 1 -match glob -result * if {[info commands testupvar] != {}} { test upvar-9.1 {Tcl_UpVar2 procedure} { diff --git a/tests/var.test b/tests/var.test index 8969384..c675d63 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.22 2003/05/12 17:20:41 msofer Exp $ +# RCS: @(#) $Id: var.test,v 1.23 2004/04/28 13:11:35 msofer Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -272,6 +272,11 @@ test var-3.10 {MakeUpvar, } { set msg } } {1 1} +test var-3.11 {MakeUpvar, my var looks like array elem} -body { + catch {unset aaaaa} + set aaaaa 789789 + upvar #0 aaaaa foo(bar) +} -returnCodes 1 -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element} if {[info commands testgetvarfullname] != {}} { test var-4.1 {Tcl_GetVariableName, global variable} { |