Merge branch 'master' of git://factorcode.org/git/factor

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 -- ) [ <file-reader> 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" <file-reader> contents eval ms>minutes unparse ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : (build) ( -- )
 
   enter-build-dir
 
   "report" <file-writer> 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
+    "Build machine:   " write host-name write nl
-     [ "Builder fatal error: git clone failed" write nl ]
+    "Build directory: " write cwd write nl
-    with-stream*
+  ] >>>report
-    throw
+
-  ]
+  git-clone [ "Builder fatal error: git clone failed" write nl ] run-or-report
-  recover
 
   "factor" cd
 
@@ -192,82 +215,33 @@ SYMBOL: report
 
   make-clean run-process drop
 
-  [ make-vm try-process ]
+  make-vm
-  [
+    [ "Builder fatal error: vm compile error" write nl ]
-    report get
+    "../compile-log"
-    [
+  run-or-report-file
-      "Builder fatal error: vm compile error" write nl
-      "../compile-log" <file-reader> contents write
-    ]
-    with-stream*
-    throw
-  ]
-  recover
 
   [ my-arch download-image ]
-  [
+    [ [ "Builder fatal error: image download" write nl ] >>>report throw ]
-    report get
-      [ "Builder fatal error: image download" write nl ]
-    with-stream*
-    throw
-  ]
   recover
 
-  [ bootstrap try-process ]
+  bootstrap [ "Bootstrap error" write nl ] "../boot-log" run-or-report-file
-  [
-    report get
-      [
-        "Bootstrap error" write nl
-        "../boot-log" <file-reader> contents write
-      ]
-    with-stream*
-    throw
-  ]
-  recover
 
-  [ builder-test try-process ]
+  builder-test [ "Builder test error" write nl ] run-or-report
-  [
-    report get
-      [
-        "Builder test error" write nl
-        "../load-everything-log" exists?
-          [ "../load-everything-log" <file-reader> contents write nl ]
-        when
-        "../test-all-log" exists?
-          [ "../test-all-log" <file-reader> contents write nl ]
-        when
-      ]
-    with-stream*
-    throw
-  ]
-  recover
 
-  report get
+  [ "Bootstrap time: " write bootstrap-minutes write " minutes" write nl ]
-    [
+  >>>report
-      "Bootstrap time: " write
-      "../bootstrap-time" <file-reader> contents write nl
-    ]
-  with-stream*
 
   "../load-everything-vocabs" exists?
     [
-      report get
+      [ "Did not pass load-everything: " write nl ] >>>report
-        [
+      "../load-everything-vocabs" file>>>report
-          "Did not pass load-everything: " write nl
-          "../load-everything-vocabs" <file-reader> contents write nl
-        ]
-      with-stream*
     ]
   when
 
   "../test-all-vocabs" exists?
     [
-      report get
+      [ "Did not pass test-all: " write nl ] >>>report
-        [
+      "../test-all-vocabs" file>>>report
-          "Did not pass test-all: " write nl
-          "../test-all-vocabs" <file-reader> contents write nl
-        ]
-      with-stream*
     ]
   when ;
 

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 ( -- )
-  [
+  [ try-everything keys ] "../load-everything-time" log-runtime
-    "../load-everything-log" <file-writer>
-      [ try-everything* ]
-    with-stream
-  ] "../load-everything-time" log-runtime
   dup empty?
     [ drop ]
     [ "../load-everything-vocabs" log-object ]
-  if
+  if ;
-  "../load-everything-log" delete-file ;
-
-! : do-tests ( -- )
-!   run-all-tests keys
-!   dup empty?
-!   [ drop ]
-!   [ "../failing-tests" log-object ]
-!   if ;
 
 : do-tests ( -- )
-  [
+  [ run-all-tests keys ] "../test-all-time" log-runtime
-    "../test-all-log" <file-writer>
-      [ run-all-tests keys ]
-    with-stream
-  ] "../test-all-time" log-runtime
   dup empty?
     [ drop ]
     [ "../test-all-vocabs" log-object ]
-  if
+  if ;
-  "../test-all-log" delete-file ;
 
 : do-all ( -- )
   record-bootstrap-time