! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! 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 ; 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 ; : do-load ( -- ) "" load-no-restarts [ keys load-all-vocabs-file to-file ] [ load-all-errors-file utf8 [ load-failures. ] with-file-writer ] bi ; GENERIC: word-vocabulary ( word -- vocabulary ) M: word word-vocabulary vocabulary>> ; M: method word-vocabulary "method-generic" word-prop word-vocabulary ; :: do-step ( errors summary-file details-file -- ) errors [ error-type +linkage-error+ eq? ] reject [ path>> ] map members natural-sort summary-file to-file errors details-file utf8 [ errors. ] with-file-writer ; : do-tests ( -- ) forget-tests? on test-all test-failures get test-all-vocabs-file test-all-errors-file do-step ; : 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 help-lint-vocabs-file help-lint-errors-file do-step ; : 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* ; : 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 ; : do-all ( -- ) f parser-quiet? set-global f restartable-tests? set-global ".." [ run-mason-rc check-user-init-errors [ 1 exit ] when 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 ] with-directory ; MAIN: do-all