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
|
USING: accessors arrays assocs classes classes.algebra classes.mixin
|
||||||
classes.mixin.private compiler.units continuations definitions eval
|
classes.mixin.private classes.union.private compiler.units definitions
|
||||||
hashtables kernel math parser sequences source-files strings
|
eval hashtables kernel math parser sequences source-files strings
|
||||||
tools.test vectors words ;
|
tools.test vectors words ;
|
||||||
IN: classes.mixin.tests
|
IN: classes.mixin.tests
|
||||||
|
|
||||||
|
@ -156,6 +156,15 @@ M: metaclass-change-mixin metaclass-change-generic ;
|
||||||
|
|
||||||
{ t } [ metaclass-change-mixin class-members empty? ] unit-test
|
{ 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
|
! redefine-mixin-class
|
||||||
{ t } [
|
{ t } [
|
||||||
[
|
[
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
USING: generic help.markup help.syntax kernel kernel.private
|
USING: classes classes.builtin classes.union.private compiler.units
|
||||||
namespaces sequences words arrays help effects math
|
help.markup help.syntax kernel ;
|
||||||
classes.private classes compiler.units ;
|
|
||||||
IN: classes.union
|
IN: classes.union
|
||||||
|
|
||||||
ARTICLE: "unions" "Union classes"
|
ARTICLE: "unions" "Union classes"
|
||||||
|
@ -21,13 +20,23 @@ ARTICLE: "unions" "Union classes"
|
||||||
|
|
||||||
ABOUT: "unions"
|
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
|
HELP: define-union-class
|
||||||
{ $values { "class" class } { "members" "a sequence of classes" } }
|
{ $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: } "." }
|
{ $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 } "." }
|
{ $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
|
{ union-class define-union-class POSTPONE: UNION: } related-words
|
||||||
|
|
||||||
HELP: union-class
|
HELP: union-class
|
||||||
{ $class-description "The class of union classes." } ;
|
{ $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 ;
|
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 ;
|
ERROR: cannot-reference-self class members ;
|
||||||
|
|
||||||
: check-self-reference ( class members -- class members )
|
: check-self-reference ( class members -- class members )
|
||||||
2dup all-contained-classes member-eq? [ cannot-reference-self ] when ;
|
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>
|
PRIVATE>
|
||||||
|
|
||||||
: define-union-class ( class members -- )
|
: define-union-class ( class members -- )
|
||||||
[ check-self-reference (define-union-class) ]
|
[ (define-union-class) ]
|
||||||
[ drop changed-conditionally ]
|
[ drop changed-conditionally ]
|
||||||
[ drop update-classes ]
|
[ drop update-classes ]
|
||||||
2tri ;
|
2tri ;
|
||||||
|
|
Loading…
Reference in New Issue