diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 22 | ||||
| -rw-r--r-- | generic/tclVar.c | 261 | ||||
| -rw-r--r-- | tests/trace.test | 4 |
5 files changed, 215 insertions, 84 deletions
@@ -1,3 +1,12 @@ +2005-11-04 Miguel Sofer <msofer@users.sf.net> + + * generic/tclInt.h: + * generic/tclNamesp.c: + * generic/tclVar.c: + * tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use + the same approach as the 8.4 patch in the ticket (i.e., removed + the patch committed on 2005-31-10). + 2005-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> * win/tclWin32Dll.c: Applied patch #1256872 to provide unicode diff --git a/generic/tclInt.h b/generic/tclInt.h index 32ef3b0..0a6fa66 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.255 2005/10/10 19:52:44 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.256 2005/11/04 02:13:41 msofer Exp $ */ #ifndef _TCLINT @@ -2019,6 +2019,7 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp* interp, LiteralTable* tablePtr); MODULE_SCOPE int TclDoubleDigits(char* buf, double value, int* signum); +MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclExpandTokenArray(Tcl_Parse *parsePtr); MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 456f335..299b1ac 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,7 +21,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.85 2005/10/31 19:54:56 msofer Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.86 2005/11/04 02:13:41 msofer Exp $ */ #include "tclInt.h" @@ -958,7 +958,7 @@ Tcl_DeleteNamespace(namespacePtr) * one last time. */ - TclDeleteVars((Interp *) nsPtr->interp, &nsPtr->varTable); + TclDeleteNamespaceVars(nsPtr); Tcl_DeleteHashTable(&nsPtr->childTable); Tcl_DeleteHashTable(&nsPtr->cmdTable); @@ -1019,6 +1019,15 @@ TclTeardownNamespace(nsPtr) int i; /* + * Start by destroying the namespace's variable table, since variables + * might trigger traces. Variable table should be cleared but not freed! + * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards. + */ + + TclDeleteNamespaceVars(nsPtr); + Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); + + /* * Delete all commands in this namespace. Be careful when traversing the * hash table: when each command is deleted, it removes itself from the * command table. @@ -1049,15 +1058,6 @@ TclTeardownNamespace(nsPtr) nsPtr->parentPtr = NULL; /* - * Destroy the namespace's variable table - * Variable table should be cleared but not freed! - * TclDeleteVars frees it, so we reinitialize it afterwards. - */ - - TclDeleteVars(iPtr, &nsPtr->varTable); - Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS); - - /* * Delete the namespace path if one is installed. */ diff --git a/generic/tclVar.c b/generic/tclVar.c index 08b00aa..d8fb817 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.113 2005/11/02 11:55:47 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.114 2005/11/04 02:13:41 msofer Exp $ */ #include "tclInt.h" @@ -52,6 +52,8 @@ static int ObjMakeUpvar(Tcl_Interp *interp, static Var * NewVar(void); static ArraySearch * ParseSearchId(Tcl_Interp *interp, CONST Var *varPtr, CONST char *varName, Tcl_Obj *handleObj); +static void UnsetVarStruct(Var *varPtr, Var *arrayPtr, Interp *iPtr, + CONST char *part1, CONST char *part2, int flags); static int SetArraySearchObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* @@ -1953,12 +1955,9 @@ TclObjUnsetVar2( * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { - Var dummyVar; - Var *varPtr, *dummyVarPtr; + Var *varPtr; Interp *iPtr = (Interp *) interp; Var *arrayPtr; - ActiveVarTrace *activePtr; - Tcl_Obj *objPtr; int result; char *part1; @@ -1968,23 +1967,120 @@ TclObjUnsetVar2( 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. + */ + + if (result != TCL_OK) { + if (flags & TCL_LEAVE_ERR_MSG) { + TclVarErrMsg(interp, part1, part2, "unset", + ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); + } + } + +#if ENABLE_NS_VARNAME_CACHING + /* + * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType + * keeping a reference. This removes some additional exteriorisations of + * [Bug 736729], but may be a good thing independently of the bug. + */ + + if (part1Ptr->typePtr == &tclNsVarNameType) { + TclFreeIntRep(part1Ptr); + part1Ptr->typePtr = NULL; + } +#endif + + /* + * Finally, if the variable is truly not in use then free up its Var + * structure and remove it from its hash table, if any. The ref count of + * its value object, if any, was decremented above. + */ + + varPtr->refCount--; + TclCleanupVar(varPtr, arrayPtr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * UnsetVarStruct -- + * + * Unset and delete a variable. This does the internal work for + * TclObjUnsetVar2 and TclDeleteNamespaceVars, which call here for each + * variable to be unset and deleted. + * + * Results: + * None. + * + * Side effects: + * If the arguments indicate a local or global variable in iPtr, it is + * unset and deleted. + * + *---------------------------------------------------------------------- + */ + +static void +UnsetVarStruct( + Var *varPtr, + Var *arrayPtr, + Interp *iPtr, + CONST char *part1, + CONST char *part2, + int flags) +{ + Var dummyVar; + Var *dummyVarPtr; + ActiveVarTrace *activePtr; + 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 * function might try to access a variable being deleted. To handle this * situation gracefully, do things in three steps: * 1. Copy the contents of the variable to a dummy variable structure, and - * mark the original Var structure as undefined. + * mark the original Var structure as undefined. * 2. Invoke traces and clean up the variable, using the dummy copy. * 3. If at the end of this the original variable is still undefined and - * has no outstanding references, then delete * it (but it could have - * gotten recreated by a trace). + * has no outstanding references, then delete it (but it could have + * gotten recreated by a trace). */ dummyVar = *varPtr; @@ -1995,22 +2091,13 @@ TclObjUnsetVar2( 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 functions for the variable being deleted. Then delete its + * 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: + * still pending. Special tricks: * 1. We need to increment varPtr's refCount around this: TclCallVarTraces * will use dummyVar so it won't increment varPtr's refCount itself. - * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call - * unset traces even if other traces are pending. + * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to + * call unset traces even if other traces are pending. */ if ((dummyVar.tracePtr != NULL) @@ -2024,8 +2111,8 @@ TclObjUnsetVar2( dummyVar.tracePtr = tracePtr->nextPtr; Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC); } - for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; + activePtr = activePtr->nextPtr) { if (activePtr->varPtr == varPtr) { activePtr->nextTracePtr = NULL; } @@ -2036,82 +2123,45 @@ TclObjUnsetVar2( * If the variable is an array, delete all of its elements. This must be * done after calling the traces on the array, above (that's the way * traces are defined). If it is a scalar, "discard" its object (decrement - * the ref count of its object, if any). + * the ref count of its object, if any). */ dummyVarPtr = &dummyVar; if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { /* * Deleting the elements of the array may cause traces to be fired on - * those elements. Before deleting them, bump the reference count of + * those elements. Before deleting them, bump the reference count of * the array, so that if those trace procs make a global or upvar link * to the array, the array is not deleted when the call stack gets * popped (we will delete the array ourselves later in this function). * - * Bumping the count can lead to the odd situation that elements of - * the array are being deleted when the array still exists, but since - * the array is about to be removed anyway, that shouldn't really - * matter. + * Bumping the count can lead to the odd situation that elements of the + * array are being deleted when the array still exists, but since the + * array is about to be removed anyway, that shouldn't really matter. */ - DeleteArray(iPtr, part1, dummyVarPtr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); - /* * Decr ref count */ } if (TclIsVarScalar(dummyVarPtr) && (dummyVarPtr->value.objPtr != NULL)) { - objPtr = dummyVarPtr->value.objPtr; + Tcl_Obj *objPtr = dummyVarPtr->value.objPtr; TclDecrRefCount(objPtr); dummyVarPtr->value.objPtr = NULL; } /* - * If the variable was a namespace variable, decrement its reference - * count. + * If the variable was a namespace variable, decrement its reference count. */ - + if (TclIsVarNamespaceVar(varPtr)) { TclClearVarNamespaceVar(varPtr); varPtr->refCount--; } - /* - * It's an error to unset an undefined variable. - */ - - if (result != TCL_OK) { - if (flags & TCL_LEAVE_ERR_MSG) { - TclVarErrMsg(interp, part1, part2, "unset", - ((arrayPtr == NULL) ? noSuchVar : noSuchElement)); - } - } - -#if ENABLE_NS_VARNAME_CACHING - /* - * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType - * keeping a reference. This removes some additional exteriorisations of - * [Bug 736729], but may be a good thing independently of the bug. - */ - - if (part1Ptr->typePtr == &tclNsVarNameType) { - TclFreeIntRep(part1Ptr); - part1Ptr->typePtr = NULL; - } -#endif - - /* - * Finally, if the variable is truly not in use then free up its Var - * structure and remove it from its hash table, if any. The ref count of - * its value object, if any, was decremented above. - */ - - varPtr->refCount--; - TclCleanupVar(varPtr, arrayPtr); - return result; } /* @@ -3929,6 +3979,77 @@ DeleteSearches( /* *---------------------------------------------------------------------- * + * TclDeleteNamespaceVars -- + * + * This procedure is called to recycle all the storage space + * associated with a namespace's table of variables. + * + * Results: + * None. + * + * Side effects: + * Variables are deleted and trace procedures are invoked, if + * any are declared. + * + *---------------------------------------------------------------------- + */ + +void +TclDeleteNamespaceVars( + 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); + } + TclCleanupVar(varPtr, NULL); + } + Tcl_DeleteHashTable(tablePtr); +} + + +/* + *---------------------------------------------------------------------- + * * TclDeleteVars -- * * This function is called to recycle all the storage space associated diff --git a/tests/trace.test b/tests/trace.test index 224f698..29c6a9a 100644 --- a/tests/trace.test +++ b/tests/trace.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: trace.test,v 1.42 2005/10/31 19:54:56 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.43 2005/11/04 02:13:41 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1179,7 +1179,7 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} { namespace delete ::ref rename doTrace {} set info -} 1010 +} 1110 # Delete arrays when done, so they can be re-used as scalars # elsewhere. |