classes.mixin,classes.union: moves the check-self-reference test
Should make it so you can't define self-referencing mixins, just like you can't define self-referencing unions.char-rename
parent
13ec2e41b9
commit
350de8f171
|
@ -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 } [
|
||||
[
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue