Attachment "1338280-84.patch" to
ticket [1338280fff]
added by
dgp
2005-11-03 00:10:18.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118.2.18
diff -u -r1.118.2.18 tclInt.h
--- generic/tclInt.h 10 Oct 2005 21:33:09 -0000 1.118.2.18
+++ generic/tclInt.h 2 Nov 2005 17:08:41 -0000
@@ -1652,6 +1652,7 @@
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *value));
+EXTERN void TclDeleteNamespaceVars _ANSI_ARGS_((Namespace *nsPtr));
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
Tcl_Parse *parsePtr));
EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.31.2.8
diff -u -r1.31.2.8 tclNamesp.c
--- generic/tclNamesp.c 26 Jul 2005 16:20:44 -0000 1.31.2.8
+++ generic/tclNamesp.c 2 Nov 2005 17:08:41 -0000
@@ -629,7 +629,7 @@
* variable list one last time.
*/
- TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable);
+ TclDeleteNamespaceVars(nsPtr);
Tcl_DeleteHashTable(&nsPtr->childTable);
Tcl_DeleteHashTable(&nsPtr->cmdTable);
@@ -713,7 +713,7 @@
Tcl_IncrRefCount(errorCode);
}
- TclDeleteVars(iPtr, &nsPtr->varTable);
+ TclDeleteNamespaceVars(nsPtr);
Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
if (errorInfo) {
@@ -732,7 +732,7 @@
* frees it, so we reinitialize it afterwards.
*/
- TclDeleteVars(iPtr, &nsPtr->varTable);
+ TclDeleteNamespaceVars(nsPtr);
Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
}
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.69.2.9
diff -u -r1.69.2.9 tclVar.c
--- generic/tclVar.c 23 Oct 2005 22:01:31 -0000 1.69.2.9
+++ generic/tclVar.c 2 Nov 2005 17:08:42 -0000
@@ -66,7 +66,9 @@
CONST char *operation, CONST char *reason));
static int SetArraySearchObj _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
-
+static void UnsetVarStruct _ANSI_ARGS_((Var *varPtr, Var *arrayPtr,
+ Interp *iPtr, CONST char *part1, CONST char *part2,
+ int flags));
/*
* Functions defined in this file that may be exported in the future
@@ -1986,39 +1988,43 @@
*----------------------------------------------------------------------
*/
-int
-TclObjUnsetVar2(interp, part1Ptr, part2, flags)
- Tcl_Interp *interp; /* Command interpreter in which varName is
- * to be looked up. */
- Tcl_Obj *part1Ptr; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array or NULL. */
- int flags; /* OR-ed combination of any of
- * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_LEAVE_ERR_MSG. */
+static void
+UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags)
+ Var *varPtr;
+ Var *arrayPtr;
+ Interp *iPtr;
+ CONST char *part1;
+ CONST char *part2;
+ int flags;
{
Var dummyVar;
- Var *varPtr, *dummyVarPtr;
- Interp *iPtr = (Interp *) interp;
- Var *arrayPtr;
+ Var *dummyVarPtr;
ActiveVarTrace *activePtr;
- Tcl_Obj *objPtr;
- int result;
- char *part1;
-
- part1 = TclGetString(part1Ptr);
- varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
- /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- if (varPtr == NULL) {
- return TCL_ERROR;
- }
-
- result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
DeleteSearches(arrayPtr);
}
/*
+ * For global/upvar variables referenced in procedures, decrement
+ * the reference count on the variable referred to, and free
+ * the referenced variable if it's no longer needed.
+ */
+
+ if (TclIsVarLink(varPtr)) {
+ Var *linkPtr = varPtr->value.linkPtr;
+ linkPtr->refCount--;
+ if ((linkPtr->refCount == 0) && TclIsVarUndefined(linkPtr)
+ && (linkPtr->tracePtr == NULL)
+ && (linkPtr->flags & VAR_IN_HASHTABLE)) {
+ if (linkPtr->hPtr != NULL) {
+ Tcl_DeleteHashEntry(linkPtr->hPtr);
+ }
+ ckfree((char *) linkPtr);
+ }
+ }
+
+ /*
* The code below is tricky, because of the possibility that
* a trace procedure might try to access a variable being
* deleted. To handle this situation gracefully, do things
@@ -2039,15 +2045,6 @@
varPtr->searchPtr = NULL;
/*
- * Keep the variable alive until we're done with it. We used to
- * increase/decrease the refCount for each operation, making it
- * hard to find [Bug 735335] - caused by unsetting the variable
- * whose value was the variable's name.
- */
-
- varPtr->refCount++;
-
- /*
* Call trace procedures for the variable being deleted. Then delete
* its traces. Be sure to abort any other traces for the variable
* that are still pending. Special tricks:
@@ -2104,7 +2101,7 @@
}
if (TclIsVarScalar(dummyVarPtr)
&& (dummyVarPtr->value.objPtr != NULL)) {
- objPtr = dummyVarPtr->value.objPtr;
+ Tcl_Obj *objPtr = dummyVarPtr->value.objPtr;
TclDecrRefCount(objPtr);
dummyVarPtr->value.objPtr = NULL;
}
@@ -2118,6 +2115,44 @@
varPtr->refCount--;
}
+}
+
+int
+TclObjUnsetVar2(interp, part1Ptr, part2, flags)
+ Tcl_Interp *interp; /* Command interpreter in which varName is
+ * to be looked up. */
+ Tcl_Obj *part1Ptr; /* Name of variable or array. */
+ CONST char *part2; /* Name of element within array or NULL. */
+ int flags; /* OR-ed combination of any of
+ * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * TCL_LEAVE_ERR_MSG. */
+{
+ Var *varPtr;
+ Interp *iPtr = (Interp *) interp;
+ Var *arrayPtr;
+ int result;
+ char *part1;
+
+ part1 = TclGetString(part1Ptr);
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
+ /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+
+ /*
+ * Keep the variable alive until we're done with it. We used to
+ * increase/decrease the refCount for each operation, making it
+ * hard to find [Bug 735335] - caused by unsetting the variable
+ * whose value was the variable's name.
+ */
+
+ varPtr->refCount++;
+
+ UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);
+
/*
* It's an error to unset an undefined variable.
*/
@@ -4532,6 +4567,58 @@
*/
void
+TclDeleteNamespaceVars(nsPtr)
+ Namespace *nsPtr;
+{
+ Tcl_HashTable *tablePtr = &nsPtr->varTable;
+ Tcl_Interp *interp = nsPtr->interp;
+ Interp *iPtr = (Interp *)interp;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ int flags = 0;
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+
+ /*
+ * Determine what flags to pass to the trace callback procedures.
+ */
+
+ if (nsPtr == iPtr->globalNsPtr) {
+ flags = TCL_GLOBAL_ONLY;
+ } else if (nsPtr == currNsPtr) {
+ flags = TCL_NAMESPACE_ONLY;
+ }
+ if (Tcl_InterpDeleted(interp)) {
+ flags |= TCL_INTERP_DESTROYED;
+ }
+
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
+ register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ varPtr->refCount++; /* Make sure we get to remove from hash */
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
+ UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags);
+ Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
+ varPtr->refCount--;
+
+ /* Remove the variable from the table and force it undefined
+ * in case an unset trace brought it back from the dead */
+ Tcl_DeleteHashEntry(hPtr);
+ varPtr->hPtr = NULL;
+ TclSetVarUndefined(varPtr);
+ TclSetVarScalar(varPtr);
+ while (varPtr->tracePtr != NULL) {
+ VarTrace *tracePtr = varPtr->tracePtr;
+ varPtr->tracePtr = tracePtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+ }
+ CleanupVar(varPtr, NULL);
+ }
+ Tcl_DeleteHashTable(tablePtr);
+}
+
+void
TclDeleteVars(iPtr, tablePtr)
Interp *iPtr; /* Interpreter to which variables belong. */
Tcl_HashTable *tablePtr; /* Hash table containing variables to
