Plug memleak when deleting a namespace destroys a linked Tcl var.

3 files changed, 53 insertions, 1 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index e37727d..57367fa 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2638,6 +2638,8 @@ MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
 			    int *codePtr, int *levelPtr);
 MODULE_SCOPE int	TclNokia770Doubles();
+MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
+MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
 MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, const char *operation,
 			    const char *reason, int index);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2dc2e47..7283d78 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -23,6 +23,7 @@
 
 typedef struct Link {
     Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
+    Namespace *nsPtr;		/* Namespace containing Tcl variable */
     Tcl_Obj *varName;		/* Name of variable (must be global). This is
 				 * needed during trace callbacks, since the
 				 * actual variable may be aliased at that time
@@ -114,6 +115,8 @@ Tcl_LinkVar(
 {
     Tcl_Obj *objPtr;
     Link *linkPtr;
+    Namespace *dummy;
+    const char *name;
     int code;
 
     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
@@ -126,6 +129,7 @@ Tcl_LinkVar(
 
     linkPtr = (Link *) ckalloc(sizeof(Link));
     linkPtr->interp = interp;
+    linkPtr->nsPtr = NULL;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
     linkPtr->addr = addr;
@@ -142,11 +146,17 @@ Tcl_LinkVar(
 	ckfree((char *) linkPtr);
 	return TCL_ERROR;
     }
+
+    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
+	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
+    linkPtr->nsPtr->refCount++;
+
     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
 	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
 	    (ClientData) linkPtr);
     if (code != TCL_OK) {
 	Tcl_DecrRefCount(linkPtr->varName);
+	TclNsDecrRefCount(linkPtr->nsPtr);
 	ckfree((char *) linkPtr);
     }
     return code;
@@ -186,6 +196,9 @@ Tcl_UnlinkVar(
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, (ClientData) linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
+    if (linkPtr->nsPtr) {
+	TclNsDecrRefCount(linkPtr->nsPtr);
+    }
     ckfree((char *) linkPtr);
 }
 
@@ -279,8 +292,11 @@ LinkTraceProc(
      */
 
     if (flags & TCL_TRACE_UNSETS) {
-	if (Tcl_InterpDeleted(interp)) {
+	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
+	    if (linkPtr->nsPtr) {
+		TclNsDecrRefCount(linkPtr->nsPtr);
+	    }
 	    ckfree((char *) linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a2e625e..a476b4e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1060,6 +1060,13 @@ Tcl_DeleteNamespace(
 	}
     }
 }
+
+int
+TclNamespaceDeleted(
+    Namespace *nsPtr)
+{
+    return (nsPtr->flags & NS_DYING) ? 1 : 0;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -1240,6 +1247,33 @@ NamespaceFree(
 /*
  *----------------------------------------------------------------------
  *
+ * TclNsDecrRefCount --
+ *
+ *      Drops a reference to a namespace and frees it if the namespace has
+ *      been deleted and the last reference has just been dropped.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclNsDecrRefCount(
+    Namespace *nsPtr)
+{
+    nsPtr->refCount--;
+    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+        NamespaceFree(nsPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_Export --
  *
  *	Makes all the commands matching a pattern available to later be