core/classes/mixin/mixin-tests.factor

   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
   7
   8 ! Test mixins
   9 MIXIN: sequence-mixin
  10
  11 INSTANCE: array sequence-mixin
  12 INSTANCE: vector sequence-mixin
  13 INSTANCE: slice sequence-mixin
  14
  15 MIXIN: assoc-mixin
  16
  17 INSTANCE: hashtable assoc-mixin
  18
  19 GENERIC: collection-size ( x -- y )
  20
  21 M: sequence-mixin collection-size length ;
  22
  23 M: assoc-mixin collection-size assoc-size ;
  24
  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
  31
  32 ! Test mixing in of new classes after the fact
  33 DEFER: mx1
  34 FORGET: mx1
  35
  36 MIXIN: mx1
  37
  38 INSTANCE: integer mx1
  39
  40 [ t ] [ integer mx1 class<= ] unit-test
  41 [ f ] [ mx1 integer class<= ] unit-test
  42 [ f ] [ mx1 number class<= ] unit-test
  43
  44 "IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )
  45
  46 [ t ] [ array mx1 class<= ] unit-test
  47 [ f ] [ mx1 number class<= ] unit-test
  48
  49 [ \ mx1 forget ] with-compilation-unit
  50
  51 USE: io.streams.string
  52
  53 2 [
  54     [ "mixin-forget-test" forget-source ] with-compilation-unit
  55
  56     [ ] [
  57         {
  58             "USING: sequences ;"
  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"
  65         parse-stream drop
  66     ] unit-test
  67
  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
  70
  71     [ ] [
  72         {
  73             "USING: hashtables ;"
  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"
  80         parse-stream drop
  81     ] unit-test
  82
  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
  85 ] times
  86
  87 ! Method flattening interfered with mixin update
  88 MIXIN: flat-mx-1
  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
  95
  96 [ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
  97
  98 ! Too eager with reset-class
  99
 100 [ ] [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
 101
 102 [ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
 103
 104 [ ] [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
 105
 106 [ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
 107
 108 MIXIN: empty-mixin
 109
 110 [ f ] [ "hi" empty-mixin? ] unit-test
 111
 112 MIXIN: move-instance-declaration-mixin
 113
 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
 115
 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
 117
 118 [ ] [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
 119
 120 [ { string } ] [ move-instance-declaration-mixin members ] unit-test
 121
 122 MIXIN: silly-mixin
 123 SYMBOL: not-a-class
 124
 125 [ [ \ not-a-class \ silly-mixin add-mixin-instance ] with-compilation-unit ] must-fail
 126
 127 SYMBOL: not-a-mixin
 128 TUPLE: a-class ;
 129
 130 [ [ \ a-class \ not-a-mixin add-mixin-instance ] with-compilation-unit ] must-fail
 131
 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
 136
 137 GENERIC: metaclass-change-generic ( a -- b )
 138
 139 M: metaclass-change-mixin metaclass-change-generic ;
 140
 141 [ T{ metaclass-change } ] [ T{ metaclass-change } metaclass-change-generic ] unit-test
 142
 143 [ ] [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
 144
 145 [ 0 ] [ 0 metaclass-change-generic ] unit-test
 146
 147 ! Forgetting a mixin member class should remove it from the mixin
 148 [ ] [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
 149
 150 [ t ] [ metaclass-change-mixin members empty? ] unit-test