1 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: assocs combinators.smart debugger fry io.encodings.utf8
4 io.files io.streams.string kernel literals locals mason.common
5 mason.config mason.disk mason.test math namespaces sequences
6 xml.syntax xml.writer ;
9 : git-link ( id -- link )
10 [ "http://github.com/factor/factor/commit/" "" prepend-as ] keep
11 [XML <a href=<->><-></a> XML] ;
13 : common-report ( -- xml )
19 current-git-id get git-link
21 <h1>Build report for <->/<-></h1>
23 <tr><td>Build machine:</td><td><-></td></tr>
24 <tr><td>Disk usage:</td><td><-></td></tr>
25 <tr><td>Build directory:</td><td><-></td></tr>
26 <tr><td>GIT ID:</td><td><-></td></tr>
30 : with-report ( quot: ( -- xml ) -- )
35 [XML <div><-><-></div> XML]
37 ] with-file-writer ; inline
39 : file-tail ( file encoding lines -- seq )
40 [ file-lines ] dip short tail* "\n" join ;
42 :: failed-report ( error file what -- status )
44 error [ error. ] with-string-writer :> error
45 file utf8 400 file-tail :> output
57 : compile-failed ( error -- status )
58 "compile-log" "VM compilation failed" failed-report ;
60 : boot-failed ( error -- status )
61 "boot-log" "Bootstrap failed" failed-report ;
63 : test-failed ( error -- status )
64 "test-log" "Tests failed" failed-report ;
66 : timings-table ( -- xml )
75 dup eval-file nanos>time
76 [XML <tr><td><-></td><td><-></td></tr> XML]
77 ] map [XML <h2>Timings</h2> <table><-></table> XML] ;
79 : error-dump ( heading vocabs-file messages-file -- xml )
80 [ eval-file ] dip over empty? [ 3drop f ] [
82 [ [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ]
83 [ utf8 file-contents ]
85 [XML <h1><-></h1> <-> Details: <pre><-></pre> XML]
88 : benchmarks-table ( assoc -- xml )
91 [XML <tr><td><-></td><td><-></td></tr> XML]
96 <tr><th>Benchmark</th><th>Time (seconds)</th></tr>
101 : successful-report ( -- )
113 compiler-error-messages-file
122 help-lint-vocabs-file
123 help-lint-errors-file
127 benchmark-error-vocabs-file
128 benchmark-error-messages-file
131 benchmarks-file eval-file benchmarks-table
135 : build-clean? ( -- ? )
139 help-lint-vocabs-file
141 benchmark-error-vocabs-file
142 } [ eval-file empty? ] all? ;
144 : success ( -- status )
145 successful-report build-clean? status-clean status-dirty ? ;