[3d96b7076e] Prevent crashes when destroying an object's class inside a method call.

5 files changed, 93 insertions, 8 deletions

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 84bb85a..5fca220 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -951,6 +951,16 @@ ReleaseClassContents(
     }
     if (!IsRootClass(oPtr)) {
 	FOREACH(instancePtr, clsPtr->instances) {
+	    int j;
+	    if (instancePtr->selfCls == clsPtr) {
+		instancePtr->flags |= CLASS_GONE;
+	    }
+	    for(j=0 ; j<instancePtr->mixins.num ; j++) {
+		Class *mixin = instancePtr->mixins.list[j];
+		if (mixin == clsPtr) {
+		    instancePtr->mixins.list[j] = NULL;
+		}
+	    }
 	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
 		AddRef(instancePtr);
 	    }
@@ -1131,12 +1141,14 @@ ObjectNamespaceDeleted(
      * methods on the object.
      */
 
-    if (!IsRootObject(oPtr)) {
+    if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) {
 	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
     }
 
     FOREACH(mixinPtr, oPtr->mixins) {
-	TclOORemoveFromInstances(oPtr, mixinPtr);
+	if (mixinPtr) {
+	    TclOORemoveFromInstances(oPtr, mixinPtr);
+	}
     }
     if (i) {
 	ckfree(oPtr->mixins.list);
@@ -1908,13 +1920,13 @@ Tcl_CopyObjectInstance(
      */
 
     FOREACH(mixinPtr, o2Ptr->mixins) {
-	if (mixinPtr != o2Ptr->selfCls) {
+	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
 	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
 	}
     }
     DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
     FOREACH(mixinPtr, o2Ptr->mixins) {
-	if (mixinPtr != o2Ptr->selfCls) {
+	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
 	    TclOOAddToInstances(o2Ptr, mixinPtr);
 	}
     }
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 85f6c31..c880754 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -323,7 +323,9 @@ TclOOObjectSetMixins(
     if (numMixins == 0) {
 	if (oPtr->mixins.num != 0) {
 	    FOREACH(mixinPtr, oPtr->mixins) {
-		TclOORemoveFromInstances(oPtr, mixinPtr);
+		if (mixinPtr) {
+		    TclOORemoveFromInstances(oPtr, mixinPtr);
+		}
 	    }
 	    ckfree(oPtr->mixins.list);
 	    oPtr->mixins.num = 0;
@@ -332,7 +334,7 @@ TclOOObjectSetMixins(
     } else {
 	if (oPtr->mixins.num != 0) {
 	    FOREACH(mixinPtr, oPtr->mixins) {
-		if (mixinPtr != oPtr->selfCls) {
+		if (mixinPtr && mixinPtr != oPtr->selfCls) {
 		    TclOORemoveFromInstances(oPtr, mixinPtr);
 		}
 	    }
@@ -1213,6 +1215,9 @@ TclOODefineClassObjCmd(
 	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
 	oPtr->selfCls = clsPtr;
 	TclOOAddToInstances(oPtr, oPtr->selfCls);
+	if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
+	    oPtr->flags &= ~CLASS_GONE;
+	}
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {
@@ -2509,8 +2514,10 @@ ObjMixinGet(
 
     resultObj = Tcl_NewObj();
     FOREACH(mixinPtr, oPtr->mixins) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, mixinPtr->thisPtr));
+	if (mixinPtr) {
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    TclOOObjectName(interp, mixinPtr->thisPtr));
+	}
     }
     Tcl_SetObjResult(interp, resultObj);
     return TCL_OK;
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 0c22bcf..76eaef5 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -196,6 +196,9 @@ InfoObjectClassCmd(
 	}
 
 	FOREACH(mixinPtr, oPtr->mixins) {
+	    if (!mixinPtr) {
+		continue;
+	    }
 	    if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
 		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
 		return TCL_OK;
@@ -467,6 +470,9 @@ InfoObjectIsACmd(
 	    Class *mixinPtr;
 
 	    FOREACH(mixinPtr, oPtr->mixins) {
+		if (!mixinPtr) {
+		    continue;
+		}
 		if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
 		    result = 1;
 		    break;
@@ -665,6 +671,9 @@ InfoObjectMixinsCmd(
 
     resultObj = Tcl_NewObj();
     FOREACH(mixinPtr, oPtr->mixins) {
+	if (!mixinPtr) {
+	    continue;
+	}
 	Tcl_ListObjAppendElement(NULL, resultObj,
 		TclOOObjectName(interp, mixinPtr->thisPtr));
     }
@@ -1281,6 +1290,9 @@ InfoClassMixinsCmd(
 
     resultObj = Tcl_NewObj();
     FOREACH(mixinPtr, clsPtr->mixins) {
+	if (!mixinPtr) {
+	    continue;
+	}
 	Tcl_ListObjAppendElement(NULL, resultObj,
 		TclOOObjectName(interp, mixinPtr->thisPtr));
     }
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 208e32c..b75ffdb 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -193,6 +193,9 @@ typedef struct Object {
 				 * destroyed. */
 #define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
 				 * called. */
+#define CLASS_GONE	4	/* Indicates that the class of this object has
+				 * been deleted, and so the object should not
+				 * attempt to remove itself from its class. */
 #define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
 				 * specially during teardown. */
diff --git a/tests/oo.test b/tests/oo.test
index c83e015..2112f10 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -638,6 +638,57 @@ test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup {
 } -cleanup {
     cls destroy
 } -result {in destructor}
+test oo-3.10 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
+    oo::class create Super
+} -body {
+    # Only reliably failed in a memdebug build
+    oo::class create Cls {
+	superclass Super
+	method mthd {} {
+	    [self class] destroy
+	    return ok
+	}
+    }
+    [Cls new] mthd
+} -cleanup {
+    Super destroy
+} -result ok
+test oo-3.11 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
+    oo::class create Super
+    oo::class create Sub {
+	superclass Super
+    }
+} -body {
+    # Only reliably failed in a memdebug build
+    oo::class create Cls {
+	superclass Super
+	method mthd {} {
+	    oo::objdefine [self] class Sub
+	    Cls destroy
+	    return ok
+	}
+    }
+    [Cls new] mthd
+} -cleanup {
+    Super destroy
+} -result ok
+test oo-3.12 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
+    oo::class create Super
+} -body {
+    # Only reliably failed in a memdebug build
+    oo::class create Cls {
+	superclass Super
+	method mthd {} {
+	    [self class] destroy
+	    return ok
+	}
+    }
+    set o [Super new]
+    oo::objdefine $o mixin Cls
+    $o mthd
+} -cleanup {
+    Super destroy
+} -result ok
 
 test oo-4.1 {basic test of OO functionality: export} {
     set o [oo::object new]