diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 4ee31936a9..0121e217b9 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -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 diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 7ba850f744..61267a464f 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -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