From 336ad674d7c5681127970354699ecd1e4630f4d5 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 12 Feb 2008 04:42:47 -0600 Subject: [PATCH] builder: another refactoring --- extra/builder/builder.factor | 231 +++++++++++++++++++++------------ extra/builder/test/test.factor | 23 +--- 2 files changed, 150 insertions(+), 104 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 7b959787f4..6aa8662095 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,6 +1,6 @@ USING: kernel parser io io.files io.launcher io.sockets hashtables math threads - system continuations namespaces sequences splitting math.parser + arrays system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client combinators bootstrap.image bootstrap.image.download combinators.cleave ; @@ -11,10 +11,10 @@ IN: builder : runtime ( quot -- time ) benchmark nip ; -: log-runtime ( quot file -- ) - >r runtime r> [ . ] with-stream ; +! : log-runtime ( quot file -- ) +! >r runtime r> [ . ] with-stream ; -: log-object ( object file -- ) [ . ] with-stream ; +! : log-object ( object file -- ) [ . ] with-stream ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -48,16 +48,16 @@ SYMBOL: builder-recipients ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run-or-notify ( desc message -- ) - [ [ try-process ] curry ] - [ [ email-string throw ] curry ] - bi* - recover ; +! : run-or-notify ( desc message -- ) +! [ [ try-process ] curry ] +! [ [ email-string throw ] curry ] +! bi* +! recover ; -: run-or-send-file ( desc message file -- ) - >r >r [ try-process ] curry - r> r> [ email-file throw ] 2curry - recover ; +! : run-or-send-file ( desc message file -- ) +! >r >r [ try-process ] curry +! r> r> [ email-file throw ] 2curry +! recover ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -98,7 +98,9 @@ VAR: stamp : git-id ( -- id ) { "git" "show" } [ readln ] with-stream " " split second ; -: record-git-id ( -- ) git-id "../git-id" log-object ; +! : record-git-id ( -- ) git-id "../git-id" log-object ; + +: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ; : make-clean ( -- desc ) { "make" "clean" } ; @@ -110,12 +112,12 @@ VAR: stamp } >hashtable ; -: retrieve-boot-image ( -- ) - [ my-arch download-image ] - [ ] - [ "builder: image download" email-string ] - cleanup - flush ; +! : retrieve-boot-image ( -- ) +! [ my-arch download-image ] +! [ ] +! [ "builder: image download" email-string ] +! cleanup +! flush ; : bootstrap ( -- desc ) `{ @@ -165,27 +167,27 @@ SYMBOL: build-status ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SYMBOL: report +! SYMBOL: report -: >>>report ( quot -- ) report get swap with-stream* ; +! : >>>report ( quot -- ) report get swap with-stream* ; -: file>>>report ( file -- ) [ contents write ] curry >>>report ; +! : file>>>report ( file -- ) [ contents write ] curry >>>report ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: run-or-report ( desc quot -- ) - [ [ try-process ] curry ] - [ [ >>>report throw ] curry ] - bi* - recover ; +! : 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 ; +! : run-or-report-file ( desc quot file -- ) +! [ [ try-process ] curry ] +! [ [ >>>report ] curry ] +! [ [ file>>>report throw ] curry ] +! tri* +! compose +! recover ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -194,80 +196,137 @@ SYMBOL: report ! : bootstrap-minutes ( -- ) ! "../bootstrap-time" contents eval ms>minutes unparse ; -: min-and-sec ( milliseconds -- str ) - 1000 /i 60 /mod swap - `{ ,[ number>string ] " minutes and " ,[ number>string ] " seconds" } - concat ; +! : min-and-sec ( milliseconds -- str ) +! 1000 /i 60 /mod swap +! `{ ,[ number>string ] " minutes and " ,[ number>string ] " seconds" } +! concat ; + +! : boot-time ( -- string ) "../bootstrap-time" eval-file min-and-sec ; +! : load-time ( -- string ) "../load-everything-time" eval-file min-and-sec ; +! : test-time ( -- string ) "../test-all-time" eval-file min-and-sec ; + +: milli-seconds>time ( n -- string ) + 1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ; : eval-file ( file -- obj ) contents eval ; - -: boot-time ( -- string ) "../bootstrap-time" eval-file min-and-sec ; -: load-time ( -- string ) "../load-everything-time" eval-file min-and-sec ; -: test-time ( -- string ) "../test-all-time" eval-file min-and-sec ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! : (build) ( -- ) + +! enter-build-dir + +! "report" report set + +! [ +! "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 + +! record-git-id + +! make-clean run-process drop + +! make-vm +! [ "Builder fatal error: vm compile error" write nl ] +! "../compile-log" +! run-or-report-file + +! [ my-arch download-image ] +! [ [ "Builder fatal error: image download" write nl ] >>>report throw ] +! recover + +! bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file + +! builder-test [ "Builder test error" write nl ] run-or-report + +! [ +! "Bootstrap time: " write boot-time write nl +! "Load all time: " write load-time write nl +! "Test all time: " write test-time write nl +! ] >>>report + +! "../load-everything-vocabs" exists? +! [ +! [ "Did not pass load-everything: " write nl ] >>>report +! "../load-everything-vocabs" file>>>report +! ] +! when + +! "../test-all-vocabs" exists? +! [ +! [ "Did not pass test-all: " write nl ] >>>report +! "../test-all-vocabs" file>>>report +! ] +! when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cat ( file -- ) contents print ; + +: run-or-bail ( desc quot -- ) + [ [ try-process ] curry ] + [ [ throw ] curry ] + bi* + recover ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : (build) ( -- ) enter-build-dir - "report" report set + "report" [ - [ - "Build machine: " write host-name write nl - "Build directory: " write cwd write nl - ] >>>report + "Build machine: " write host-name print + "Build directory: " write cwd print - git-clone [ "Builder fatal error: git clone failed" write nl ] run-or-report + git-clone [ "git clone failed" print ] run-or-bail - "factor" cd + "factor" cd - record-git-id + record-git-id - make-clean run-process drop + make-clean run-process drop - make-vm - [ "Builder fatal error: vm compile error" write nl ] - "../compile-log" - run-or-report-file + make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail - [ my-arch download-image ] - [ [ "Builder fatal error: image download" write nl ] >>>report throw ] - recover + [ my-arch download-image ] [ "Image download error" print throw ] recover - bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file + bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail - builder-test [ "Builder test error" write nl ] run-or-report + [ builder-test try-process ] + [ "Builder test error" print throw ] + recover - [ - "Bootstrap time: " write boot-time write nl - "Load all time: " write load-time write nl - "Test all time: " write test-time write nl - ] >>>report + "Boot time: " write "../boot-time" eval-file milli-seconds>time print + "Load time: " write "../load-time" eval-file milli-seconds>time print + "Test time: " write "../test-time" eval-file milli-seconds>time print - "../load-everything-vocabs" exists? - [ - [ "Did not pass load-everything: " write nl ] >>>report - "../load-everything-vocabs" file>>>report - ] - when + "Did not pass load-everything: " print "../load-everything-vocabs" cat + "Did not pass test-all: " print "../test-all-vocabs" cat - "../test-all-vocabs" exists? - [ - [ "Did not pass test-all: " write nl ] >>>report - "../test-all-vocabs" file>>>report - ] - when ; - -: send-report ( -- ) - report get dispose - "report" "../report" email-file ; + ] with-file-out ; : build ( -- ) - [ (build) ] - [ drop ] - recover - send-report ; + [ (build) ] [ drop ] recover + "report" "../report" email-file ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : send-report ( -- ) +! report get dispose +! "report" "../report" email-file ; + +! : build ( -- ) +! [ (build) ] +! [ drop ] +! recover +! send-report ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index 0a5750a030..f521af1b7c 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -10,28 +10,15 @@ USING: kernel namespaces sequences assocs builder continuations IN: builder.test -: record-bootstrap-time ( -- ) - "../bootstrap-time" - [ bootstrap-time get . ] - with-stream ; - : do-load ( -- ) - [ try-everything keys ] "../load-everything-time" log-runtime - dup empty? - [ drop ] - [ "../load-everything-vocabs" log-object ] - if ; + try-everything keys "../load-everything-vocabs" [ . ] with-file-out ; : do-tests ( -- ) - [ run-all-tests keys ] "../test-all-time" log-runtime - dup empty? - [ drop ] - [ "../test-all-vocabs" log-object ] - if ; + run-all-tests keys "../test-all-vocabs" [ . ] with-file-out ; : do-all ( -- ) - record-bootstrap-time - do-load - do-tests ; + bootstrap-time get "../boot-time" [ . ] with-file-out + [ do-load ] runtime "../load-time" [ . ] with-file-out + [ do-tests ] runtime "../test-time" [ . ] with-file-out ; MAIN: do-all \ No newline at end of file