Throw error if superclass is not a tuple class

core/classes/tuple/tuple-tests.factor

@@ -538,3 +538,6 @@ TUPLE: another-forget-accessors-test ;
         ] with-string-writer empty?
     ] with-variable
 ] unit-test
+
+! Missing error check
+[ "IN: tuples.test USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail

core/classes/tuple/tuple.factor

@@ -58,6 +58,8 @@ PRIVATE>
 : all-slot-names ( class -- slots )
     superclasses [ slot-names ] map concat \ class prefix ;
 
+ERROR: bad-superclass class ;
+
 <PRIVATE
 
 : tuple= ( tuple1 tuple2 -- ? )
@@ -185,16 +187,23 @@ M: tuple-class update-class
 : tuple-class-unchanged? ( class superclass slots -- ? )
     rot tuck [ superclass = ] [ slot-names = ] 2bi* and ;
 
+: valid-superclass? ( class -- ? )
+    [ tuple-class? ] [ tuple bootstrap-word eq? ] bi or ;
+
+: check-superclass ( superclass -- )
+    dup valid-superclass? [ bad-superclass ] unless drop ;
+
 PRIVATE>
 
 GENERIC# define-tuple-class 2 ( class superclass slots -- )
 
 M: word define-tuple-class
+    over check-superclass
     define-new-tuple-class ;
 
 M: tuple-class define-tuple-class
     3dup tuple-class-unchanged?
-    [ 3dup redefine-tuple-class ] unless
+    [ over check-superclass 3dup redefine-tuple-class ] unless
     3drop ;
 
 : define-error-class ( class superclass slots -- )

core/debugger/debugger.factor

@@ -215,7 +215,10 @@ M: check-method summary
     drop "Invalid parameters for create-method" ;
 
 M: no-tuple-class summary
-    drop "Invalid class for define-constructor" ;
+    drop "BOA constructors can only be defined for tuple classes" ;
+
+M: bad-superclass summary
+    drop "Tuple classes can only inherit from other tuple classes" ;
 
 M: no-cond summary
     drop "Fall-through in cond" ;