diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index feb11933fb..aa44088c2d 100755 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -66,6 +66,7 @@ IN: mason.child [ 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&& ; : build-child ( -- ) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index 1aade3bcae..a3ff1a8ff5 100755 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -98,6 +98,8 @@ CONSTANT: benchmark-time-file "benchmark-time" CONSTANT: html-help-time-file "html-help-time" CONSTANT: benchmarks-file "benchmarks" +CONSTANT: benchmark-error-messages-file "benchmark-error-messages" +CONSTANT: benchmark-error-vocabs-file "benchmark-error-vocabs" SYMBOL: status diff --git a/extra/mason/email/email.factor b/extra/mason/email/email.factor index f25f7e5cfa..55edfcb30b 100644 --- a/extra/mason/email/email.factor +++ b/extra/mason/email/email.factor @@ -1,18 +1,18 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces accessors combinators make smtp -debugger prettyprint io io.streams.string io.encodings.utf8 -io.files io.sockets +USING: kernel namespaces accessors combinators make smtp debugger +prettyprint io io.streams.string io.encodings.utf8 io.files io.sockets mason.common mason.platform mason.config ; IN: mason.email : prefix-subject ( str -- str' ) [ "mason on " % platform % ": " % % ] "" make ; -: email-status ( body subject -- ) +: email-status ( body content-type subject -- ) builder-from get >>from builder-recipients get >>to + swap >>content-type swap prefix-subject >>subject swap >>body send-email ; @@ -25,11 +25,11 @@ IN: mason.email } case ; : email-report ( -- ) - "report" utf8 file-contents subject email-status ; + "report" utf8 file-contents "text/html" subject email-status ; : email-error ( error callstack -- ) [ "Fatal error on " write host-name print nl [ error. ] [ callstack. ] bi* - ] with-string-writer "fatal error" + ] with-string-writer "text/plain" "fatal error" email-status ; diff --git a/extra/mason/report/report-tests.factor b/extra/mason/report/report-tests.factor index 7f5c4f1d30..a9e8e2802b 100644 --- a/extra/mason/report/report-tests.factor +++ b/extra/mason/report/report-tests.factor @@ -1,2 +1,4 @@ IN: mason.report.tests USING: mason.report tools.test ; + +{ 0 0 } [ [ ] with-report ] must-infer-as \ No newline at end of file diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 52e1608885..79ec15651d 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -1,74 +1,117 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces debugger fry io io.files io.sockets -io.encodings.utf8 prettyprint benchmark mason.common -mason.platform mason.config sequences ; +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 ; IN: mason.report -: time. ( file -- ) - [ write ": " write ] [ eval-file milli-seconds>time print ] bi ; - -: common-report ( -- ) - "Build machine: " write host-name print - "CPU: " write target-cpu get print - "OS: " write target-os get print - "Build directory: " write build-dir print - "git id: " write "git-id" eval-file print nl ; +: 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 @ ] with-file-writer ; inline + [ "report" utf8 ] dip + '[ + common-report + _ call( -- xml ) + [XML <-><-> XML] + pprint-xml + ] with-file-writer ; inline + +:: failed-report ( error file what -- ) + [ + 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 ; : compile-failed-report ( error -- ) - [ - "VM compile failed:" print nl - "compile-log" cat nl - error. - ] with-report ; + "compile-log" "VM compilation failed" failed-report ; : boot-failed-report ( error -- ) - [ - "Bootstrap failed:" print nl - "boot-log" 100 cat-n nl - error. - ] with-report ; + "boot-log" "Bootstrap failed" failed-report ; : test-failed-report ( error -- ) + "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 utf8 file-contents milli-seconds>time + [XML <-><-> XML] + ] map [XML

Timings

<->
XML] ; + +: fail-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 ) [ - "Tests failed:" print nl - "test-log" 100 cat-n nl - error. - ] with-report ; + 1000000 /f + [XML <-><-> XML] + ] { } assoc>map [XML

    Benchmarks

    <->
    XML] ; : successful-report ( -- ) [ - boot-time-file time. - load-time-file time. - test-time-file time. - help-lint-time-file time. - benchmark-time-file time. - html-help-time-file time. + [ + timings-table - nl + "Load failures" + load-everything-vocabs-file + load-everything-errors-file + fail-dump - load-everything-vocabs-file eval-file [ - "== Did not pass load-everything:" print . - load-everything-errors-file cat - ] unless-empty + "Compiler warnings and errors" + compiler-errors-file + compiler-error-messages-file + fail-dump - compiler-errors-file eval-file [ - "== Vocabularies with compiler errors:" print . - ] unless-empty + "Unit test failures" + test-all-vocabs-file + test-all-errors-file + fail-dump + + "Help lint failures" + help-lint-vocabs-file + help-lint-errors-file + fail-dump - test-all-vocabs-file eval-file [ - "== Did not pass test-all:" print . - test-all-errors-file cat - ] unless-empty - - help-lint-vocabs-file eval-file [ - "== Did not pass help-lint:" print . - help-lint-errors-file cat - ] unless-empty - - "== Benchmarks:" print - benchmarks-file eval-file benchmarks. + "Benchmark errors" + benchmark-error-vocabs-file + benchmark-error-messages-file + fail-dump + + "Benchmark timings" + benchmarks-file eval-file benchmarks-table + ] output>array ] with-report ; \ No newline at end of file diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index 4c212b07fb..11a15328fb 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs benchmark bootstrap.stage2 compiler.errors generic help.html help.lint io.directories @@ -42,7 +42,11 @@ M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ; do-step ; : do-benchmarks ( -- ) - run-benchmarks benchmarks-file to-file ; + run-benchmarks + [ + [ keys benchmark-error-vocabs-file to-file ] + [ benchmark-error-messages-file utf8 [ benchmark-errors. ] with-file-writer ] bi + ] [ benchmarks-file to-file ] bi* ; : benchmark-ms ( quot -- ms ) benchmark 1000 /i ; inline