]> gitweb.factorcode.org Git - factor.git/blob - extra/mason/test/test.factor
Merge branch 'master' into experimental
[factor.git] / extra / mason / test / test.factor
1 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs benchmark bootstrap.stage2
4 compiler.errors generic help.html help.lint io.directories
5 io.encodings.utf8 io.files kernel mason.common math namespaces
6 prettyprint sequences sets sorting tools.test tools.time
7 tools.vocabs words ;
8 IN: mason.test
9
10 : do-load ( -- )
11     try-everything
12     [ keys load-everything-vocabs-file to-file ]
13     [ load-everything-errors-file utf8 [ load-failures. ] with-file-writer ]
14     bi ;
15
16 GENERIC: word-vocabulary ( word -- vocabulary )
17
18 M: word word-vocabulary vocabulary>> ;
19
20 M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ;
21
22 : do-compile-errors ( -- )
23     compiler-errors-file utf8 [
24         +error+ errors-of-type keys
25         [ word-vocabulary ] map
26         prune natural-sort .
27     ] with-file-writer ;
28
29 : do-tests ( -- )
30     run-all-tests
31     [ keys test-all-vocabs-file to-file ]
32     [ test-all-errors-file utf8 [ test-failures. ] with-file-writer ]
33     bi ;
34
35 : do-help-lint ( -- )
36     "" run-help-lint
37     [ keys help-lint-vocabs-file to-file ]
38     [ help-lint-errors-file utf8 [ typos. ] with-file-writer ]
39     bi ;
40
41 : do-benchmarks ( -- )
42     run-benchmarks benchmarks-file to-file ;
43
44 : benchmark-ms ( quot -- ms )
45     benchmark 1000 /i ; inline
46
47 : do-all ( -- )
48     ".." [
49         bootstrap-time get boot-time-file to-file
50         [ do-load do-compile-errors ] benchmark-ms load-time-file to-file
51         [ generate-help ] benchmark-ms html-help-time-file to-file
52         [ do-tests ] benchmark-ms test-time-file to-file
53         [ do-help-lint ] benchmark-ms help-lint-time-file to-file
54         [ do-benchmarks ] benchmark-ms benchmark-time-file to-file
55     ] with-directory ;
56
57 MAIN: do-all