builder: fix bug in run-or-bail

db4
Eduardo Cavazos 2008-02-14 05:20:38 -06:00
parent 35abb02630
commit 3b23cafefd
2 changed files with 6 additions and 20 deletions

View File

@ -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

View File

@ -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 ;