summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2016-05-21 09:26:07 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2016-05-21 09:26:07 (GMT)
commitf74fa93858b232af77de13991c43775c193df25a (patch)
tree41386636fdb87c929e9f9a78888ce2539fa00a3d
parent07666542f4a7b9ba216e19b1fd3d5db1b3f943c3 (diff)
downloadtcl-f74fa93858b232af77de13991c43775c193df25a.zip
tcl-f74fa93858b232af77de13991c43775c193df25a.tar.gz
tcl-f74fa93858b232af77de13991c43775c193df25a.tar.bz2
Make the tests pass.bug_f97d4ee020
-rw-r--r--generic/tclNamesp.c40
-rw-r--r--tests/namespace.test20
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 {}}