core/classes/mixin/mixin-tests.factor

   1 USING: accessors arrays assocs classes classes.algebra classes.mixin
   2 classes.mixin.private classes.union.private compiler.units definitions
   3 eval hashtables kernel math parser sequences source-files strings
   4 tools.test vectors words ;
   5 IN: classes.mixin.tests
   6
   7 ! Test mixins
   8 MIXIN: sequence-mixin
   9
  10 INSTANCE: array sequence-mixin
  11 INSTANCE: vector sequence-mixin
  12 INSTANCE: slice sequence-mixin
  13
  14 MIXIN: assoc-mixin
  15
  16 INSTANCE: hashtable assoc-mixin
  17
  18 GENERIC: collection-size ( x -- y )
  19
  20 M: sequence-mixin collection-size length ;
  21
  22 M: assoc-mixin collection-size assoc-size ;
  23
  24 { t } [ array sequence-mixin class<= ] unit-test
  25 { t } [ { 1 2 3 } sequence-mixin? ] unit-test
  26 { 3 } [ { 1 2 3 } collection-size ] unit-test
  27 { f } [ H{ { 1 2 } { 2 3 } } sequence-mixin? ] unit-test
  28 { t } [ H{ { 1 2 } { 2 3 } } assoc-mixin? ] unit-test
  29 { 2 } [ H{ { 1 2 } { 2 3 } } collection-size ] unit-test
  30
  31 ! Test mixing in of new classes after the fact
  32 DEFER: mx1
  33 FORGET: mx1
  34
  35 MIXIN: mx1
  36
  37 INSTANCE: integer mx1
  38
  39 { t } [ integer mx1 class<= ] unit-test
  40 { f } [ mx1 integer class<= ] unit-test
  41 { f } [ mx1 number class<= ] unit-test
  42
  43 "IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )
  44
  45 { t } [ array mx1 class<= ] unit-test
  46 { f } [ mx1 number class<= ] unit-test
  47
  48 [ \ mx1 forget ] with-compilation-unit
  49
  50 USE: io.streams.string
  51
  52 2 [
  53     [ "mixin-forget-test" forget-source ] with-compilation-unit
  54
  55     [ ] [
  56         {
  57             "USING: sequences ;"
  58             "IN: classes.mixin.tests"
  59             "MIXIN: mixin-forget-test"
  60             "INSTANCE: sequence mixin-forget-test"
  61             "GENERIC: mixin-forget-test-g ( x -- y )"
  62             "M: mixin-forget-test mixin-forget-test-g ;"
  63         } unlines <string-reader> "mixin-forget-test"
  64         parse-stream drop
  65     ] unit-test
  66
  67     [ { } ] [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
  68     [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
  69
  70     [ ] [
  71         {
  72             "USING: hashtables ;"
  73             "IN: classes.mixin.tests"
  74             "MIXIN: mixin-forget-test"
  75             "INSTANCE: hashtable mixin-forget-test"
  76             "GENERIC: mixin-forget-test-g ( x -- y )"
  77             "M: mixin-forget-test mixin-forget-test-g ;"
  78         } unlines <string-reader> "mixin-forget-test"
  79         parse-stream drop
  80     ] unit-test
  81
  82     [ { } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] must-fail
  83     [ H{ } ] [ H{ } "mixin-forget-test-g" "classes.mixin.tests" lookup-word execute ] unit-test
  84 ] times
  85
  86 ! Method flattening interfered with mixin update
  87 MIXIN: flat-mx-1
  88 TUPLE: flat-mx-1-1 ; INSTANCE: flat-mx-1-1 flat-mx-1
  89 TUPLE: flat-mx-1-2 ; INSTANCE: flat-mx-1-2 flat-mx-1
  90 TUPLE: flat-mx-1-3 ; INSTANCE: flat-mx-1-3 flat-mx-1
  91 TUPLE: flat-mx-1-4 ; INSTANCE: flat-mx-1-4 flat-mx-1
  92 MIXIN: flat-mx-2     INSTANCE: flat-mx-2 flat-mx-1
  93 TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
  94
  95 { t } [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
  96
  97 ! Too eager with reset-class
  98
  99 { } [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
 100
 101 { t } [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
 102
 103 { } [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
 104
 105 { t } [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
 106
 107 MIXIN: empty-mixin
 108
 109 { f } [ "hi" empty-mixin? ] unit-test
 110
 111 MIXIN: move-instance-declaration-mixin
 112
 113 { } [ "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
 114
 115 { } [ "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
 116
 117 { } [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
 118
 119 { { string } } [ move-instance-declaration-mixin class-members ] unit-test
 120
 121 MIXIN: silly-mixin
 122 SYMBOL: a-symbol
 123
 124 [
 125     [
 126         \ a-symbol \ silly-mixin add-mixin-instance
 127     ] with-compilation-unit
 128 ] [ not-an-instance? ] must-fail-with
 129
 130 SYMBOL: not-a-mixin
 131 TUPLE: a-class ;
 132
 133 [
 134     [
 135         \ a-class \ not-a-mixin add-mixin-instance
 136     ] with-compilation-unit
 137 ] [ not-an-instance? ] must-fail-with
 138
 139 ! Changing a mixin member's metaclass should not remove it from the mixin
 140 MIXIN: metaclass-change-mixin
 141 TUPLE: metaclass-change ;
 142 INSTANCE: metaclass-change metaclass-change-mixin
 143
 144 GENERIC: metaclass-change-generic ( a -- b )
 145
 146 M: metaclass-change-mixin metaclass-change-generic ;
 147
 148 { T{ metaclass-change } } [ T{ metaclass-change } metaclass-change-generic ] unit-test
 149
 150 { } [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
 151
 152 { 0 } [ 0 metaclass-change-generic ] unit-test
 153
 154 ! Forgetting a mixin member class should remove it from the mixin
 155 { } [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
 156
 157 { t } [ metaclass-change-mixin class-members empty? ] unit-test
 158
 159 ! Don't allow mixins to reference themselves
 160 [
 161     "IN: issue-1652 MIXIN: bmix INSTANCE: bmix bmix" eval( -- )
 162 ] [ error>> cannot-reference-self? ] must-fail-with
 163
 164 [
 165     "IN: issue-1652 MIXIN: a MIXIN: b INSTANCE: a b INSTANCE: b a" eval( -- )
 166 ] [ error>> cannot-reference-self? ] must-fail-with
 167
 168 ! redefine-mixin-class
 169 { t } [
 170     [
 171         SYMBOLS: foo1 foo2 ;
 172         foo1 { foo2 } redefine-mixin-class
 173         foo1 "mixin" word-prop
 174     ] with-compilation-unit
 175 ] unit-test