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-word [ 2 2 + ] ( -- n ) define-declared
  10     ] with-compilation-unit
  11     "poo" "words.tests" lookup-word execute
  12 ] unit-test
  13
  14 { t } [ t loaded-vocab-names [ vocab-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-word { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
  29
  30 { { 1 2 } } [
  31     "create-test" "scratchpad" lookup-word "testing" word-prop
  32 ] unit-test
  33
  34 [
  35     [ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
  36
  37     [ ] [ [ "test-scope" "scratchpad" create-word drop ] with-compilation-unit ] unit-test
  38 ] with-scope
  39
  40 { "test-scope" } [
  41     "test-scope" "scratchpad" lookup-word name>>
  42 ] unit-test
  43
  44 { t } [ loaded-vocab-names array? ] unit-test
  45 { t } [ loaded-vocab-names [ vocab-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 ! Make sure that undefined words throw proper errors
  68 DEFER: deferred
  69 [ deferred ] [ T{ undefined-word f deferred } = ] must-fail-with
  70
  71 [ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
  72 [ error>> [ undefined-word? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
  73
  74 { } [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
  75
  76 { } [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
  77 { f } [ "no-loc" "words.tests" lookup-word where ] unit-test
  78
  79 { } [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
  80 { f } [ "no-loc-2" "words.tests" lookup-word where ] unit-test
  81
  82 { } [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
  83 { "test-last" } [ last-word name>> ] unit-test
  84
  85 "undef-test" "words.tests" lookup-word [
  86     [ forget ] with-compilation-unit
  87 ] when*
  88
  89 [ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
  90 [ error>> undefined-word? ] must-fail-with
  91
  92 { } [
  93     "IN: words.tests GENERIC: symbol-generic ( -- )" eval( -- )
  94 ] unit-test
  95
  96 { } [
  97     "IN: words.tests SYMBOL: symbol-generic" eval( -- )
  98 ] unit-test
  99
 100 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
 101 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
 102
 103 { } [
 104     "IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
 105     "symbol-generic-test" parse-stream drop
 106 ] unit-test
 107
 108 { } [
 109     "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
 110     "symbol-generic-test" parse-stream drop
 111 ] unit-test
 112
 113 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
 114 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
 115
 116 ! Regressions
 117 { } [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
 118 { t } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
 119 { } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 120 { f } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
 121
 122 { } [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
 123 { t } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
 124 { } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 125 { f } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
 126
 127 { { } }
 128 [
 129     all-words [
 130         [ "effect-dependencies" word-prop ]
 131         [ "definition-dependencies" word-prop ]
 132         [ "conditional-dependencies" word-prop ] tri
 133         3append [ "forgotten" word-prop ] filter
 134     ] map harvest
 135 ] unit-test
 136
 137 [ "hi" word-code ] must-fail