[593baa032c] Stop segfault in class destruction with active namespace.

2 files changed, 54 insertions, 17 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 5fca220..34eb5ad 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -58,6 +58,8 @@ static const struct {
 static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
 			    const char *nsNameStr);
+static void		ClearMixins(Class *clsPtr);
+static void		ClearSuperclasses(Class *clsPtr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
 			    Method *mPtr, Tcl_Obj *namePtr,
 			    Method **newMPtrPtr);
@@ -905,6 +907,34 @@ ObjectRenamedTrace(
  */
 
 static void
+ClearMixins(
+    Class *clsPtr)
+{
+    int i;
+    Class *mixinPtr;
+
+    FOREACH(mixinPtr, clsPtr->mixins) {
+	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+    }
+    ckfree(clsPtr->mixins.list);
+    clsPtr->mixins.num = 0;
+}
+
+static void
+ClearSuperclasses(
+    Class *clsPtr)
+{
+    int i;
+    Class *superPtr;
+
+    FOREACH(superPtr, clsPtr->superclasses) {
+	TclOORemoveFromSubclasses(clsPtr, superPtr);
+    }
+    ckfree(clsPtr->superclasses.list);
+    clsPtr->superclasses.num = 0;
+}
+
+static void
 ReleaseClassContents(
     Tcl_Interp *interp,		/* The interpreter containing the class. */
     Object *oPtr)		/* The object representing the class. */
@@ -979,6 +1009,9 @@ ReleaseClassContents(
 	    Tcl_DeleteCommandFromToken(interp,
 		    mixinSubclassPtr->thisPtr->command);
 	}
+	if (mixinSubclassPtr->mixins.num) {
+	    ClearMixins(mixinSubclassPtr);
+	}
 	DelRef(mixinSubclassPtr->thisPtr);
 	DelRef(mixinSubclassPtr);
     }
@@ -999,6 +1032,9 @@ ReleaseClassContents(
 	if (!Deleted(subclassPtr->thisPtr)) {
 	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
 	}
+	if (subclassPtr->superclasses.num) {
+	    ClearSuperclasses(subclassPtr);
+	}
 	DelRef(subclassPtr->thisPtr);
 	DelRef(subclassPtr);
     }
@@ -1195,7 +1231,6 @@ ObjectNamespaceDeleted(
     }
 
     if (clsPtr != NULL) {
-	Class *superPtr;
 	Tcl_ObjectMetadataType *metadataTypePtr;
 	ClientData value;
 
@@ -1215,23 +1250,12 @@ ObjectNamespaceDeleted(
 	    ckfree(clsPtr->filters.list);
 	    clsPtr->filters.num = 0;
 	}
-	FOREACH(mixinPtr, clsPtr->mixins) {
-	    if (!Deleted(mixinPtr->thisPtr)) {
-		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
-	    }
-	}
-	if (i) {
-	    ckfree(clsPtr->mixins.list);
-	    clsPtr->mixins.num = 0;
-	}
-	FOREACH(superPtr, clsPtr->superclasses) {
-	    if (!Deleted(superPtr->thisPtr)) {
-		TclOORemoveFromSubclasses(clsPtr, superPtr);
-	    }
+
+	if (clsPtr->mixins.num) {
+	    ClearMixins(clsPtr);
 	}
-	if (i) {
-	    ckfree(clsPtr->superclasses.list);
-	    clsPtr->superclasses.num = 0;
+	if (clsPtr->superclasses.num) {
+	    ClearSuperclasses(clsPtr);
 	}
 	if (clsPtr->subclasses.list) {
 	    ckfree(clsPtr->subclasses.list);
diff --git a/tests/oo.test b/tests/oo.test
index 2112f10..895f7ed 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3671,6 +3671,19 @@ test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
     unset -nocomplain result
     fruitMetaclass destroy
 } -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
+test oo-35.3 {Bug 593baa032c: superclass list teardown} {
+    # Bug makes this crash, especially with mem-debugging on
+    oo::class create B {}
+    oo::class create D {superclass B}
+    namespace eval [info object namespace D] [list [namespace which B] destroy]
+} {}
+test oo-35.4 {Bug 593baa032c: mixins list teardown} {
+    # Bug makes this crash, especially with mem-debugging on
+    oo::class create B {}
+    oo::class create D {mixin B}
+    namespace eval [info object namespace D] [list [namespace which B] destroy]
+} {}
+
 
 cleanupTests
 return