core/words/words-tests.factor

   1 USING: arrays generic assocs kernel math namespaces
   2 sequences tools.test words definitions parser quotations
   3 vocabs continuations classes.tuple compiler.units
   4 io.streams.string accessors eval words.symbol ;
   5 IN: words.tests
   6
   7 [ 4 ] [
   8     [
   9         "poo" "words.tests" create [ 2 2 + ] define
  10     ] with-compilation-unit
  11     "poo" "words.tests" lookup execute
  12 ] unit-test
  13
  14 [ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test
  15
  16 DEFER: plist-test
  17
  18 [ t ] [
  19     \ plist-test t "sample-property" set-word-prop
  20     \ plist-test "sample-property" word-prop
  21 ] unit-test
  22
  23 [ f ] [
  24     \ plist-test f "sample-property" set-word-prop
  25     \ plist-test "sample-property" word-prop
  26 ] unit-test
  27
  28 "create-test" "scratchpad" create { 1 2 } "testing" set-word-prop
  29 [ { 1 2 } ] [
  30     "create-test" "scratchpad" lookup "testing" word-prop
  31 ] unit-test
  32
  33 [
  34     [ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
  35
  36     [ ] [ "test-scope" "scratchpad" create drop ] unit-test
  37 ] with-scope
  38
  39 [ "test-scope" ] [
  40     "test-scope" "scratchpad" lookup name>>
  41 ] unit-test
  42
  43 [ t ] [ vocabs array? ] unit-test
  44 [ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test
  45
  46 [ f ] [ gensym gensym = ] unit-test
  47
  48 SYMBOL: a-symbol
  49 [ t ] [ \ a-symbol symbol? ] unit-test
  50
  51 ! See if redefining a generic as a colon def clears some
  52 ! word props.
  53 GENERIC: testing
  54 "IN: words.tests : testing ;" eval
  55
  56 [ f ] [ \ testing generic? ] unit-test
  57
  58 : forgotten ;
  59 : another-forgotten ;
  60
  61 FORGET: forgotten
  62
  63 FORGET: another-forgotten
  64 : another-forgotten ;
  65
  66 ! I forgot remove-crossref calls!
  67 : fee ;
  68 : foe fee ;
  69 : fie foe ;
  70
  71 [ t ] [ \ fee usage [ word? ] filter empty? ] unit-test
  72 [ t ] [ \ foe usage empty? ] unit-test
  73 [ f ] [ \ foe crossref get key? ] unit-test
  74
  75 FORGET: foe
  76
  77 ! xref should not retain references to gensyms
  78 [ ] [
  79     [ gensym [ * ] define ] with-compilation-unit
  80 ] unit-test
  81
  82 [ t ] [
  83     \ * usage [ word? ] filter [ crossref? ] all?
  84 ] unit-test
  85
  86 DEFER: calls-a-gensym
  87 [ ] [
  88     [
  89         \ calls-a-gensym
  90         gensym dup "x" set 1quotation
  91         define
  92     ] with-compilation-unit
  93 ] unit-test
  94
  95 [ f ] [ "x" get crossref get at ] unit-test
  96
  97 ! more xref buggery
  98 [ f ] [
  99     GENERIC: xyzzle ( x -- x )
 100     : a ; \ a
 101     M: integer xyzzle a ;
 102     FORGET: a
 103     M: object xyzzle ;
 104     crossref get at
 105 ] unit-test
 106
 107 ! regression
 108 GENERIC: freakish ( x -- y )
 109 : bar freakish ;
 110 M: array freakish ;
 111 [ t ] [ \ bar \ freakish usage member? ] unit-test
 112
 113 DEFER: x
 114 [ x ] [ undefined? ] must-fail-with
 115
 116 [ ] [ "no-loc" "words.tests" create drop ] unit-test
 117 [ f ] [ "no-loc" "words.tests" lookup where ] unit-test
 118
 119 [ ] [ "IN: words.tests : no-loc-2 ;" eval ] unit-test
 120 [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
 121
 122 [ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test
 123 [ "test-last" ] [ word name>> ] unit-test
 124
 125 ! regression
 126 SYMBOL: quot-uses-a
 127 SYMBOL: quot-uses-b
 128
 129 [ ] [
 130     [
 131         quot-uses-a [ 2 3 + ] define
 132     ] with-compilation-unit
 133 ] unit-test
 134
 135 [ { + } ] [ \ quot-uses-a uses ] unit-test
 136
 137 [ ] [
 138     [
 139         quot-uses-b 2 [ 3 + ] curry define
 140     ] with-compilation-unit
 141 ] unit-test
 142
 143 [ { + } ] [ \ quot-uses-b uses ] unit-test
 144
 145 "undef-test" "words.tests" lookup [
 146     [ forget ] with-compilation-unit
 147 ] when*
 148
 149 [ "IN: words.tests : undef-test ; << undef-test >>" eval ]
 150 [ error>> undefined? ] must-fail-with
 151
 152 [ ] [
 153     "IN: words.tests GENERIC: symbol-generic" eval
 154 ] unit-test
 155
 156 [ ] [
 157     "IN: words.tests SYMBOL: symbol-generic" eval
 158 ] unit-test
 159
 160 [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
 161 [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
 162
 163 [ ] [
 164     "IN: words.tests GENERIC: symbol-generic" <string-reader>
 165     "symbol-generic-test" parse-stream drop
 166 ] unit-test
 167
 168 [ ] [
 169     "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
 170     "symbol-generic-test" parse-stream drop
 171 ] unit-test
 172
 173 [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
 174 [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
 175
 176 ! Regressions
 177 [ ] [ "IN: words.tests : decl-forget-test ; foldable" eval ] unit-test
 178 [ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
 179 [ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test
 180 [ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
 181
 182 [ ] [ "IN: words.tests : decl-forget-test ; flushable" eval ] unit-test
 183 [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
 184 [ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test
 185 [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
 186
 187 [ { } ]
 188 [
 189     all-words [
 190         "compiled-uses" word-prop
 191         keys [ "forgotten" word-prop ] contains?
 192     ] filter
 193 ] unit-test
 194
 195 [ { } ] [
 196     crossref get keys
 197     [ word? ] filter [ "forgotten" word-prop ] filter
 198 ] unit-test