diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor index 539bcc0128..8389240567 100644 --- a/core/classes/mixin/mixin-tests.factor +++ b/core/classes/mixin/mixin-tests.factor @@ -1,6 +1,6 @@ -USING: arrays assocs classes classes.algebra classes.mixin -classes.mixin.private compiler.units continuations definitions eval -hashtables kernel math parser sequences source-files strings +USING: accessors arrays assocs classes classes.algebra classes.mixin +classes.mixin.private classes.union.private compiler.units definitions +eval hashtables kernel math parser sequences source-files strings tools.test vectors words ; IN: classes.mixin.tests @@ -156,6 +156,15 @@ M: metaclass-change-mixin metaclass-change-generic ; { t } [ metaclass-change-mixin class-members empty? ] unit-test +! Don't allow mixins to reference themselves +[ + "IN: issue-1652 MIXIN: bmix INSTANCE: bmix bmix" eval( -- ) +] [ error>> cannot-reference-self? ] must-fail-with + +[ + "IN: issue-1652 MIXIN: a MIXIN: b INSTANCE: a b INSTANCE: b a" eval( -- ) +] [ error>> cannot-reference-self? ] must-fail-with + ! redefine-mixin-class { t } [ [ diff --git a/core/classes/union/union-docs.factor b/core/classes/union/union-docs.factor index bd7e520f61..d5ee508bf6 100644 --- a/core/classes/union/union-docs.factor +++ b/core/classes/union/union-docs.factor @@ -1,6 +1,5 @@ -USING: generic help.markup help.syntax kernel kernel.private -namespaces sequences words arrays help effects math -classes.private classes compiler.units ; +USING: classes classes.builtin classes.union.private compiler.units +help.markup help.syntax kernel ; IN: classes.union ARTICLE: "unions" "Union classes" @@ -21,13 +20,23 @@ ARTICLE: "unions" "Union classes" ABOUT: "unions" +HELP: (define-union-class) +{ $values { "class" class } { "members" "a sequence of classes" } } +{ $description "Defines a union class." } +{ $errors "Throws " { $link cannot-reference-self } " if the definition references itself." } ; + HELP: define-union-class { $values { "class" class } { "members" "a sequence of classes" } } { $description "Defines a union class with specified members. This is the run time equivalent of " { $link POSTPONE: UNION: } "." } { $notes "This word must be called from inside " { $link with-compilation-unit } "." } -{ $side-effects "class" } ; +{ $side-effects "class" +} ; { union-class define-union-class POSTPONE: UNION: } related-words HELP: union-class { $class-description "The class of union classes." } ; + +HELP: union-of-builtins? +{ $values { "class" class } { "?" boolean } } +{ $description { $link t } " if the class either is a " { $link builtin-class } " or only contains builtin classes." } ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index e821b151a3..05bb9bee3d 100644 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -50,18 +50,18 @@ M: class union-of-builtins? M: union-class update-class define-union-predicate ; -: (define-union-class) ( class members -- ) - f swap f union-class make-class-props (define-class) ; - ERROR: cannot-reference-self class members ; : check-self-reference ( class members -- class members ) 2dup all-contained-classes member-eq? [ cannot-reference-self ] when ; +: (define-union-class) ( class members -- ) + check-self-reference f swap f union-class make-class-props (define-class) ; + PRIVATE> : define-union-class ( class members -- ) - [ check-self-reference (define-union-class) ] + [ (define-union-class) ] [ drop changed-conditionally ] [ drop update-classes ] 2tri ;