extra/mason/child/child.factor

   1 ! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays calendar combinators.short-circuit fry
   4 continuations debugger io.directories io.files io.launcher
   5 io.pathnames io.encodings.ascii kernel make mason.common mason.config
   6 mason.platform mason.report mason.notify namespaces sequences
   7 quotations macros ;
   8 IN: mason.child
   9
  10 : make-cmd ( -- args )
  11     gnu-make platform 2array ;
  12
  13 : make-vm ( -- )
  14     "factor" [
  15         <process>
  16             make-cmd >>command
  17             "../compile-log" >>stdout
  18             +stdout+ >>stderr
  19         try-process
  20     ] with-directory ;
  21
  22 : builds-factor-image ( -- img )
  23     builds/factor boot-image-name append-path ;
  24
  25 : copy-image ( -- )
  26     builds-factor-image "." copy-file-into
  27     builds-factor-image "factor" copy-file-into ;
  28
  29 : factor-vm ( -- string )
  30     target-os get "winnt" = "./factor.com" "./factor" ? ;
  31
  32 : boot-cmd ( -- cmd )
  33     factor-vm
  34     "-i=" boot-image-name append
  35     "-no-user-init"
  36     3array ;
  37
  38 : boot ( -- )
  39     "factor" [
  40         <process>
  41             boot-cmd >>command
  42             +closed+ >>stdin
  43             "../boot-log" >>stdout
  44             +stdout+ >>stderr
  45             1 hours >>timeout
  46         try-process
  47     ] with-directory ;
  48
  49 : test-cmd ( -- cmd ) factor-vm "-run=mason.test" 2array ;
  50
  51 : test ( -- )
  52     "factor" [
  53         <process>
  54             test-cmd >>command
  55             +closed+ >>stdin
  56             "../test-log" >>stdout
  57             +stdout+ >>stderr
  58             4 hours >>timeout
  59         try-process
  60     ] with-directory ;
  61
  62 : recover-else ( try catch else -- )
  63     [ [ '[ @ f t ] ] [ '[ @ f ] ] bi* recover ] dip '[ drop @ ] when ; inline
  64
  65 MACRO: recover-cond ( alist -- )
  66     dup { [ length 1 = ] [ first callable? ] } 1&&
  67     [ first ] [ [ first first2 ] [ rest ] bi '[ _ _ [ _ recover-cond ] recover-else ] ] if ;
  68
  69 : build-child ( -- status )
  70     copy-image
  71     {
  72         { [ notify-make-vm make-vm ] [ compile-failed ] }
  73         { [ notify-boot boot ] [ boot-failed ] }
  74         { [ notify-test test ] [ test-failed ] }
  75         [ success ]
  76     } recover-cond ;