summaryrefslogtreecommitdiffstats
path: root/generic/tclVar.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r--generic/tclVar.c72
1 files changed, 58 insertions, 14 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 54699ce..c2aea55 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,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.184 2009/11/20 00:19:46 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.185 2010/01/30 16:33:25 dkf Exp $
*/
#include "tclInt.h"
@@ -158,7 +158,7 @@ static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void UnsetVarStruct(Var *varPtr, Var *arrayPtr,
Interp *iPtr, Tcl_Obj *part1Ptr,
- Tcl_Obj *part2Ptr, int flags);
+ Tcl_Obj *part2Ptr, int flags, int index);
static int SetArraySearchObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
@@ -2204,10 +2204,7 @@ TclObjUnsetVar2(
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
* TCL_LEAVE_ERR_MSG. */
{
- Var *varPtr;
- Interp *iPtr = (Interp *) interp;
- Var *arrayPtr;
- int result;
+ Var *varPtr, *arrayPtr;
varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
@@ -2215,7 +2212,52 @@ TclObjUnsetVar2(
return TCL_ERROR;
}
- result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+ return TclPtrUnsetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags,
+ -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPtrUnsetVar --
+ *
+ * Delete a variable, given the pointers to the variable's (and possibly
+ * containing array's) VAR structure.
+ *
+ * Results:
+ * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
+ * the variable can't be unset. In the event of an error, if the
+ * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
+ * interp's result.
+ *
+ * Side effects:
+ * If varPtr and arrayPtr indicate a local or global variable in interp,
+ * it is deleted. If varPtr is an array reference and part2Ptr is NULL,
+ * then the whole array is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPtrUnsetVar(
+ Tcl_Interp *interp, /* Command interpreter in which varName is to
+ * be looked up. */
+ register Var *varPtr, /* The variable to be unset. */
+ Var *arrayPtr, /* NULL for scalar variables, pointer to the
+ * containing array otherwise. */
+ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
+ * the name of a variable. */
+ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ const int flags, /* OR-ed combination of any of
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * TCL_LEAVE_ERR_MSG. */
+ int index) /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
+{
+ Interp *iPtr = (Interp *) interp;
+ int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
/*
* Keep the variable alive until we're done with it. We used to
@@ -2228,7 +2270,7 @@ TclObjUnsetVar2(
VarHashRefCount(varPtr)++;
}
- UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);
+ UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
/*
* It's an error to unset an undefined variable.
@@ -2237,7 +2279,7 @@ TclObjUnsetVar2(
if (result != TCL_OK) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
- ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
+ ((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
}
}
@@ -2294,7 +2336,8 @@ UnsetVarStruct(
Interp *iPtr,
Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr,
- int flags)
+ int flags,
+ int index)
{
Var dummyVar;
int traced = TclIsVarTraced(varPtr)
@@ -2364,7 +2407,7 @@ UnsetVarStruct(
TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
(flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
| TCL_TRACE_UNSETS,
- /* leaveErrMsg */ 0, -1);
+ /* leaveErrMsg */ 0, index);
/*
* The traces that we just called may have triggered a change in
@@ -4418,7 +4461,7 @@ TclDeleteNamespaceVars(
* hash. */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
- NULL, flags);
+ NULL, flags, -1);
Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
@@ -4506,7 +4549,8 @@ TclDeleteVars(
*/
VarHashInvalidateEntry(varPtr);
- UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
+ UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
+ -1);
}
VarHashDeleteTable(tablePtr);
}
@@ -4548,7 +4592,7 @@ TclDeleteCompiledLocalVars(
namePtrPtr = &localName(framePtr, 0);
for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
- TCL_TRACE_UNSETS);
+ TCL_TRACE_UNSETS, i);
}
framePtr->numCompiledLocals = 0;
}