<commit_before>! Copyright (C) 2008, 2010 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs benchmark bootstrap.stage2 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 namespaces parser.notes sequences
sets sorting source-files.errors system 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 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
<commit_msg>mason.test: Add option to skip benchmarks to mason.<commit_after>! Copyright (C) 2008, 2010 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs benchmark bootstrap.stage2 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 namespaces parser.notes sequences
sets sorting source-files.errors system 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 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 ;

SYMBOL: skip-mason-benchmarks

: 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
        skip-mason-benchmarks get [ [ do-benchmarks ] benchmark benchmark-time-file to-file ] unless
        do-compile-errors
    ] with-directory ;

MAIN: do-all

{'fraction_non_alphanumeric': 0.13155080213903744, 'fraction_numerical': 0.004545454545454545, 'mean_word_length': 2.354708520179372, 'pattern_counts': {'":': 2, '<': 7, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1978063', 'n_tokens_mistral': 2540, 'n_tokens_neox': 2460, 'n_words': 564}