diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2016-05-21 09:26:07 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2016-05-21 09:26:07 (GMT) |
commit | f74fa93858b232af77de13991c43775c193df25a (patch) | |
tree | 41386636fdb87c929e9f9a78888ce2539fa00a3d | |
parent | 07666542f4a7b9ba216e19b1fd3d5db1b3f943c3 (diff) | |
download | tcl-f74fa93858b232af77de13991c43775c193df25a.zip tcl-f74fa93858b232af77de13991c43775c193df25a.tar.gz tcl-f74fa93858b232af77de13991c43775c193df25a.tar.bz2 |
Make the tests pass.bug_f97d4ee020
-rw-r--r-- | generic/tclNamesp.c | 40 | ||||
-rw-r--r-- | tests/namespace.test | 20 |
2 files changed, 46 insertions, 14 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index d286de4..58a86d9 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1127,17 +1127,21 @@ TclTeardownNamespace( while (nsPtr->cmdTable.numEntries > 0) { int length = nsPtr->cmdTable.numEntries; - Tcl_Command *cmds = TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Tcl_Command) * length); + Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Command *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - cmds[i++] = Tcl_GetHashValue(entryPtr); + cmds[i] = Tcl_GetHashValue(entryPtr); + cmds[i]->refCount++; + i++; } for (i = 0 ; i < length ; i++) { - Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmds[i]); + Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, + (Tcl_Command) cmds[i]); + TclCleanupCommandMacro(cmds[i]); } TclStackFree((Tcl_Interp *) iPtr, cmds); } @@ -1188,42 +1192,50 @@ TclTeardownNamespace( * 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; - Tcl_Namespace **nss = TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Tcl_Namespace *) * length); + Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - nss[i++] = Tcl_GetHashValue(entryPtr); + children[i] = Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; } for (i = 0 ; i < length ; i++) { - Tcl_DeleteNamespace(nss[i]); + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); } - TclStackFree((Tcl_Interp *) iPtr, nss); + TclStackFree((Tcl_Interp *) iPtr, children); } #else if (nsPtr->childTablePtr != NULL) { while (nsPtr->childTablePtr->numEntries > 0) { int length = nsPtr->childTablePtr->numEntries; - Tcl_Namespace **nss = TclStackAlloc((Tcl_Interp *) iPtr, - sizeof(Tcl_Namespace *) * length); + Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr, + sizeof(Namespace *) * length); i = 0; for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - nss[i++] = Tcl_GetHashValue(entryPtr); + children[i] = Tcl_GetHashValue(entryPtr); + children[i]->refCount++; + i++; } for (i = 0 ; i < length ; i++) { - Tcl_DeleteNamespace(nss[i]); + Tcl_DeleteNamespace((Tcl_Namespace *) children[i]); + TclNsDecrRefCount(children[i]); } - TclStackFree((Tcl_Interp *) iPtr, nss); + TclStackFree((Tcl_Interp *) iPtr, children); } } #endif diff --git a/tests/namespace.test b/tests/namespace.test index 1b31fc5..cb9bc8c 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2972,6 +2972,26 @@ test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { } namespace delete ::testing } {} +test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { + namespace eval ::testing { + variable gone {} + oo::class create CB { + variable cmd + constructor other {set cmd $other} + destructor {rename $cmd {}; lappend ::testing::gone $cmd} + } + namespace eval abc { + ::testing::CB create def ::testing::abc::ghi + ::testing::CB create ghi ::testing::abc::def + } + namespace delete abc + try { + return [lsort $gone] + } finally { + namespace delete ::testing + } + } +} {::testing::abc::def ::testing::abc::ghi} # cleanup catch {rename cmd1 {}} |