Plug method-related memory leaks pointed out by Miguel.

2 files changed, 23 insertions, 12 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index de0b36b..73b1034 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOO.c,v 1.4 2008/05/31 11:42:16 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.5 2008/05/31 22:29:45 dkf Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -276,6 +276,8 @@ InitFoundation(
     fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
     TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
     TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+    AddRef(fPtr->objectCls->thisPtr);
+    AddRef(fPtr->objectCls);
 
     /*
      * Basic method declarations for the core classes.
@@ -299,6 +301,7 @@ InitFoundation(
 	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
 
     argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1);
+    Tcl_IncrRefCount(argsPtr);
     bodyPtr = Tcl_NewStringObj(
 	    "if {[catch {define [self] $definitionScript} msg opt]} {\n"
 	    "set ei [split [dict get $opt -errorinfo] \\n]\n"
@@ -308,6 +311,7 @@ InitFoundation(
 	    "return -options $opt $msg", -1);
     fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
 	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
+    Tcl_DecrRefCount(argsPtr);
 
     /*
      * Create non-object commands and plug ourselves into the Tcl [info]
@@ -346,6 +350,8 @@ KillFoundation(
 {
     Foundation *fPtr = GetFoundation(interp);
 
+    DelRef(fPtr->objectCls->thisPtr);
+    DelRef(fPtr->objectCls);
     Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
     Tcl_DecrRefCount(fPtr->constructorName);
     Tcl_DecrRefCount(fPtr->destructorName);
@@ -472,7 +478,7 @@ AllocObject(
 
     /*
      * Access the namespace command table directly when creating "my" to avoid
-     * a bottleneck in string manipulation. 
+     * a bottleneck in string manipulation.
      */
 
     {
@@ -541,7 +547,7 @@ ObjectRenamedTrace(
 
     AddRef(oPtr);
     oPtr->flags |= OBJECT_DELETED;
-    if (!Tcl_InterpDeleted(interp)) {
+    if (!(flags & TCL_INTERP_DESTROYED)) {
 	CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR);
 
 	if (contextPtr != NULL) {
@@ -613,7 +619,8 @@ ReleaseClassContents(
 	AddRef(list[i]);
     }
     for (i=0 ; i<n ; i++) {
-	if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
+	    list[i]->thisPtr->flags |= OBJECT_DELETED;
 	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
 	}
 	DelRef(list[i]);
@@ -631,7 +638,8 @@ ReleaseClassContents(
 	AddRef(list[i]);
     }
     for (i=0 ; i<n ; i++) {
-	if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
+	    list[i]->thisPtr->flags |= OBJECT_DELETED;
 	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
 	}
 	DelRef(list[i]);
@@ -649,7 +657,8 @@ ReleaseClassContents(
 	AddRef(insts[i]);
     }
     for (i=0 ; i<n ; i++) {
-	if (!(insts[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	if (!(insts[i]->flags & OBJECT_DELETED)) {
+	    insts[i]->flags |= OBJECT_DELETED;
 	    Tcl_DeleteCommandFromToken(interp, insts[i]->command);
 	}
 	DelRef(insts[i]);
@@ -660,9 +669,11 @@ ReleaseClassContents(
 
     if (clsPtr->constructorChainPtr) {
 	TclOODeleteChain(clsPtr->constructorChainPtr);
+	clsPtr->constructorChainPtr = NULL;
     }
     if (clsPtr->destructorChainPtr) {
 	TclOODeleteChain(clsPtr->destructorChainPtr);
+	clsPtr->destructorChainPtr = NULL;
     }
     if (clsPtr->classChainCache) {
 	FOREACH_HASH_DECLS;
@@ -673,6 +684,7 @@ ReleaseClassContents(
 	}
 	Tcl_DeleteHashTable(clsPtr->classChainCache);
 	ckfree((char *) clsPtr->classChainCache);
+	clsPtr->classChainCache = NULL;
     }
 
     if (clsPtr->filters.num) {
@@ -790,7 +802,7 @@ ObjectNamespaceDeleted(
 	oPtr->metadataPtr = NULL;
     }
 
-    if (clsPtr != NULL && !(oPtr->flags & ROOT_OBJECT)) {
+    if (clsPtr != NULL) {
 	Class *superPtr, *mixinPtr;
 
 	if (clsPtr->metadataPtr != NULL) {
@@ -806,7 +818,6 @@ ObjectNamespaceDeleted(
 	    clsPtr->metadataPtr = NULL;
 	}
 
-	clsPtr->flags |= OBJECT_DELETED;
 	FOREACH(filterObj, clsPtr->filters) {
 	    Tcl_DecrRefCount(filterObj);
 	}
@@ -815,7 +826,7 @@ ObjectNamespaceDeleted(
 	    clsPtr->filters.num = 0;
 	}
 	FOREACH(mixinPtr, clsPtr->mixins) {
-	    if (!(mixinPtr->flags & OBJECT_DELETED)) {
+	    if (!(mixinPtr->thisPtr->flags & OBJECT_DELETED)) {
 		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
 	    }
 	}
@@ -824,7 +835,7 @@ ObjectNamespaceDeleted(
 	    clsPtr->mixins.num = 0;
 	}
 	FOREACH(superPtr, clsPtr->superclasses) {
-	    if (!(superPtr->flags & OBJECT_DELETED)) {
+	    if (!(superPtr->thisPtr->flags & OBJECT_DELETED)) {
 		TclOORemoveFromSubclasses(clsPtr, superPtr);
 	    }
 	}
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index f190533..21e0869 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOOMethod.c,v 1.1 2008/05/31 11:42:19 dkf Exp $
+ * RCS: @(#) $Id: tclOOMethod.c,v 1.2 2008/05/31 22:29:46 dkf Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -235,7 +235,7 @@ void
 TclOODelMethodRef(
     Method *mPtr)
 {
-    if ((mPtr != NULL) && (--mPtr->refCount < 0)) {
+    if ((mPtr != NULL) && (--mPtr->refCount <= 0)) {
 	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
 	    mPtr->typePtr->deleteProc(mPtr->clientData);
 	}