1 USING: alien arrays definitions generic assocs hashtables io kernel
2 math namespaces parser prettyprint sequences strings tools.test words
3 quotations classes classes.private classes.union classes.mixin
4 classes.predicate classes.algebra vectors source-files compiler.units
5 kernel.private sorting vocabs eval ;
6 IN: classes.mixin.tests
11 INSTANCE: array sequence-mixin
12 INSTANCE: vector sequence-mixin
13 INSTANCE: slice sequence-mixin
17 INSTANCE: hashtable assoc-mixin
19 GENERIC: collection-size ( x -- y )
21 M: sequence-mixin collection-size length ;
23 M: assoc-mixin collection-size assoc-size ;
25 [ t ] [ array sequence-mixin class<= ] unit-test
26 [ t ] [ { 1 2 3 } sequence-mixin? ] unit-test
27 [ 3 ] [ { 1 2 3 } collection-size ] unit-test
28 [ f ] [ H{ { 1 2 } { 2 3 } } sequence-mixin? ] unit-test
29 [ t ] [ H{ { 1 2 } { 2 3 } } assoc-mixin? ] unit-test
30 [ 2 ] [ H{ { 1 2 } { 2 3 } } collection-size ] unit-test
32 ! Test mixing in of new classes after the fact
40 [ t ] [ integer mx1 class<= ] unit-test
41 [ f ] [ mx1 integer class<= ] unit-test
42 [ f ] [ mx1 number class<= ] unit-test
44 "IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )
46 [ t ] [ array mx1 class<= ] unit-test
47 [ f ] [ mx1 number class<= ] unit-test
49 [ \ mx1 forget ] with-compilation-unit
51 USE: io.streams.string
54 [ "mixin-forget-test" forget-source ] with-compilation-unit
59 "IN: classes.mixin.tests"
60 "MIXIN: mixin-forget-test"
61 "INSTANCE: sequence mixin-forget-test"
62 "GENERIC: mixin-forget-test-g ( x -- y )"
63 "M: mixin-forget-test mixin-forget-test-g ;"
64 } "\n" join <string-reader> "mixin-forget-test"
68 [ { } ] [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
69 [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
74 "IN: classes.mixin.tests"
75 "MIXIN: mixin-forget-test"
76 "INSTANCE: hashtable mixin-forget-test"
77 "GENERIC: mixin-forget-test-g ( x -- y )"
78 "M: mixin-forget-test mixin-forget-test-g ;"
79 } "\n" join <string-reader> "mixin-forget-test"
83 [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
84 [ H{ } ] [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
87 ! Method flattening interfered with mixin update
89 TUPLE: flat-mx-1-1 ; INSTANCE: flat-mx-1-1 flat-mx-1
90 TUPLE: flat-mx-1-2 ; INSTANCE: flat-mx-1-2 flat-mx-1
91 TUPLE: flat-mx-1-3 ; INSTANCE: flat-mx-1-3 flat-mx-1
92 TUPLE: flat-mx-1-4 ; INSTANCE: flat-mx-1-4 flat-mx-1
93 MIXIN: flat-mx-2 INSTANCE: flat-mx-2 flat-mx-1
94 TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
96 [ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
98 ! Too eager with reset-class
100 [ ] [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
102 [ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
104 [ ] [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
106 [ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
110 [ f ] [ "hi" empty-mixin? ] unit-test
112 MIXIN: move-instance-declaration-mixin
114 [ ] [ "IN: classes.mixin.tests.a USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
116 [ ] [ "IN: classes.mixin.tests.b USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-2" parse-stream drop ] unit-test
118 [ ] [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
120 [ { string } ] [ move-instance-declaration-mixin members ] unit-test
125 [ [ \ not-a-class \ silly-mixin add-mixin-instance ] with-compilation-unit ] must-fail
130 [ [ \ a-class \ not-a-mixin add-mixin-instance ] with-compilation-unit ] must-fail
132 ! Changing a mixin member's metaclass should not remove it from the mixin
133 MIXIN: metaclass-change-mixin
134 TUPLE: metaclass-change ;
135 INSTANCE: metaclass-change metaclass-change-mixin
137 GENERIC: metaclass-change-generic ( a -- b )
139 M: metaclass-change-mixin metaclass-change-generic ;
141 [ T{ metaclass-change } ] [ T{ metaclass-change } metaclass-change-generic ] unit-test
143 [ ] [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
145 [ 0 ] [ 0 metaclass-change-generic ] unit-test
147 ! Forgetting a mixin member class should remove it from the mixin
148 [ ] [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
150 [ t ] [ metaclass-change-mixin members empty? ] unit-test