diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 1783a36928..3e7efcc404 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,5 +1,5 @@ -USING: kernel io io.files io.launcher io.sockets hashtables math threads +USING: kernel parser io io.files io.launcher io.sockets hashtables math threads system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client combinators bootstrap.image bootstrap.image.download @@ -133,7 +133,7 @@ VAR: stamp ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! SYMBOL: build-status +SYMBOL: build-status ! : build ( -- ) @@ -167,24 +167,47 @@ VAR: stamp SYMBOL: report +: >>>report ( quot -- ) report get swap with-stream* ; + +: file>>>report ( file -- ) [ contents write ] curry >>>report ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: run-or-report ( desc quot -- ) + [ [ try-process ] curry ] + [ [ >>>report throw ] curry ] + bi* + recover ; + +: run-or-report-file ( desc quot file -- ) + [ [ try-process ] curry ] + [ [ >>>report ] curry ] + [ [ file>>>report throw ] curry ] + tri* + compose + recover ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ms>minutes ( ms -- minutes ) 1000.0 / 60 / ; + +: bootstrap-minutes ( -- ) + "../bootstrap-time" contents eval ms>minutes unparse ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : (build) ( -- ) enter-build-dir "report" report set - report get [ "Build machine: " write host-name write nl ] with-stream* - - report get [ "Build directory: " write cwd write nl ] with-stream* - - [ git-clone try-process ] [ - report get - [ "Builder fatal error: git clone failed" write nl ] - with-stream* - throw - ] - recover + "Build machine: " write host-name write nl + "Build directory: " write cwd write nl + ] >>>report + + git-clone [ "Builder fatal error: git clone failed" write nl ] run-or-report "factor" cd @@ -192,82 +215,33 @@ SYMBOL: report make-clean run-process drop - [ make-vm try-process ] - [ - report get - [ - "Builder fatal error: vm compile error" write nl - "../compile-log" contents write - ] - with-stream* - throw - ] - recover + make-vm + [ "Builder fatal error: vm compile error" write nl ] + "../compile-log" + run-or-report-file [ my-arch download-image ] - [ - report get - [ "Builder fatal error: image download" write nl ] - with-stream* - throw - ] + [ [ "Builder fatal error: image download" write nl ] >>>report throw ] recover - [ bootstrap try-process ] - [ - report get - [ - "Bootstrap error" write nl - "../boot-log" contents write - ] - with-stream* - throw - ] - recover + bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file - [ builder-test try-process ] - [ - report get - [ - "Builder test error" write nl - "../load-everything-log" exists? - [ "../load-everything-log" contents write nl ] - when - "../test-all-log" exists? - [ "../test-all-log" contents write nl ] - when - ] - with-stream* - throw - ] - recover + builder-test [ "Builder test error" write nl ] run-or-report - report get - [ - "Bootstrap time: " write - "../bootstrap-time" contents write nl - ] - with-stream* + [ "Bootstrap time: " write bootstrap-minutes write " minutes" write nl ] + >>>report "../load-everything-vocabs" exists? [ - report get - [ - "Did not pass load-everything: " write nl - "../load-everything-vocabs" contents write nl - ] - with-stream* + [ "Did not pass load-everything: " write nl ] >>>report + "../load-everything-vocabs" file>>>report ] when "../test-all-vocabs" exists? [ - report get - [ - "Did not pass test-all: " write nl - "../test-all-vocabs" contents write nl - ] - with-stream* + [ "Did not pass test-all: " write nl ] >>>report + "../test-all-vocabs" file>>>report ] when ; diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index 6f87213096..0a5750a030 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -15,45 +15,19 @@ IN: builder.test [ bootstrap-time get . ] with-stream ; -: try-everything* ( -- vocabs ) try-everything [ first vocab-link-name ] map ; - -! : do-load ( -- ) -! [ try-everything* ] "../load-everything-time" log-runtime -! dup empty? -! [ drop ] -! [ "../load-everything-log" log-object ] -! if ; - : do-load ( -- ) - [ - "../load-everything-log" - [ try-everything* ] - with-stream - ] "../load-everything-time" log-runtime + [ try-everything keys ] "../load-everything-time" log-runtime dup empty? [ drop ] [ "../load-everything-vocabs" log-object ] - if - "../load-everything-log" delete-file ; - -! : do-tests ( -- ) -! run-all-tests keys -! dup empty? -! [ drop ] -! [ "../failing-tests" log-object ] -! if ; + if ; : do-tests ( -- ) - [ - "../test-all-log" - [ run-all-tests keys ] - with-stream - ] "../test-all-time" log-runtime + [ run-all-tests keys ] "../test-all-time" log-runtime dup empty? [ drop ] [ "../test-all-vocabs" log-object ] - if - "../test-all-log" delete-file ; + if ; : do-all ( -- ) record-bootstrap-time