]> gitweb.factorcode.org Git - factor.git/commitdiff
inheriting from itself would hang a tuple definition. only breaks if tuple is being...
authorDoug Coleman <doug.coleman@gmail.com>
Tue, 1 Sep 2009 09:02:44 +0000 (04:02 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Tue, 1 Sep 2009 09:02:44 +0000 (04:02 -0500)
core/classes/tuple/parser/parser-tests.factor
core/classes/tuple/parser/parser.factor

index 4ee31936a99733fb72fd8dac0502d8dad0e78c8a..0121e217b9dd07fd9cc348aeb4172132ff2a78f9 100644 (file)
@@ -142,3 +142,8 @@ TUPLE: parsing-corner-case x ;
         "    x 3 }"
     } "\n" join eval( -- tuple )
 ] [ error>> unexpected-eof? ] must-fail-with
+
+TUPLE: bad-inheritance-tuple ;
+[
+    "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple < bad-inheritance-tuple ;" eval( -- )
+] [ error>> bad-inheritance? ] must-fail-with
index 7ba850f744da3ee144fb31f3ab116371bbb84fcf..61267a464face5e1b79dd844a52212fa1e1ff521 100644 (file)
@@ -56,11 +56,18 @@ ERROR: invalid-slot-name name ;
 : parse-tuple-slots ( -- )
     ";" parse-tuple-slots-delim ;
 
+ERROR: bad-inheritance class superclass ;
+
+: check-self-inheritance ( class1 class2 -- class1 class2 )
+    2dup = [ bad-inheritance ] when ;
+
 : parse-tuple-definition ( -- class superclass slots )
     CREATE-CLASS
-    scan {
+    scan 2dup = [ ] when {
         { ";" [ tuple f ] }
-        { "<" [ scan-word [ parse-tuple-slots ] { } make ] }
+        { "<" [
+            scan-word check-self-inheritance [ parse-tuple-slots ] { } make
+        ] }
         [ tuple swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ]
     } case
     dup check-duplicate-slots