]> gitweb.factorcode.org Git - factor.git/commitdiff
classes.mixin,classes.union: moves the check-self-reference test
authorBjörn Lindqvist <bjourne@gmail.com>
Tue, 3 Jan 2017 05:10:12 +0000 (06:10 +0100)
committerBjörn Lindqvist <bjourne@gmail.com>
Tue, 3 Jan 2017 05:10:12 +0000 (06:10 +0100)
Should make it so you can't define self-referencing mixins, just like
you can't define self-referencing unions.

core/classes/mixin/mixin-tests.factor
core/classes/union/union-docs.factor
core/classes/union/union.factor

index 539bcc012858d58edaaa83ce2f7bae140ce632db..83892405679a40e24c855704526bf094d33441b3 100644 (file)
@@ -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 } [
     [
index bd7e520f61c516800b0ec4013d173bfdab1c2cc5..d5ee508bf6093ed474642008b432af653cc642cb 100644 (file)
@@ -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." } ;
index e821b151a3b8ae7ca95fe4ecc1ee1612316d6ea3..05bb9bee3d24f22d7d9eabc8b9eb44ffdaf77c86 100644 (file)
@@ -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 ;