Attachment "2724403.patch" to
ticket [2724403fff]
added by
msofer
2009-05-10 02:21:55.
? generic/tclCoroutine.c
? generic/tclExecute.c.cvs
? generic/tclExecute.c.new
? unix/0valgrind
? unix/ERR
? unix/autom4te.cache
? unix/config.status.lineno
? unix/dltest.marker
? unix/httpd_10227
? unix/httpd_10297
? unix/httpd_14990
? unix/res
? unix/tcl.pc
? unix/tclsh-new
? unix/tclsh-orig
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.394
diff -u -r1.394 tclBasic.c
--- generic/tclBasic.c 8 May 2009 08:48:19 -0000 1.394
+++ generic/tclBasic.c 9 May 2009 16:40:15 -0000
@@ -1446,7 +1446,6 @@
Tcl_PopCallFrame(interp);
ckfree((char *) iPtr->rootFramePtr);
iPtr->rootFramePtr = NULL;
- Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
/*
* Free up the result *after* deleting variables, since variable deletion
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.423
diff -u -r1.423 tclInt.h
--- generic/tclInt.h 8 May 2009 08:48:19 -0000 1.423
+++ generic/tclInt.h 9 May 2009 16:40:18 -0000
@@ -241,15 +241,11 @@
long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
- int flags; /* OR-ed combination of the namespace status
- * flags NS_DYING and NS_DEAD listed below. */
- int activationCount; /* Number of "activations" or active call
- * frames for this namespace that are on the
- * Tcl call stack. The namespace won't be
- * freed until activationCount becomes zero. */
+ int flags; /* 0R-ed combination of values below. */
int refCount; /* Count of references by namespaceName
- * objects. The namespace can't be freed until
- * refCount becomes zero. */
+ * objects, CallFrames and the parent
+ * namespace. The namespace can't be freed
+ * until refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
* registered in the namespace. Indexed by
* strings; values have type (Command *).
@@ -346,20 +342,6 @@
/*
* Flags used to represent the status of a namespace:
*
- * NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the
- * namespace but there are still active call frames on the Tcl
- * stack that refer to the namespace. When the last call frame
- * referring to it has been popped, it's variables and command
- * will be destroyed and it will be marked "dead" (NS_DEAD). The
- * namespace can no longer be looked up by name.
- * NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the
- * namespace and no call frames still refer to it. Its variables
- * and command have already been destroyed. This bit allows the
- * namespace resolution code to recognize that the namespace is
- * "deleted". When the last namespaceName object in any byte code
- * unit that refers to the namespace has been freed (i.e., when
- * the namespace's refCount is 0), the namespace's storage will
- * be freed.
* NS_KILLED - 1 means that TclTeardownNamespace has already been called on
* this namespace and it should not be called again [Bug 1355942]
* NS_SUPPRESS_COMPILATION -
@@ -367,9 +349,14 @@
* forcing them to be looked up every time.
*/
-#define NS_DYING 0x01
-#define NS_DEAD 0x02
-#define NS_KILLED 0x04
+/* NS_DYING and NS_DEAD are the same now; both names kept for back compat */
+
+#define NS_DYING 0x01 /* deprecated */
+#define NS_DEAD 0x02 /* deprecated */
+
+#define NS_KILLED 0x07 /* 0x4; set also (NS_DYING|NS_DEAD) for compat
+ * with extensions that may have used them */
+
#define NS_SUPPRESS_COMPILATION 0x08
/*
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.191
diff -u -r1.191 tclNamesp.c
--- generic/tclNamesp.c 21 Mar 2009 12:24:49 -0000 1.191
+++ generic/tclNamesp.c 9 May 2009 16:40:22 -0000
@@ -396,22 +396,13 @@
} else {
nsPtr = (Namespace *) namespacePtr;
- /*
- * TODO: Examine whether it would be better to guard based on NS_DYING
- * or NS_KILLED. It appears that these are not tested because they can
- * be set in a global interp that has been [namespace delete]d, but
- * which never really completely goes away because of lingering global
- * things like ::errorInfo and [::unknown] and hidden commands.
- * Review of those designs might permit stricter checking here.
- */
-
- if (nsPtr->flags & NS_DEAD) {
+ if (nsPtr->flags & NS_KILLED) {
Tcl_Panic("Trying to push call frame for dead namespace");
/*NOTREACHED*/
}
}
- nsPtr->activationCount++;
+ nsPtr->refCount++;
framePtr->nsPtr = nsPtr;
framePtr->isProcCallFrame = isProcCallFrame;
framePtr->objc = 0;
@@ -455,7 +446,8 @@
* Side effects:
* Modifies the call stack of the interpreter. Resets various fields of
* the popped call frame. If a namespace has been deleted and has no more
- * activations on the call stack, the namespace is destroyed.
+ * references (including activations on the call stack), the namespace is
+ * destroyed.
* Schedules a tailcall if one is present.
*
*----------------------------------------------------------------------
@@ -502,10 +494,9 @@
*/
nsPtr = framePtr->nsPtr;
- nsPtr->activationCount--;
- if ((nsPtr->flags & NS_DYING)
- && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
- Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+ nsPtr->refCount--;
+ if ((nsPtr->flags & NS_KILLED) && (nsPtr->refCount == 0)) {
+ NamespaceFree(nsPtr);
}
framePtr->nsPtr = NULL;
@@ -845,8 +836,7 @@
nsPtr->nsId = ++(tsdPtr->numNsCreated);
nsPtr->interp = interp;
nsPtr->flags = 0;
- nsPtr->activationCount = 0;
- nsPtr->refCount = 0;
+ nsPtr->refCount = (parentPtr != NULL);
Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
TclInitVarHashTable(&nsPtr->varTable, nsPtr);
nsPtr->exportArrayPtr = NULL;
@@ -968,117 +958,36 @@
Interp *iPtr = (Interp *) nsPtr->interp;
Namespace *globalNsPtr = (Namespace *)
TclGetGlobalNamespace((Tcl_Interp *) iPtr);
- Tcl_HashEntry *entryPtr;
/*
- * 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). Note that this code is actually
- * reentrant so command delete traces won't purturb things badly.
+ * 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.
*/
-
- while (nsPtr->ensembles != NULL) {
- EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;
-
+
+ TclTeardownNamespace(nsPtr);
+
+ if (nsPtr->refCount == 0) {
+ NamespaceFree(nsPtr);
+ } else if ((nsPtr == globalNsPtr) && !(iPtr->flags & DELETED)) {
/*
- * Splice out and link to indicate that we've already been killed.
+ * Restore the ::errorInfo and ::errorCode traces.
*/
-
- nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
- ensemblePtr->next = ensemblePtr;
- Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
- }
-
- /*
- * If the namespace has a registered unknown handler (TIP 181), then free
- * it here.
- */
-
- if (nsPtr->unknownHandlerPtr != NULL) {
- Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
- nsPtr->unknownHandlerPtr = NULL;
- }
-
- /*
- * 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) {
- nsPtr->flags |= NS_DYING;
- if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
- nsPtr->name);
- if (entryPtr != NULL) {
- Tcl_DeleteHashEntry(entryPtr);
- }
- }
- nsPtr->parentPtr = NULL;
- } else if (!(nsPtr->flags & NS_KILLED)) {
+
+ EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+ EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+
/*
- * 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.
+ * 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);
-
- TclTeardownNamespace(nsPtr);
-
- if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
- /*
- * 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 to clear the variable list
- * one last time.
- */
-
- TclDeleteNamespaceVars(nsPtr);
-
- Tcl_DeleteHashTable(&nsPtr->childTable);
- Tcl_DeleteHashTable(&nsPtr->cmdTable);
-
- /*
- * If the reference count is 0, then discard the namespace.
- * Otherwise, mark it as "dead" so that it can't be used.
- */
-
- if (nsPtr->refCount == 0) {
- NamespaceFree(nsPtr);
- } else {
- nsPtr->flags |= NS_DEAD;
- }
- } else {
- /*
- * Restore the ::errorInfo and ::errorCode traces.
- */
-
- EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
- EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
-
- /*
- * 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);
- }
+ nsPtr->flags &= ~NS_KILLED;
}
}
+
/*
*----------------------------------------------------------------------
@@ -1114,6 +1023,40 @@
Tcl_Command cmd;
int i;
+ if (nsPtr->flags & NS_KILLED) {
+ return;
+ }
+ nsPtr->flags |= NS_KILLED;
+
+ /*
+ * 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). Note that this code is actually
+ * reentrant so command delete traces won't purturb things badly.
+ */
+
+ while (nsPtr->ensembles != NULL) {
+ EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensembles;
+
+ /*
+ * Splice out and link to indicate that we've already been killed.
+ */
+
+ nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
+ ensemblePtr->next = ensemblePtr;
+ Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token);
+ }
+
+ /*
+ * If the namespace has a registered unknown handler (TIP 181), then free
+ * it here.
+ */
+
+ if (nsPtr->unknownHandlerPtr != NULL) {
+ Tcl_DecrRefCount(nsPtr->unknownHandlerPtr);
+ nsPtr->unknownHandlerPtr = NULL;
+ }
+
/*
* Start by destroying the namespace's variable table, since variables
* might trigger traces. Variable table should be cleared but not freed!
@@ -1150,8 +1093,9 @@
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
+ nsPtr->refCount--;
+ nsPtr->parentPtr = NULL;
}
- nsPtr->parentPtr = NULL;
/*
* Delete the namespace path if one is installed.
@@ -1205,16 +1149,6 @@
}
/*
- * Free any client data associated with the namespace.
- */
-
- if (nsPtr->deleteProc != NULL) {
- nsPtr->deleteProc(nsPtr->clientData);
- }
- nsPtr->deleteProc = NULL;
- nsPtr->clientData = NULL;
-
- /*
* Reset the namespace's id field to ensure that this namespace won't be
* interpreted as valid by, e.g., the cache validation code for cached
* command references in Tcl_GetCommandFromObj.
@@ -1245,6 +1179,16 @@
register Namespace *nsPtr) /* Points to the namespace to free. */
{
/*
+ * Free any client data associated with the namespace.
+ */
+
+ if (nsPtr->deleteProc != NULL) {
+ nsPtr->deleteProc(nsPtr->clientData);
+ }
+ nsPtr->deleteProc = NULL;
+ nsPtr->clientData = NULL;
+
+ /*
* Most of the namespace's contents are freed when the namespace is
* deleted by Tcl_DeleteNamespace. All that remains is to free its names
* (for error messages), and the structure itself.
@@ -2489,7 +2433,7 @@
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)) {
if ((cxtNsPtr == realNsPtr)
- || !(realNsPtr->flags & NS_DYING)) {
+ || !(realNsPtr->flags & NS_KILLED)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2510,7 +2454,7 @@
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)
- && !(realNsPtr->flags & NS_DYING)) {
+ && !(realNsPtr->flags & NS_KILLED)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2528,7 +2472,7 @@
TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)
- && !(realNsPtr->flags & NS_DYING)) {
+ && !(realNsPtr->flags & NS_KILLED)) {
entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
if (entryPtr != NULL) {
cmdPtr = Tcl_GetHashValue(entryPtr);
@@ -2549,7 +2493,8 @@
*/
for (search = 0; (search < 2) && (cmdPtr == NULL); search++) {
- if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
+ if ((nsPtr[search] != NULL) &&(simpleName != NULL)
+ && !(nsPtr[search]->flags & NS_KILLED)) {
entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
simpleName);
if (entryPtr != NULL) {
@@ -2775,7 +2720,7 @@
resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
- if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
+ if (!(nsPtr->flags & NS_KILLED) && (interp == nsPtr->interp) &&
(!refNsPtr || ((interp == refNsPtr->interp) &&
(refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
@@ -3184,7 +3129,10 @@
*/
currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
+ if (currNsPtr->flags & NS_KILLED) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("Current namespace is deleted", -1));
+ return TCL_ERROR;
+ } else if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
} else {
Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1));
@@ -4693,7 +4641,7 @@
nsPtr = resNamePtr->nsPtr;
nsPtr->refCount--;
- if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+ if (nsPtr->refCount == 0) {
NamespaceFree(nsPtr);
}
ckfree((char *) resNamePtr);
@@ -4774,7 +4722,7 @@
* that holds a reference to it.
*/
- if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+ if ((nsPtr == NULL) || (nsPtr->flags & NS_KILLED)) {
/*
* Our failed lookup proves any previously cached nsName intrep is no
* longer valid. Get rid of it so we no longer waste memory storing
@@ -4858,7 +4806,7 @@
int index;
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
+ if (nsPtr == NULL || nsPtr->flags & NS_KILLED) {
if (!Tcl_InterpDeleted(interp)) {
Tcl_AppendResult(interp,
"tried to manipulate ensemble of deleted namespace", NULL);
@@ -6369,7 +6317,7 @@
return TCL_ERROR;
}
- if (ensemblePtr->nsPtr->flags & NS_DYING) {
+ if (ensemblePtr->nsPtr->flags & NS_KILLED) {
/*
* Don't know how we got here, but make things give up quickly.
*/
@@ -6845,7 +6793,7 @@
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
ensembleCmd->nsPtr->refCount--;
if ((ensembleCmd->nsPtr->refCount == 0)
- && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+ && (ensembleCmd->nsPtr->flags & NS_KILLED)) {
NamespaceFree(ensembleCmd->nsPtr);
}
ckfree(ensembleCmd->fullSubcmdName);
@@ -7258,7 +7206,7 @@
ckfree(ensembleCmd->fullSubcmdName);
ensembleCmd->nsPtr->refCount--;
if ((ensembleCmd->nsPtr->refCount == 0)
- && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+ && (ensembleCmd->nsPtr->flags & NS_KILLED)) {
NamespaceFree(ensembleCmd->nsPtr);
}
ckfree((char *) ensembleCmd);
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.152
diff -u -r1.152 tclObj.c
--- generic/tclObj.c 8 May 2009 02:21:09 -0000 1.152
+++ generic/tclObj.c 9 May 2009 16:40:24 -0000
@@ -3552,9 +3552,8 @@
if ((objPtr->typePtr != &tclCmdNameType)
|| (resPtr == NULL)
|| (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch)
- || (interp != cmdPtr->nsPtr->interp)
|| (cmdPtr->flags & CMD_IS_DELETED)
- || (cmdPtr->nsPtr->flags & NS_DYING)
+ || (interp != cmdPtr->nsPtr->interp)
|| ((resPtr->refNsPtr != NULL) &&
(((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))
!= resPtr->refNsPtr)
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.178
diff -u -r1.178 tclVar.c
--- generic/tclVar.c 24 Mar 2009 09:30:07 -0000 1.178
+++ generic/tclVar.c 9 May 2009 16:40:26 -0000
@@ -894,8 +894,9 @@
* to continue onward, or it may signal an error.
*/
- if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
- && !(flags & AVOID_RESOLVERS)) {
+ if (!(cxtNsPtr->flags & NS_KILLED)
+ && ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
+ && !(flags & AVOID_RESOLVERS))) {
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
result = cxtNsPtr->varResProc(interp, varName,
@@ -970,7 +971,8 @@
if (create) { /* Var wasn't found so create it. */
TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
- if (varNsPtr == NULL) {
+ if ((varNsPtr == NULL) ||
+ ((varNsPtr != iPtr->globalNsPtr) && (varNsPtr->flags & NS_KILLED))) {
*errMsgPtr = badNamespace;
return NULL;
} else if (tail == NULL) {
@@ -4981,6 +4983,10 @@
cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
+ if (cxtNsPtr->flags & NS_KILLED) {
+ return NULL;
+ }
+
if (!(flags & AVOID_RESOLVERS) &&
(cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
resPtr = iPtr->resolverPtr;
