diff options
| -rw-r--r-- | generic/tclBasic.c | 2 | ||||
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 206 | ||||
| -rw-r--r-- | generic/tclOO.c | 23 | ||||
| -rw-r--r-- | tests/namespace.test | 4 | ||||
| -rw-r--r-- | tests/oo.test | 34 |
6 files changed, 110 insertions, 160 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e18d1b7..56356e2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3740,7 +3740,7 @@ CallCommandTraces( */ cmdPtr->flags &= ~CMD_TRACE_ACTIVE; - TclCleanupCommandMacro(cmdPtr); + cmdPtr->refCount--; iPtr->activeCmdTracePtr = active.nextPtr; Tcl_Release(iPtr); return result; diff --git a/generic/tclInt.h b/generic/tclInt.h index e86a0cc..fa661d6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2958,7 +2958,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); -MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPt); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int dictLength, const char **elementPtr, const char **nextPtr, diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 1d20a77..f57b7e1 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -884,20 +884,22 @@ Tcl_CreateNamespace( * Tcl_DeleteNamespace -- * * Deletes a namespace and all of the commands, variables, and other - * namespaces within it, and disassociates the namespace from its parent. + * namespaces within it. * * Results: * None. * * Side effects: - * See description. + * When a namespace is deleted, it is automatically removed as a child of + * its parent namespace. Also, all its commands, variables and child + * namespaces are deleted. * *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( - Tcl_Namespace *namespacePtr) /* Points to the namespace to delete. */ + Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; @@ -913,13 +915,12 @@ Tcl_DeleteNamespace( nsPtr->refCount++; /* - * Before marking the namespace as dying, give anyone interested, notably - * TclOO, a chance to use this namespace normally despite the fact that - * the namespace is going to go. Allows the calling of destructors. Only - * called once (unless re-established by the called function). [Bug - * 2950259] + * Give anyone interested - notably TclOO - a chance to use this namespace + * normally despite the fact that the namespace is going to go. Allows the + * calling of destructors. Will only be called once (unless re-established + * by the called function). [Bug 2950259] * - * Setting this field requires access to the internal definition + * Note that setting this field requires access to the internal definition * of namespaces, so it should only be accessed by code that knows about * being careful with reentrancy. */ @@ -934,13 +935,13 @@ Tcl_DeleteNamespace( } /* - * Delete all coroutines now to break the circular ref cycle between - * the namespace and any coroutines [Bug 2724403]. This code is + * Delete all coroutine commands now: break the circular ref cycle between + * the namespace and the coroutine command [Bug 2724403]. This code is * essentially duplicated in TclTeardownNamespace() for all other * commands. Don't optimize to Tcl_NextHashEntry() because of traces. * - * Maybe later avoid traversing the command table by keeping a - * separate list of coroutines. + * NOTE: we could avoid traversing the ns's command list by keeping a + * separate list of coros. */ for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); @@ -958,7 +959,7 @@ Tcl_DeleteNamespace( /* * If the namespace has associated ensemble commands, delete them first. * This leaves the actual contents of the namespace alone (unless they are - * linked ensemble commands, of course). This code is actually + * linked ensemble commands, of course). Note that this code is actually * reentrant so command delete traces won't purturb things badly. */ @@ -985,14 +986,20 @@ Tcl_DeleteNamespace( } /* - * If the namespace is on the call frame stack, add the flag NS_DYING, - * after the namesapce can not be reached by name, but its commands and - * variables are still usable from in those active call frames. When all - * active call frames referring to the namespace have been popped from the - * Tcl stack, Tcl_PopCallFrame calls this function again to delete - * everything in the namespace. Its commands and variables are deleted. - * When the structure's refCount reaches 0 FreeNsNameInternalRep frees the - * storage for the structure. + * If the namespace is on the call frame stack, it is marked as "dying" + * (NS_DYING is OR'd into its flags): the namespace can't be looked up by + * name but its commands and variables are still usable by those active + * call frames. When all active call frames referring to the namespace + * have been popped from the Tcl stack, Tcl_PopCallFrame will call this + * function again to delete everything in the namespace. If no nsName + * objects refer to the namespace (i.e., if its refCount is zero), its + * commands and variables are deleted and the storage for its namespace + * structure is freed. Otherwise, if its refCount is nonzero, the + * namespace's commands and variables are deleted but the structure isn't + * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the + * namespace resolution code to recognize that the namespace is "deleted". + * The structure's storage is freed by FreeNsNameInternalRep when its + * refCount reaches 0. */ if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { @@ -1008,10 +1015,11 @@ Tcl_DeleteNamespace( nsPtr->parentPtr = NULL; } else if (!(nsPtr->flags & NS_KILLED)) { /* - * Time to actually delete the namespace and everything in it. If this - * is the global namespace, clear it but don't free its storage unless - * the interpreter is being deleted. Set the NS_KILLED flag to prevent - * additional entry to this section. + * Delete the namespace and everything in it. If this is the global + * namespace, then clear it but don't free its storage unless the + * interpreter is being torn down. Set the NS_KILLED flag to avoid + * recursive calls here - if the namespace is really in the process of + * being deleted, ignore any second call. */ nsPtr->flags |= (NS_DYING|NS_KILLED); @@ -1022,8 +1030,8 @@ Tcl_DeleteNamespace( /* * If this is the global namespace, then it may have residual * "errorInfo" and "errorCode" variables for errors that occurred - * while it was being torn down. Try one last time to clear the - * variable list. + * while it was being torn down. Try to clear the variable list + * one last time. */ TclDeleteNamespaceVars(nsPtr); @@ -1048,8 +1056,8 @@ Tcl_DeleteNamespace( EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0); /* - * The namespace is not deleted yet. Remove the KILLED marks, so it - * can be deleted later, avoiding mem leaks. + * We didn't really kill it, so remove the KILLED marks, so it can + * get killed later, avoiding mem leaks. */ nsPtr->flags &= ~(NS_DYING|NS_KILLED); @@ -1057,7 +1065,7 @@ Tcl_DeleteNamespace( } TclNsDecrRefCount(nsPtr); } - + int TclNamespaceDeleted( Namespace *nsPtr) @@ -1065,83 +1073,6 @@ TclNamespaceDeleted( return (nsPtr->flags & NS_DYING) ? 1 : 0; } -void -TclDeleteNamespaceChildren( - Namespace *nsPtr /* Namespace whose children to delete */ -) -{ - Interp *iPtr = (Interp *) nsPtr->interp; - Tcl_HashEntry *entryPtr; - int i, unchecked; - Tcl_HashSearch search; - /* - * Delete all the child namespaces. - * - * BE CAREFUL: When each child is deleted, it divorces itself from its - * parent. The hash table can't be proplery traversed if its elements are - * being deleted. Because of traces (and the desire to avoid the - * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug - * f97d4ee020]) copy to a temporary array and then delete all those - * namespaces. - * - * Important: leave the hash table itself still live. - */ - -#ifndef BREAK_NAMESPACE_COMPAT - unchecked = (nsPtr->childTable.numEntries > 0); - while (nsPtr->childTable.numEntries > 0 && unchecked) { - int length = nsPtr->childTable.numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); - - i = 0; - for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); - children[i]->refCount++; - i++; - } - unchecked = 0; - for (i = 0 ; i < length ; i++) { - if (!(children[i]->flags & NS_DYING)) { - unchecked = 1; - Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); - TclNsDecrRefCount(children[i]); - } - } - TclStackFree((Tcl_Interp *) iPtr, children); - } -#else - if (nsPtr->childTablePtr != NULL) { - unchecked = (nsPtr->childTable.numEntries > 0); - while (nsPtr->childTable.numEntries > 0 && unchecked) { - int length = nsPtr->childTablePtr->numEntries; - Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Namespace *) * length); - - i = 0; - for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); - children[i]->refCount++; - i++; - } - unchecked = 0; - for (i = 0 ; i < length ; i++) { - if (!(children[i]->flags & NS_DYING)) { - unchecked = 1; - Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); - TclNsDecrRefCount(children[i]); - } - } - TclStackFree((Tcl_Interp *) iPtr, children); - } - } -#endif -} - /* *---------------------------------------------------------------------- * @@ -1174,9 +1105,6 @@ TclTeardownNamespace( Tcl_HashSearch search; int i; - - TclDeleteNamespaceChildren(nsPtr); - /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! @@ -1253,6 +1181,62 @@ TclTeardownNamespace( nsPtr->commandPathSourceList = NULL; } + /* + * Delete all the child namespaces. + * + * BE CAREFUL: When each child is deleted, it will divorce itself from its + * parent. You can't traverse a hash table properly if its elements are + * being deleted. Because of traces (and the desire to avoid the + * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug + * f97d4ee020]) we copy to a temporary array and then delete all those + * namespaces. + * + * Important: leave the hash table itself still live. + */ + +#ifndef BREAK_NAMESPACE_COMPAT + while (nsPtr->childTable.numEntries > 0) { + int length = nsPtr->childTable.numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); + + i = 0; + for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + entryPtr != NULL; + entryPtr = Tcl_NextHashEntry(&search)) { + children[i] = (Namespace *)Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; + } + for (i = 0 ; i < length ; i++) { + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); + } + TclStackFree((Tcl_Interp *) iPtr, children); + } +#else + if (nsPtr->childTablePtr != NULL) { + while (nsPtr->childTablePtr->numEntries > 0) { + int length = nsPtr->childTablePtr->numEntries; + Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); + + i = 0; + for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); + entryPtr != NULL; + entryPtr = Tcl_NextHashEntry(&search)) { + children[i] = Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; + } + for (i = 0 ; i < length ; i++) { + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); + } + TclStackFree((Tcl_Interp *) iPtr, children); + } + } +#endif /* * Free the namespace's export pattern array. diff --git a/generic/tclOO.c b/generic/tclOO.c index 452e2ef..405d5d0 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1184,19 +1184,18 @@ ObjectNamespaceDeleted( * freed memory. */ - if (oPtr->command != NULL) { - if (((Command *) oPtr->command)->flags && CMD_DYING) { - /* - * The command is already (being) deleted. Proceed to clean up the the namespace, - */ - } else { - /* - * The namespace must have been deleted directly. Delete the command - * as well. - */ + if (((Command *) oPtr->command)->flags && CMD_DYING) { + /* + * Something has already started the command deletion process. We can + * go ahead and clean up the the namespace, + */ + } else { + /* + * The namespace must have been deleted directly. Delete the command + * as well. + */ - Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); - } + Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command); } if (oPtr->myclassCommand) { diff --git a/tests/namespace.test b/tests/namespace.test index dc0e56d..efd00a8 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3289,8 +3289,8 @@ test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { namespace eval ::testing { namespace eval abc {proc xyz {} {}} namespace eval def {proc xyz {} {}} - trace add command abc::xyz delete "namespace delete ::testing::def; #" - trace add command def::xyz delete "namespace delete ::testing::abc; #" + trace add command abc::xyz delete "namespace delete ::testing::def {}; #" + trace add command def::xyz delete "namespace delete ::testing::abc {}; #" } namespace delete ::testing } {} diff --git a/tests/oo.test b/tests/oo.test index 7980f9e..168baee 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1734,7 +1734,6 @@ test oo-11.6.3 { } -result 0 -cleanup { } - test oo-11.6.4 { OO: cleanup ReleaseClassContents() where class is mixed into one of its instances @@ -1755,34 +1754,6 @@ test oo-11.6.4 { rename obj1 {} } - -test oo-11.7 { - When an object is deleted its namespace is deleted, and all objects it is - mixed into are also deleted. If the object has been renamed into the - namespace of one of the objects it has been mixed into, the routine for the - object might get entirely deleted before the namespace of the object is - entirely deleted, in which case the C routine that performs the namespace - deletion either must either understand that the handle on the routine for - the object might now be gone, or it must be guaranteed that the handle does - not disappear until that routine is finished. -} -setup { -} -body { - oo::class create class1 - - oo::object create obj1 - oo::objdefine obj1 { - mixin ::class1 - } - set obj1ns [info object namespace obj1] - set class1ns [info object namespace class1] - rename class1 ${obj1ns}::class1 - # No segmentation fault - namespace delete $class1ns - return done -} -cleanup { -} -result done - - test oo-12.1 {OO: filters} { oo::class create Aclass Aclass create Aobject @@ -1806,8 +1777,6 @@ test oo-12.1 {OO: filters} { Aclass destroy return $result } {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345} - - test oo-12.2 {OO: filters} -setup { oo::class create Aclass Aclass create Aobject @@ -4407,13 +4376,12 @@ test oo-35.6 { } -body { rename obj2 {} rename obj1 {} - # No segmentation fault + # doesn't crash return done } -cleanup { rename obj {} } -result done - test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object |