fix another tuple definition bug

diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor
index 0121e217b9dd07fd9cc348aeb4172132ff2a78f9..2b9fd7b89bc7c67b8266eb77f025b9e15b86767f 100644 (file)
--- a/core/classes/tuple/parser/parser-tests.factor
+++ b/core/classes/tuple/parser/parser-tests.factor
@@ -147,3 +147,9 @@ TUPLE: bad-inheritance-tuple ;
 [
     "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple < bad-inheritance-tuple ;" eval( -- )
 ] [ error>> bad-inheritance? ] must-fail-with
+
+TUPLE: bad-inheritance-tuple2 ;
+TUPLE: bad-inheritance-tuple3 < bad-inheritance-tuple2 ;
+[
+    "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple2 < bad-inheritance-tuple3 ;" eval( -- )
+] [ error>> bad-inheritance? ] must-fail-with

diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index 61267a464face5e1b79dd844a52212fa1e1ff521..0a57ad34f35a2e5b83f2325c937814c98eb1beaf 100644 (file)
--- a/core/classes/tuple/parser/parser.factor
+++ b/core/classes/tuple/parser/parser.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sets namespaces make sequences parser
 lexer combinators words classes.parser classes.tuple arrays
-slots math assocs parser.notes ;
+slots math assocs parser.notes classes.algebra ;
 IN: classes.tuple.parser
 
 : slot-names ( slots -- seq )
@@ -58,15 +58,15 @@ ERROR: invalid-slot-name name ;
 
 ERROR: bad-inheritance class superclass ;
 
-: check-self-inheritance ( class1 class2 -- class1 class2 )
-    2dup = [ bad-inheritance ] when ;
+: check-inheritance ( class1 class2 -- class1 class2 )
+    2dup swap class<= [ bad-inheritance ] when ;
 
 : parse-tuple-definition ( -- class superclass slots )
     CREATE-CLASS
     scan 2dup = [ ] when {
         { ";" [ tuple f ] }
         { "<" [
-            scan-word check-self-inheritance [ parse-tuple-slots ] { } make
+            scan-word check-inheritance [ parse-tuple-slots ] { } make
         ] }
         [ tuple swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ]
     } case