From cee0b9e854be1cc0048bddfcb5868a79c391fe73 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 1 Jun 2012 16:46:45 -0700
Subject: [PATCH] classes.tuple: Better error message for tuples that try to
 inherit from themselves. Add must-fail tests for tuples that try to inherit
 from themselves and for inheriting from a generic. Fixes #412.

---
 core/classes/tuple/tuple-tests.factor | 4 ++++
 core/classes/tuple/tuple.factor       | 7 +++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 3aa225b1f5..960855b191 100644
--- 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 c0455a5962..b338769706 100644
--- 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 -- )