core/words/words-tests.factor

   1 USING: accessors arrays compiler.crossref compiler.units definitions
   2 eval generic io.streams.string kernel math namespaces parser sequences
   3 tools.test vocabs words words.private words.symbol ;
   4 IN: words.tests
   5
   6 { 4 } [
   7     [
   8         "poo" "words.tests" create-word [ 2 2 + ] ( -- n ) define-declared
   9     ] with-compilation-unit
  10     "poo" "words.tests" lookup-word execute
  11 ] unit-test
  12
  13 { t } [ t loaded-vocab-names [ vocab-words [ word? and ] each ] each ] unit-test
  14
  15 DEFER: plist-test
  16
  17 { t } [
  18     \ plist-test t "sample-property" set-word-prop
  19     \ plist-test "sample-property" word-prop
  20 ] unit-test
  21
  22 { f } [
  23     \ plist-test f "sample-property" set-word-prop
  24     \ plist-test "sample-property" word-prop
  25 ] unit-test
  26
  27 { } [ [ "create-test" "scratchpad" create-word { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
  28
  29 { { 1 2 } } [
  30     "create-test" "scratchpad" lookup-word "testing" word-prop
  31 ] unit-test
  32
  33 H{ } clone [
  34     [ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
  35
  36     [ ] [ [ "test-scope" "scratchpad" create-word drop ] with-compilation-unit ] unit-test
  37 ] with-variables
  38
  39 { "test-scope" } [
  40     "test-scope" "scratchpad" lookup-word name>>
  41 ] unit-test
  42
  43 { t } [ loaded-vocab-names array? ] unit-test
  44 { t } [ loaded-vocab-names [ vocab-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 ( a -- b )
  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 ! Make sure that undefined words throw proper errors
  67 DEFER: deferred
  68 [ deferred ] [ T{ undefined-word f deferred } = ] must-fail-with
  69
  70 [ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
  71 [ error>> [ undefined-word? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
  72
  73 { } [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
  74
  75 { } [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
  76 { f } [ "no-loc" "words.tests" lookup-word where ] unit-test
  77
  78 { } [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
  79 { f } [ "no-loc-2" "words.tests" lookup-word where ] unit-test
  80
  81 { } [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
  82 { "test-last" } [ last-word name>> ] unit-test
  83
  84 "undef-test" "words.tests" lookup-word [
  85     [ forget ] with-compilation-unit
  86 ] when*
  87
  88 [ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
  89 [ error>> undefined-word? ] must-fail-with
  90
  91 { } [
  92     "IN: words.tests GENERIC: symbol-generic ( x -- x )" eval( -- )
  93 ] unit-test
  94
  95 { } [
  96     "IN: words.tests SYMBOL: symbol-generic" eval( -- )
  97 ] unit-test
  98
  99 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
 100 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
 101
 102 { } [
 103     "IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
 104     "symbol-generic-test" parse-stream drop
 105 ] unit-test
 106
 107 { } [
 108     "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
 109     "symbol-generic-test" parse-stream drop
 110 ] unit-test
 111
 112 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
 113 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
 114
 115 ! Regressions
 116 { } [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
 117 { t } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
 118 { } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 119 { f } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
 120
 121 { } [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
 122 { t } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
 123 { } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
 124 { f } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
 125
 126 { { } }
 127 [
 128     ! No word can have dependencies to forgotten words.
 129     all-words [
 130         load-dependencies [ "forgotten" word-prop ] filter
 131     ] map harvest
 132 ] unit-test
 133
 134 [ "hi" word-code ] must-fail
 135
 136 ! Extra return values to defeat tco.
 137 : i-call1 ( -- w n )
 138     get-callstack caller 20 ;
 139
 140 ! caller
 141 : i-call2 ( -- w x y )
 142     i-call1 30 ;
 143
 144 { i-call2 } [
 145     i-call2 2drop
 146 ] unit-test