builder: fix bug in run-or-bail
parent
35abb02630
commit
3b23cafefd
|
@ -59,6 +59,7 @@ VAR: stamp
|
||||||
: bootstrap ( -- desc )
|
: bootstrap ( -- desc )
|
||||||
<process*>
|
<process*>
|
||||||
bootstrap-cmd >>arguments
|
bootstrap-cmd >>arguments
|
||||||
|
+closed+ >>stdin
|
||||||
"../boot-log" >>stdout
|
"../boot-log" >>stdout
|
||||||
+stdout+ >>stderr
|
+stdout+ >>stderr
|
||||||
20 minutes>ms >>timeout
|
20 minutes>ms >>timeout
|
||||||
|
@ -89,24 +90,8 @@ VAR: stamp
|
||||||
|
|
||||||
[ my-arch download-image ] [ "Image download error" print throw ] recover
|
[ my-arch download-image ] [ "Image download error" print throw ] recover
|
||||||
|
|
||||||
! bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
|
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
|
||||||
|
|
||||||
! bootstrap
|
|
||||||
! <process-stream> dup dispose process-stream-process wait-for-process
|
|
||||||
! zero? not
|
|
||||||
! [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ]
|
|
||||||
! when
|
|
||||||
|
|
||||||
[
|
|
||||||
bootstrap
|
|
||||||
<process-stream> dup dispose process-stream-process wait-for-process
|
|
||||||
zero? not
|
|
||||||
[ "bootstrap non-zero" throw ]
|
|
||||||
when
|
|
||||||
]
|
|
||||||
[ "Bootstrap error" print "../boot-log" cat "bootstrap" throw ]
|
|
||||||
recover
|
|
||||||
|
|
||||||
[ builder-test try-process ]
|
[ builder-test try-process ]
|
||||||
[ "Builder test error" print throw ]
|
[ "Builder test error" print throw ]
|
||||||
recover
|
recover
|
||||||
|
|
|
@ -39,13 +39,14 @@ DEFER: to-strings
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: process* arguments stdout stderr timeout ;
|
TUPLE: process* arguments stdin stdout stderr timeout ;
|
||||||
|
|
||||||
: <process*> process* construct-empty ;
|
: <process*> process* construct-empty ;
|
||||||
|
|
||||||
: >desc ( process* -- desc )
|
: >desc ( process* -- desc )
|
||||||
H{ } clone
|
H{ } clone
|
||||||
over arguments>> [ +arguments+ swap put-at ] when*
|
over arguments>> [ +arguments+ swap put-at ] when*
|
||||||
|
over stdin>> [ +stdin+ swap put-at ] when*
|
||||||
over stdout>> [ +stdout+ swap put-at ] when*
|
over stdout>> [ +stdout+ swap put-at ] when*
|
||||||
over stderr>> [ +stderr+ swap put-at ] when*
|
over stderr>> [ +stderr+ swap put-at ] when*
|
||||||
over timeout>> [ +timeout+ swap put-at ] when*
|
over timeout>> [ +timeout+ swap put-at ] when*
|
||||||
|
@ -73,8 +74,8 @@ TUPLE: process* arguments stdout stderr timeout ;
|
||||||
: cat ( file -- ) <file-reader> contents print ;
|
: cat ( file -- ) <file-reader> contents print ;
|
||||||
|
|
||||||
: run-or-bail ( desc quot -- )
|
: run-or-bail ( desc quot -- )
|
||||||
[ [ try-process ] curry ]
|
[ [ try-process ] curry ]
|
||||||
[ [ throw ] curry ]
|
[ [ throw ] compose ]
|
||||||
bi*
|
bi*
|
||||||
recover ;
|
recover ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue