Deal with the elaborate rip-apart-a-metaclass case as well.

3 files changed, 30 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index b794da5..a82dbfd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,13 @@
+2013-08-02  Donal Fellows  <dkf@users.sf.net>
+
+	* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
+	crashes when emptying the superclass slot, even when doing elaborate
+	things with metaclasses.
+
 2013-08-01  Harald Oehlmann  <oehhar@users.sf.net>
 
-	* tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
-	  Start notifier thread again if we were forked, to solve Rivet bug
-	  55153.
+	* tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
+	thread again if we were forked, to solve Rivet bug 55153.
 
 2013-07-05  Kevin B. Kenny  <kennykb@acm.org>
 
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 1a5058c..f0983cc 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2215,6 +2215,9 @@ ClassSuperSet(
 	superclasses = ckrealloc(superclasses, sizeof(Class *));
 	superclasses[0] = oPtr->fPtr->objectCls;
 	superc = 1;
+	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
+	    superclasses[0] = oPtr->fPtr->classCls;
+	}
     } else {
 	for (i=0 ; i<superc ; i++) {
 	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
diff --git a/tests/oo.test b/tests/oo.test
index 6f16a8d..6d38f71 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3391,6 +3391,25 @@ test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
     unset -nocomplain result
     fruit destroy
 } -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
+test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+    oo::class create fruitMetaclass {
+	superclass oo::class
+	method eat {} {}
+    }
+    set result {}
+} -body {
+    lappend result [fruitMetaclass create ::appleClass] \
+	[appleClass create orange] \
+	[info class superclasses fruitMetaclass]
+    oo::define fruitMetaclass superclass
+    lappend result [info class superclasses fruitMetaclass] \
+	[info object class appleClass oo::class] \
+	[catch { orange }] [info object class orange] \
+	[appleClass create pear]
+} -cleanup {
+    unset -nocomplain result
+    fruitMetaclass destroy
+} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
 
 cleanupTests
 return