From 1614457e38312b8180cd9ef843bffcc6a45a14cc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Dec 2015 18:27:23 +0000
Subject: [593baa032c] Possible fix (with test) for segfault in superclass
 teardown.

---
 generic/tclOO.c | 29 ++++++++++++++++++++---------
 tests/oo.test   |  7 +++++++
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 5fca220..f2e0ca9 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -58,6 +58,7 @@ 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		ClearSuperclasses(Class *clsPtr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
 			    Method *mPtr, Tcl_Obj *namePtr,
 			    Method **newMPtrPtr);
@@ -905,6 +906,20 @@ ObjectRenamedTrace(
  */
 
 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. */
@@ -999,6 +1014,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 +1213,6 @@ ObjectNamespaceDeleted(
     }
 
     if (clsPtr != NULL) {
-	Class *superPtr;
 	Tcl_ObjectMetadataType *metadataTypePtr;
 	ClientData value;
 
@@ -1224,14 +1241,8 @@ ObjectNamespaceDeleted(
 	    ckfree(clsPtr->mixins.list);
 	    clsPtr->mixins.num = 0;
 	}
-	FOREACH(superPtr, clsPtr->superclasses) {
-	    if (!Deleted(superPtr->thisPtr)) {
-		TclOORemoveFromSubclasses(clsPtr, superPtr);
-	    }
-	}
-	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..ca5c7f9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3671,6 +3671,13 @@ 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]
+} {}
+
 
 cleanupTests
 return
-- 
cgit v0.12