/core/words/words-tests.factor

  1USING: arrays generic assocs kernel math namespaces
  2sequences tools.test words definitions parser quotations
  3vocabs continuations classes.tuple compiler.units
  4io.streams.string accessors eval words.symbol grouping ;
  5IN: 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-word execute
 12] unit-test
 13
 14[ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test
 15
 16DEFER: 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-word "testing" word-prop
 32] unit-test
 33
 34[
 35    [ t ] [ \ array? "array?" "arrays" lookup-word = ] 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-word 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
 49SYMBOL: 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.
 54GENERIC: testing ( a -- b )
 55"IN: words.tests : testing ( -- ) ;" eval( -- )
 56
 57[ f ] [ \ testing generic? ] unit-test
 58
 59: forgotten ( -- ) ;
 60: another-forgotten ( -- ) ;
 61
 62FORGET: forgotten
 63
 64FORGET: another-forgotten
 65: another-forgotten ( -- ) ;
 66
 67! Make sure that undefined words throw proper errors
 68DEFER: deferred
 69[ deferred ] [ T{ undefined f deferred } = ] must-fail-with
 70
 71[ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
 72[ error>> [ undefined? ] [ 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 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" ] [ 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? ] 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