extra/mason/child/child.factor

   1 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces make debugger sequences io.files
   4 io.launcher arrays accessors calendar continuations
   5 combinators.short-circuit mason.common mason.report
   6 mason.platform mason.config http.client ;
   7 IN: mason.child
   8
   9 : make-cmd ( -- args )
  10     gnu-make platform 2array ;
  11
  12 : download-dlls ( -- )
  13     target-os get "winnt" = [
  14         "http://factorcode.org/dlls/"
  15         target-cpu get "x86.64" = [ "64/" append ] when
  16         [ "freetype6.dll" append ]
  17         [ "zlib1.dll" append ] bi
  18         [ download ] bi@
  19     ] when ;
  20
  21 : make-vm ( -- )
  22     "factor" [
  23         download-dlls
  24
  25         <process>
  26             make-cmd >>command
  27             "../compile-log" >>stdout
  28             +stdout+ >>stderr
  29         try-process
  30     ] with-directory ;
  31
  32 : builds-factor-image ( -- img )
  33     builds/factor boot-image-name append-path ;
  34
  35 : copy-image ( -- )
  36     builds-factor-image "." copy-file-into
  37     builds-factor-image "factor" copy-file-into ;
  38
  39 : boot-cmd ( -- cmd )
  40     "./factor"
  41     "-i=" boot-image-name append
  42     "-no-user-init"
  43     3array ;
  44
  45 : boot ( -- )
  46     "factor" [
  47         <process>
  48             boot-cmd >>command
  49             +closed+ >>stdin
  50             "../boot-log" >>stdout
  51             +stdout+ >>stderr
  52             1 hours >>timeout
  53         try-process
  54     ] with-directory ;
  55
  56 : test-cmd ( -- cmd ) { "./factor" "-run=mason.test" } ;
  57
  58 : test ( -- )
  59     "factor" [
  60         <process>
  61             test-cmd >>command
  62             +closed+ >>stdin
  63             "../test-log" >>stdout
  64             +stdout+ >>stderr
  65             4 hours >>timeout
  66         try-process
  67     ] with-directory ;
  68
  69 : return-with ( obj -- ) return-continuation get continue-with ;
  70
  71 : build-clean? ( -- ? )
  72     {
  73         [ load-everything-vocabs-file eval-file empty? ]
  74         [ test-all-vocabs-file eval-file empty? ]
  75         [ help-lint-vocabs-file eval-file empty? ]
  76         [ compiler-errors-file eval-file empty? ]
  77     } 0&& ;
  78
  79 : build-child ( -- )
  80     [
  81         return-continuation set
  82
  83         copy-image
  84
  85         [ make-vm ] [ compile-failed-report status-error return-with ] recover
  86         [ boot ] [ boot-failed-report status-error return-with ] recover
  87         [ test ] [ test-failed-report status-error return-with ] recover
  88
  89         successful-report
  90
  91         build-clean? status-clean status-dirty ? return-with
  92     ] callcc1
  93     status set ;