summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-02-01 17:48:04 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-02-01 17:48:04 (GMT)
commit2e9bf45bc4d2510a07a538c48f8103957ede3aaf (patch)
treeded30cb2443dbed838e4a79ea4cf381328c34592 /generic/tclVar.c
parent0fbd247a14d17e3925000c394aaa26523bd2fa12 (diff)
downloadtcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.zip
tcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.tar.gz
tcl-2e9bf45bc4d2510a07a538c48f8103957ede3aaf.tar.bz2
TIP#250 IMPLEMENTATION
* doc/namespace.n: New command [namespace upvar]. [Patch 1275435] * generic/tclInt.h: * generic/tclNamesp.c: * generic/tclVar.c: * tests/namespace.test: * tests/upvar.test:
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c82
1 files changed, 62 insertions, 20 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 0bf98cf..6ae9d16 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.117 2005/11/27 02:33:49 das Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.118 2006/02/01 17:48:11 dgp Exp $
*/
#include "tclInt.h"
@@ -3204,10 +3204,8 @@ ObjMakeUpvar(
* scalar, this is its index. Otherwise, -1 */
{
Interp *iPtr = (Interp *) interp;
- Var *otherPtr, *varPtr, *arrayPtr;
+ Var *otherPtr, *arrayPtr;
CallFrame *varFramePtr;
- CONST char *errMsg;
- CONST char *p;
/*
* Find "other" in "framePtr". If not looking up other in just the current
@@ -3229,30 +3227,74 @@ ObjMakeUpvar(
return TCL_ERROR;
}
- if (index >= 0) {
- if (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
- Tcl_Panic("ObjMakeUpvar called with an index outside from a proc.\n");
- }
- varPtr = &(varFramePtr->compiledLocals[index]);
- } else {
- /*
- * Check that we are not trying to create a namespace var linked to a
- * local variable in a procedure. If we allowed this, the local
- * variable in the shorter-lived procedure frame could go away leaving
- * the namespace var's reference invalid.
- */
+ /*
+ * Check that we are not trying to create a namespace var linked to a
+ * local variable in a procedure. If we allowed this, the local
+ * variable in the shorter-lived procedure frame could go away leaving
+ * the namespace var's reference invalid.
+ */
+ if (index < 0) {
if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
- && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
- || (varFramePtr == NULL)
- || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
- || (strstr(myName, "::") != NULL))) {
+ && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+ || (varFramePtr == NULL)
+ || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+ || (strstr(myName, "::") != NULL))) {
Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
myName, "\": upvar won't create namespace variable that ",
"refers to procedure variable", NULL);
return TCL_ERROR;
}
+ }
+ return TclPtrMakeUpvar(interp, otherPtr, myName, myFlags, index);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrMakeUpvar --
+ *
+ * This procedure does all of the work of the "global" and "upvar"
+ * commands.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs then an error
+ * message is left in iPtr->result.
+ *
+ * Side effects:
+ * The variable given by myName is linked to the variable in framePtr
+ * given by otherP1 and otherP2, so that references to myName are
+ * redirected to the other variable like a symbolic link.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPtrMakeUpvar(interp, otherPtr, myName, myFlags, index)
+ Tcl_Interp *interp; /* Interpreter containing variables. Used for
+ * error messages, too. */
+ Var *otherPtr; /* Pointer to the variable being linked-to */
+ CONST char *myName; /* Name of variable which will refer to
+ * otherP1/otherP2. Must be a scalar. */
+ int myFlags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
+ * indicates scope of myName. */
+ int index; /* If the variable to be linked is an indexed
+ * scalar, this is its index. Otherwise, -1 */
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ Var *varPtr;
+ CONST char *errMsg;
+ CONST char *p;
+
+ if (index >= 0) {
+ if (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ Tcl_Panic("ObjMakeUpvar called with an index outside from a proc.\n");
+ }
+ varPtr = &(varFramePtr->compiledLocals[index]);
+ } else {
/*
* 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