classes.mixin: fix type checking in add-mixin-instance

One test in classes.mixin.tests intermittently breaks otherwise.

diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor
index 63d24fa4f220d4f3e6ca607685243e81172c0e64..47e47dbc403d558535d98e5f9670234838a6cca8 100644 (file)
--- a/core/classes/mixin/mixin-tests.factor
+++ b/core/classes/mixin/mixin-tests.factor
@@ -1,7 +1,7 @@
 USING: arrays assocs classes classes.algebra classes.mixin
-compiler.units definitions eval hashtables io.streams.string
-kernel math parser sequences source-files strings tools.test
-vectors words ;
+classes.mixin.private compiler.units continuations definitions eval
+hashtables kernel math parser sequences source-files strings
+tools.test vectors words ;
 IN: classes.mixin.tests
 
 ! Test mixins
@@ -119,14 +119,22 @@ MIXIN: move-instance-declaration-mixin
 { { string } } [ move-instance-declaration-mixin class-members ] unit-test
 
 MIXIN: silly-mixin
-SYMBOL: not-a-class
+SYMBOL: a-symbol
 
-[ [ \ not-a-class \ silly-mixin add-mixin-instance ] with-compilation-unit ] must-fail
+[
+    [
+        \ a-symbol \ silly-mixin add-mixin-instance
+    ] with-compilation-unit
+] [ not-a-class? ] must-fail-with
 
 SYMBOL: not-a-mixin
 TUPLE: a-class ;
 
-[ [ \ a-class \ not-a-mixin add-mixin-instance ] with-compilation-unit ] must-fail
+[
+    [
+        \ a-class \ not-a-mixin add-mixin-instance
+    ] with-compilation-unit
+] [ not-a-mixin-class? ] must-fail-with
 
 ! Changing a mixin member's metaclass should not remove it from the mixin
 MIXIN: metaclass-change-mixin
@@ -147,3 +155,12 @@ M: metaclass-change-mixin metaclass-change-generic ;
 { } [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
 
 { t } [ metaclass-change-mixin class-members empty? ] unit-test
+
+! redefine-mixin-class
+{ t } [
+    [
+        SYMBOL: foo1
+        foo1 { foo1 } redefine-mixin-class
+        foo1 "mixin" word-prop
+    ] with-compilation-unit
+] unit-test

diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor
index b9873064d328b269647a5eb6e8bdb448aa9ad75f..86a25e4ba798be125a4bc223880853596a8e4ec1 100644 (file)
--- a/core/classes/mixin/mixin.factor
+++ b/core/classes/mixin/mixin.factor
@@ -18,11 +18,6 @@ M: mixin-class reset-class
 
 M: mixin-class rank-class drop 8 ;
 
-ERROR: not-a-mixin-class class ;
-
-: check-mixin-class ( mixin -- mixin )
-    dup mixin-class? [ not-a-mixin-class ] unless ;
-
 <PRIVATE
 
 : redefine-mixin-class ( class members -- )
@@ -32,7 +27,7 @@ ERROR: not-a-mixin-class class ;
     2tri ;
 
 : if-mixin-member? ( class mixin true false -- )
-    [ check-mixin-class 2dup class-members member-eq? ] 2dip if ; inline
+    [ 2dup class-members member-eq? ] 2dip if ; inline
 
 : change-mixin-class ( class mixin quot -- )
     [ [ class-members swap bootstrap-word ] dip call ] [ drop ] 2bi
@@ -66,8 +61,16 @@ ERROR: not-a-mixin-class class ;
 
 PRIVATE>
 
+ERROR: not-a-class object ;
+
+ERROR: not-a-mixin-class object ;
+
+: check-types ( class mixin -- class mixin )
+    [ dup class? [ not-a-class ] unless ]
+    [ dup mixin-class? [ not-a-mixin-class ] unless ] bi* ;
+
 : add-mixin-instance ( class mixin -- )
-    [ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ;
+    check-types [ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ;
 
 : remove-mixin-instance ( class mixin -- )
     [ (remove-mixin-instance) ] [ 2drop ] if-mixin-member? ;