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 ;
8 "poo" "words.tests" create-word [ 2 2 + ] ( -- n ) define-declared
9 ] with-compilation-unit
10 "poo" "words.tests" lookup-word execute
13 { t } [ t loaded-vocab-names [ vocab-words [ word? and ] each ] each ] unit-test
18 \ plist-test t "sample-property" set-word-prop
19 \ plist-test "sample-property" word-prop
23 \ plist-test f "sample-property" set-word-prop
24 \ plist-test "sample-property" word-prop
27 { } [ [ "create-test" "scratchpad" create-word { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
30 "create-test" "scratchpad" lookup-word "testing" word-prop
34 [ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
36 [ ] [ [ "test-scope" "scratchpad" create-word drop ] with-compilation-unit ] unit-test
40 "test-scope" "scratchpad" lookup-word name>>
43 { t } [ loaded-vocab-names array? ] unit-test
44 { t } [ loaded-vocab-names [ vocab-words [ word? ] all? ] all? ] unit-test
46 { f } [ gensym gensym = ] unit-test
49 { t } [ \ a-symbol symbol? ] unit-test
51 ! See if redefining a generic as a colon def clears some
53 GENERIC: testing ( a -- b )
54 "IN: words.tests : testing ( -- ) ;" eval( -- )
56 { f } [ \ testing generic? ] unit-test
59 : another-forgotten ( -- ) ;
63 FORGET: another-forgotten
64 : another-forgotten ( -- ) ;
66 ! Make sure that undefined words throw proper errors
68 [ deferred ] [ T{ undefined-word f deferred } = ] must-fail-with
70 [ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
71 [ error>> [ undefined-word? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
73 { } [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
75 { } [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
76 { f } [ "no-loc" "words.tests" lookup-word where ] unit-test
78 { } [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
79 { f } [ "no-loc-2" "words.tests" lookup-word where ] unit-test
81 { } [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
82 { "test-last" } [ last-word name>> ] unit-test
84 "undef-test" "words.tests" lookup-word [
85 [ forget ] with-compilation-unit
88 [ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
89 [ error>> undefined-word? ] must-fail-with
92 "IN: words.tests GENERIC: symbol-generic ( x -- x )" eval( -- )
96 "IN: words.tests SYMBOL: symbol-generic" eval( -- )
99 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
100 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
103 "IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
104 "symbol-generic-test" parse-stream drop
108 "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
109 "symbol-generic-test" parse-stream drop
112 { t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
113 { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
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
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
128 ! No word can have dependencies to forgotten words.
130 load-dependencies [ "forgotten" word-prop ] filter
134 [ "hi" word-code ] must-fail
136 ! Extra return values to defeat tco.
138 get-callstack caller 20 ;
141 : i-call2 ( -- w x y )