summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-04-28 13:11:28 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-04-28 13:11:28 (GMT)
commit74c3e73d8d217092ccc418bd990bf43f9d8890ce (patch)
tree81765be95085309d4c8abe150311d739005cb45c
parent25b3a8473ed731844f2c5f093d1156a80c82e848 (diff)
downloadtcl-74c3e73d8d217092ccc418bd990bf43f9d8890ce.zip
tcl-74c3e73d8d217092ccc418bd990bf43f9d8890ce.tar.gz
tcl-74c3e73d8d217092ccc418bd990bf43f9d8890ce.tar.bz2
* 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].
-rw-r--r--ChangeLog9
-rw-r--r--doc/global.n6
-rw-r--r--doc/upvar.n6
-rw-r--r--generic/tclVar.c26
-rw-r--r--tests/upvar.test7
-rw-r--r--tests/var.test7
6 files changed, 54 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 7be5697..1d7dd94 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {