summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorpooryorick <com.digitalsmarties@pooryorick.com>2021-04-03 12:48:54 (GMT)
committerpooryorick <com.digitalsmarties@pooryorick.com>2021-04-03 12:48:54 (GMT)
commit970479b4ee7ed81756afb201bf22fb663e9fc99a (patch)
tree5c723b7b7d0cdfc752bedd74922bd43beaa48025 /generic
parent55f8e3ac01b129121e749e40480a67bca8aa0832 (diff)
downloadtcl-970479b4ee7ed81756afb201bf22fb663e9fc99a.zip
tcl-970479b4ee7ed81756afb201bf22fb663e9fc99a.tar.gz
tcl-970479b4ee7ed81756afb201bf22fb663e9fc99a.tar.bz2
When a namesapce is deleted delete all namespaces under it before making any
modifictions to it.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclNamesp.c142
2 files changed, 84 insertions, 59 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index fa661d6..e86a0cc 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2958,6 +2958,7 @@ 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 f57b7e1..bf598d9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -917,10 +917,10 @@ Tcl_DeleteNamespace(
/*
* 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
+ * calling of destructors. Only called once (unless re-established
* by the called function). [Bug 2950259]
*
- * Note that setting this field requires access to the internal definition
+ * 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.
*/
@@ -1065,7 +1065,7 @@ Tcl_DeleteNamespace(
}
TclNsDecrRefCount(nsPtr);
}
-
+
int
TclNamespaceDeleted(
Namespace *nsPtr)
@@ -1073,6 +1073,83 @@ 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
+}
+
/*
*----------------------------------------------------------------------
*
@@ -1105,6 +1182,9 @@ 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!
@@ -1181,62 +1261,6 @@ 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.