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 grouping ;
   5 IN: words.tests
   6
   7 [ 4 ] [
   8     [
   9         "poo" "words.tests" create [ 2 2 + ] (( -- n )) define-declared
  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 ] with-compilation-unit ] unit-test
  29
  30 [ { 1 2 } ] [
  31     "create-test" "scratchpad" lookup "testing" word-prop
  32 ] unit-test
  33
  34 [
  35     [ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
  36
  37     [ ] [ [ "test-scope" "scratchpad" create drop ] with-compilation-unit ] unit-test
  38 ] with-scope
  39
  40 [ "test-scope" ] [
  41     "test-scope" "scratchpad" lookup name>>
  42 ] unit-test
  43
  44 [ t ] [ vocabs array? ] unit-test
  45 [ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test
  46
  47 [ f ] [ gensym gensym = ] unit-test
  48
  49 SYMBOL: a-symbol
  50 [ t ] [ \ a-symbol symbol? ] unit-test
  51
  52 ! See if redefining a generic as a colon def clears some
  53 ! word props.
  54 GENERIC: testing ( a -- b )
  55 "IN: words.tests : testing ( -- ) ;" eval( -- )
  56
  57 [ f ] [ \ testing generic? ] unit-test
  58
  59 : forgotten ( -- ) ;
  60 : another-forgotten ( -- ) ;
  61
  62 FORGET: forgotten
  63
  64 FORGET: another-forgotten
  65 : another-forgotten ( -- ) ;
  66
  67
  68 DEFER: x
  69 [ x ] [ undefined? ] must-fail-with
  70
  71 [ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test
  72 [ f ] [ "no-loc" "words.tests" lookup where ] unit-test
  73
  74 [ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
  75 [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
  76
  77 [ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
  78 [ "test-last" ] [ word name>> ] unit-test
  79
  80 "undef-test" "words.tests" lookup [
  81     [ forget ] with-compilation-unit
  82 ] when*
  83
  84 [ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
  85 [ error>> undefined? ] must-fail-with
  86
  87 [ ] [
  88     "IN: words.tests GENERIC: symbol-generic ( -- )" eval( -- )
  89 ] unit-test
  90
  91 [ ] [
  92     "IN: words.tests SYMBOL: symbol-generic" eval( -- )
  93 ] unit-test
  94
  95 [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
  96 [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
  97
  98 [ ] [
  99     "IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
 100     "symbol-generic-test" parse-stream drop
 101 ] unit-test
 102
 103 [ ] [
 104     "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
 105     "symbol-generic-test" parse-stream drop
 106 ] unit-test
 107
 108 [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
 109 [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
 110
 111 ! Regressions
 112 [ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
 113 [ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
 114 [ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 115 [ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
 116
 117 [ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
 118 [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
 119 [ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 120 [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
 121
 122 [ { } ]
 123 [
 124     all-words [
 125         "compiled-uses" word-prop 2 <groups>
 126         keys [ "forgotten" word-prop ] filter
 127     ] map harvest
 128 ] unit-test
 129
 130 [ "hi" word-xt ] must-fail