From 3addfcc2ade1d3520606f612177f4af4db67830b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Feb 2010 00:08:18 +1300 Subject: [PATCH] classes: more robust code for detecting circular inheritance, move it out of classes.tuple since predicate classes need the same check too --- basis/debugger/debugger.factor | 3 +++ core/classes/classes.factor | 6 ++++++ core/classes/predicate/predicate-tests.factor | 19 ++++++++++++++++++- core/classes/tuple/parser/parser-tests.factor | 8 ++++++++ core/classes/tuple/parser/parser.factor | 15 ++++----------- 5 files changed, 39 insertions(+), 12 deletions(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index be450f7479..d5284133b2 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -293,6 +293,9 @@ M: duplicate-slot-names summary M: invalid-slot-name summary drop "Invalid slot name" ; +M: bad-inheritance summary + drop "Circularity in inheritance chain" ; + M: not-in-a-method-error summary drop "call-next-method can only be called in a method definition" ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 34e65e54db..8bf1648f8f 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -6,6 +6,8 @@ vectors math quotations combinators sorting effects graphs vocabs sets ; IN: classes +ERROR: bad-inheritance class superclass ; + SYMBOL: class<=-cache SYMBOL: class-not-cache SYMBOL: classes-intersect-cache @@ -169,7 +171,11 @@ GENERIC: update-methods ( class seq -- ) dup class-usages [ nip [ update-class ] each ] [ update-methods ] 2bi ; +: check-inheritance ( subclass superclass -- ) + 2dup superclasses member-eq? [ bad-inheritance ] [ 2drop ] if ; + : define-class ( word superclass members participants metaclass -- ) + [ 2dup check-inheritance ] 3dip make-class-props [ (define-class) ] [ drop changed-definition ] 2bi ; : forget-predicate ( class -- ) diff --git a/core/classes/predicate/predicate-tests.factor b/core/classes/predicate/predicate-tests.factor index dadfa59917..a37b674b3b 100644 --- a/core/classes/predicate/predicate-tests.factor +++ b/core/classes/predicate/predicate-tests.factor @@ -1,5 +1,5 @@ USING: math tools.test classes.algebra words kernel sequences assocs -accessors eval definitions compiler.units generic ; +accessors eval definitions compiler.units generic strings classes ; IN: classes.predicate.tests PREDICATE: negative < integer 0 < ; @@ -42,3 +42,20 @@ M: tuple-d ptest' drop tuple-d ; [ tuple-a ] [ tuple-b new ptest' ] unit-test [ tuple-d ] [ tuple-b new t >>slot ptest' ] unit-test + +PREDICATE: bad-inheritance-predicate < string ; +[ + "IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate < bad-inheritance-predicate ;" eval( -- ) +] [ error>> bad-inheritance? ] must-fail-with + +PREDICATE: bad-inheritance-predicate2 < string ; +PREDICATE: bad-inheritance-predicate3 < bad-inheritance-predicate2 ; +[ + "IN: classes.predicate.tests PREDICATE: bad-inheritance-predicate2 < bad-inheritance-predicate3 ;" eval( -- ) +] [ error>> bad-inheritance? ] must-fail-with + +! This must not fail +PREDICATE: tup < string ; +UNION: u tup ; + +[ ] [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 2b9fd7b89b..12a4226b2c 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -153,3 +153,11 @@ 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 + +! This must not fail +TUPLE: tup ; +UNION: u tup ; + +[ ] [ "IN: classes.tuple.parser.tests TUPLE: u < tup ;" eval( -- ) ] unit-test + +[ t ] [ u new tup? ] unit-test diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 626cbd63df..812f75a591 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! 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 classes.algebra ; +slots math assocs parser.notes classes classes.algebra ; IN: classes.tuple.parser : slot-names ( slots -- seq ) @@ -56,18 +56,11 @@ ERROR: invalid-slot-name name ; : parse-tuple-slots ( -- ) ";" parse-tuple-slots-delim ; -ERROR: bad-inheritance class superclass ; - -: check-inheritance ( class1 class2 -- class1 class2 ) - 2dup swap class<= [ bad-inheritance ] when ; - : parse-tuple-definition ( -- class superclass slots ) CREATE-CLASS - scan 2dup = [ ] when { + scan { { ";" [ tuple f ] } - { "<" [ - scan-word check-inheritance [ parse-tuple-slots ] { } make - ] } + { "<" [ scan-word [ parse-tuple-slots ] { } make ] } [ tuple swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ] } case dup check-duplicate-slots