classes.tuple: Better error message for tuples that try to inherit from themselves...

Fixes #412.

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 3aa225b1f5e321d7e590d596ac225007b76b88b1..960855b1919cd75dff520e77b4de3f5b1f3816a8 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -833,3 +833,7 @@ DEFER: initial-slot
 
 [ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: 3 } ;" eval( -- ) ]
 [ error>> T{ bad-initial-value f "x" 3 initial-class } = ] must-fail-with
+
+[ "IN: classes.tuple.tests USE: math TUPLE: foo < foo ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with
+
+[ "IN: classes.tuple.tests USE: math TUPLE: foo < + ;" eval( -- ) ] [ error>> bad-superclass? ] must-fail-with

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index c0455a5962e502db36032144a344e80a55b71d62..b338769706e3b2c309d8678adb65d6e66b70438c 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -93,7 +93,7 @@ ERROR: bad-superclass class ;
         ] [ 2drop f ] if
     ] [ 2drop f ] if ; inline
 
-GENERIC: final-class? ( class -- ? )
+GENERIC: final-class? ( object -- ? )
 
 M: tuple-class final-class? "final" word-prop ;
 
@@ -101,6 +101,8 @@ M: builtin-class final-class? tuple eq? not ;
 
 M: class final-class? drop t ;
 
+M: object final-class? drop f ;
+
 <PRIVATE
 
 : tuple-predicate-quot/1 ( class -- quot )
@@ -247,7 +249,8 @@ M: tuple-class update-class
     bi-curry* bi and ;
 
 : check-superclass ( superclass -- )
-    dup final-class? [ bad-superclass ] when drop ;
+    dup final-class? [ bad-superclass ] when
+    dup class? [ bad-superclass ] unless drop ;
 
 GENERIC# (define-tuple-class) 2 ( class superclass slots -- )