]> gitweb.factorcode.org Git - factor.git/blob - basis/ui/tools/search/search-tests.factor
Fix permission bits
[factor.git] / basis / ui / tools / search / search-tests.factor
1 USING: assocs ui.tools.search help.topics io.files io.styles
2 kernel namespaces sequences source-files threads
3 tools.test ui.gadgets ui.gestures vocabs accessors
4 vocabs.loader words tools.test.ui debugger ;
5 IN: ui.tools.search.tests
6
7 [ f ] [
8     "no such word with this name exists, certainly"
9     f f <definition-search>
10     T{ key-down f { C+ } "x" } swap search-gesture
11 ] unit-test
12
13 : assert-non-empty ( obj -- ) empty? f assert= ;
14
15 : update-live-search ( search -- seq )
16     dup [
17         300 sleep
18         list>> control-value
19     ] with-grafted-gadget ;
20
21 : test-live-search ( gadget quot -- ? )
22     >r update-live-search dup assert-non-empty r> all? ;
23
24 [ t ] [
25     "swp" all-words f <definition-search>
26     [ word? ] test-live-search
27 ] unit-test
28
29 [ t ] [
30     "" all-words t <definition-search>
31     dup [
32         { "set-word-prop" } over field>> set-control-value
33         300 sleep
34         search-value \ set-word-prop eq?
35     ] with-grafted-gadget
36 ] unit-test
37
38 [ t ] [
39     "quot" <help-search>
40     [ link? ] test-live-search
41 ] unit-test
42
43 [ t ] [
44     "factor" source-files get keys <source-file-search>
45     [ pathname? ] test-live-search
46 ] unit-test
47
48 [ t ] [
49     "kern" <vocab-search>
50     [ vocab-spec? ] test-live-search
51 ] unit-test
52
53 [ t ] [
54     "a" { "a" "b" "aa" } <history-search>
55     [ input? ] test-live-search
56 ] unit-test