core/classes/mixin/mixin-tests.factor

   1 USING: arrays assocs classes classes.algebra classes.mixin
   2 compiler.units definitions eval hashtables io.streams.string
   3 kernel math parser sequences source-files strings tools.test
   4 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         } "\n" join <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         } "\n" join <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: not-a-class
 123
 124 [ [ \ not-a-class \ silly-mixin add-mixin-instance ] with-compilation-unit ] must-fail
 125
 126 SYMBOL: not-a-mixin
 127 TUPLE: a-class ;
 128
 129 [ [ \ a-class \ not-a-mixin add-mixin-instance ] with-compilation-unit ] must-fail
 130
 131 ! Changing a mixin member's metaclass should not remove it from the mixin
 132 MIXIN: metaclass-change-mixin
 133 TUPLE: metaclass-change ;
 134 INSTANCE: metaclass-change metaclass-change-mixin
 135
 136 GENERIC: metaclass-change-generic ( a -- b )
 137
 138 M: metaclass-change-mixin metaclass-change-generic ;
 139
 140 { T{ metaclass-change } } [ T{ metaclass-change } metaclass-change-generic ] unit-test
 141
 142 { } [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
 143
 144 { 0 } [ 0 metaclass-change-generic ] unit-test
 145
 146 ! Forgetting a mixin member class should remove it from the mixin
 147 { } [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
 148
 149 { t } [ metaclass-change-mixin class-members empty? ] unit-test