! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: benchmark combinators.smart debugger fry io assocs
io.encodings.utf8 io.files io.sockets io.streams.string kernel
locals mason.common mason.config mason.platform math namespaces
prettyprint sequences xml.syntax xml.writer combinators.short-circuit
literals ;
IN: mason.report
: common-report ( -- xml )
target-os get
target-cpu get
host-name
build-dir
"git-id" eval-file
[XML
Build report for <->/<->
Build machine: | <-> |
Build directory: | <-> |
GIT ID: | <-> |
XML] ;
: with-report ( quot -- )
[ "report" utf8 ] dip
'[
common-report
_ call( -- xml )
[XML <-><-> XML]
write-xml
] with-file-writer ; inline
:: failed-report ( error file what -- status )
[
error [ error. ] with-string-writer :> error
file utf8 file-contents 400 short tail* :> output
[XML
<-what->
Build output:
<-output->
Launcher error:
<-error->
XML]
] with-report
status-error ;
: compile-failed ( error -- status )
"compile-log" "VM compilation failed" failed-report ;
: boot-failed ( error -- status )
"boot-log" "Bootstrap failed" failed-report ;
: test-failed ( error -- status )
"test-log" "Tests failed" failed-report ;
: timings-table ( -- xml )
{
$ boot-time-file
$ load-time-file
$ test-time-file
$ help-lint-time-file
$ benchmark-time-file
$ html-help-time-file
} [
dup eval-file milli-seconds>time
[XML <-> | <-> |
XML]
] map [XML Timings
XML] ;
: error-dump ( heading vocabs-file messages-file -- xml )
[ eval-file ] dip over empty? [ 3drop f ] [
[ ]
[ [ [XML <-> XML] ] map [XML XML] ]
[ utf8 file-contents ]
tri*
[XML <->
<-> Details: <->
XML]
] if ;
: benchmarks-table ( assoc -- xml )
[
1000000 /f
[XML <-> | <-> |
XML]
] { } assoc>map [XML Benchmarks
XML] ;
: successful-report ( -- )
[
[
timings-table
"Load failures"
load-everything-vocabs-file
load-everything-errors-file
error-dump
"Compiler errors"
compiler-errors-file
compiler-error-messages-file
error-dump
"Unit test failures"
test-all-vocabs-file
test-all-errors-file
error-dump
"Help lint failures"
help-lint-vocabs-file
help-lint-errors-file
error-dump
"Benchmark errors"
benchmark-error-vocabs-file
benchmark-error-messages-file
error-dump
"Benchmark timings"
benchmarks-file eval-file benchmarks-table
] output>array
] with-report ;
: build-clean? ( -- ? )
{
[ load-everything-vocabs-file eval-file empty? ]
[ test-all-vocabs-file eval-file empty? ]
[ help-lint-vocabs-file eval-file empty? ]
[ compiler-errors-file eval-file empty? ]
[ benchmark-error-vocabs-file eval-file empty? ]
} 0&& ;
: success ( -- status )
successful-report build-clean? status-clean status-dirty ? ;