factor/extra/mason/test/test.factor

123 lines
3.7 KiB
Factor
Raw Permalink Normal View History

! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
2008-09-16 00:20:33 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs benchmark bootstrap.stage2 calendar
command-line compiler.errors continuations debugger fry generic
help.html help.lint io io.directories io.encodings.utf8 io.files
io.styles kernel locals mason.common memory namespaces
parser.notes sequences sets sorting source-files.errors system
threads tools.errors tools.test tools.time vocabs
vocabs.hierarchy.private vocabs.loader vocabs.refresh words ;
2008-09-16 00:20:33 -04:00
IN: mason.test
: vocab-heading. ( vocab -- )
nl
"==== " write
[ vocab-name ] [ lookup-vocab write-object ] bi ":" print
nl ;
: load-error. ( triple -- )
[ first vocab-heading. ] [ second print-error ] bi ;
: load-failures. ( failures -- ) [ load-error. nl ] each ;
: require-all-no-restarts ( vocabs -- failures )
V{ } clone blacklist [
V{ } clone [
'[
[ require ]
[ swap vocab-name _ set-at ] recover
] each
] keep
] with-variable ;
: load-from-root-no-restarts ( root prefix -- failures )
vocabs-to-load require-all-no-restarts ;
: load-no-restarts ( prefix -- failures )
[ vocab-roots get ] dip
'[ _ load-from-root-no-restarts ] map concat ;
2008-09-16 00:20:33 -04:00
: do-load ( -- )
"" load-no-restarts
[ keys load-all-vocabs-file to-file ]
[ load-all-errors-file utf8 [ load-failures. ] with-file-writer ]
2008-09-16 00:20:33 -04:00
bi ;
2008-11-16 14:46:45 -05:00
GENERIC: word-vocabulary ( word -- vocabulary )
M: word word-vocabulary vocabulary>> ;
M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
2008-11-16 14:46:45 -05:00
2009-04-14 17:37:33 -04:00
:: do-step ( errors summary-file details-file -- )
errors
[ error-type +linkage-error+ eq? ] reject
2015-07-24 02:49:02 -04:00
[ path>> ] map members natural-sort summary-file to-file
2009-04-14 17:37:33 -04:00
errors details-file utf8 [ errors. ] with-file-writer ;
2008-09-16 00:20:33 -04:00
: do-tests ( -- )
forget-tests? on
2009-04-14 17:37:33 -04:00
test-all test-failures get
test-all-vocabs-file
test-all-errors-file
do-step ;
2008-09-16 00:20:33 -04:00
: do-help-lint ( -- )
help-lint-all
! Give the cleanup a chance to run before looking at the errors.
gc 2 seconds sleep
lint-failures get values
2009-04-14 17:37:33 -04:00
help-lint-vocabs-file
help-lint-errors-file
do-step ;
2008-09-16 00:20:33 -04:00
: do-benchmarks ( -- )
run-timing-benchmarks
[ benchmarks-file to-file ] [
[ keys benchmark-error-vocabs-file to-file ]
[ benchmark-error-messages-file utf8 [ benchmark-errors. ] with-file-writer ] bi
] bi* ;
2008-09-16 00:20:33 -04:00
: do-compile-errors ( -- )
compiler-errors get values
compiler-errors-file
compiler-error-messages-file
do-step ;
: outdated-core-vocabs ( -- modified-sources modified-docs any? )
"" to-refresh drop 2dup [ empty? not ] either? ;
: outdated-boot-image. ( modified-sources modified-docs -- )
"Boot image is out of date. Changed vocabs:" print
union [ print ] each
flush ;
: check-boot-image ( -- ? )
outdated-core-vocabs [ outdated-boot-image. t ] [ 2drop f ] if ;
: run-mason-rc ( -- )
t "user-init" [
".factor-mason-rc" rc-path try-user-init
] with-variable ;
: check-user-init-errors ( -- ? )
user-init-errors get-global assoc-empty?
[ f ] [ :user-init-errors t ] if ;
2008-09-16 00:20:33 -04:00
: do-all ( -- )
f parser-quiet? set-global
f restartable-tests? set-global
2008-09-16 00:20:33 -04:00
".." [
run-mason-rc check-user-init-errors [ 1 exit ] when
2008-09-16 00:20:33 -04:00
bootstrap-time get boot-time-file to-file
check-boot-image [ 1 exit ] when
[ do-load ] benchmark load-time-file to-file
[ generate-help ] benchmark html-help-time-file to-file
[ do-tests ] benchmark test-time-file to-file
[ do-help-lint ] benchmark help-lint-time-file to-file
[ do-benchmarks ] benchmark benchmark-time-file to-file
do-compile-errors
2008-09-16 00:20:33 -04:00
] with-directory ;
2009-11-19 05:48:59 -05:00
MAIN: do-all