mason.child: On Windows, commands launch relative to parent process

binary location instead of cwd. Launch factor.com with full path to get
the correct binary location.
Rename "test" and friends.
db4
Doug Coleman 2015-06-10 15:35:10 -07:00
parent 958d5e61b2
commit 2451fea0a1
1 changed files with 24 additions and 18 deletions

View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar combinators USING: accessors arrays calendar combinators
combinators.short-circuit continuations fry io.directories combinators.short-circuit continuations fry io.directories
io.launcher kernel macros make mason.config mason.notify io.launcher io.pathnames kernel macros make mason.config
mason.platform mason.report namespaces quotations sequences mason.notify mason.platform mason.report namespaces quotations
splitting system ; sequences splitting system ;
IN: mason.child IN: mason.child
: nmake-cmd ( -- args ) : nmake-cmd ( -- args )
@ -16,37 +16,43 @@ IN: mason.child
target-os get name>> target-cpu get name>> (platform) target-os get name>> target-cpu get name>> (platform)
2array ; 2array ;
: make-cmd ( -- args ) : mason-child-make-cmd ( -- args )
{ {
{ [ target-os get windows = ] [ nmake-cmd ] } { [ target-os get windows = ] [ nmake-cmd ] }
[ gnu-make-cmd ] [ gnu-make-cmd ]
} cond ; } cond ;
: make-vm ( -- ) : make-mason-child-vm ( -- )
"factor" [ "factor" [
<process> <process>
make-cmd >>command mason-child-make-cmd >>command
"../compile-log" >>stdout "../compile-log" >>stdout
+stdout+ >>stderr +stdout+ >>stderr
+new-group+ >>group +new-group+ >>group
try-process try-process
] with-directory ; ] with-directory ;
: factor-vm ( -- string ) ! On windows, process launches relative to current process, ignoring
target-os get windows = "./factor.com" "./factor" ? ; ! current-directory variables. Must pass absolute-path of factor.com
: mason-child-vm ( -- string )
target-os get windows = [
"./factor.com" absolute-path
] [
"./factor"
] if ;
: boot-cmd ( -- cmd ) : mason-child-boot-cmd ( -- cmd )
[ [
factor-vm , mason-child-vm ,
"-i=" target-boot-image-name append , "-i=" target-boot-image-name append ,
"-no-user-init" , "-no-user-init" ,
boot-flags get % boot-flags get %
] { } make ; ] { } make ;
: boot ( -- ) : bootstrap-mason-child ( -- )
"factor" [ "factor" [
<process> <process>
boot-cmd >>command mason-child-boot-cmd >>command
+closed+ >>stdin +closed+ >>stdin
"../boot-log" >>stdout "../boot-log" >>stdout
+stdout+ >>stderr +stdout+ >>stderr
@ -55,12 +61,12 @@ IN: mason.child
try-process try-process
] with-directory ; ] with-directory ;
: test-cmd ( -- cmd ) factor-vm "-run=mason.test" 2array ; : mason-child-test-cmd ( -- cmd ) mason-child-vm "-run=mason.test" 2array ;
: test ( -- ) : test-mason-child ( -- )
"factor" [ "factor" [
<process> <process>
test-cmd >>command mason-child-test-cmd >>command
+closed+ >>stdin +closed+ >>stdin
"../test-log" >>stdout "../test-log" >>stdout
+stdout+ >>stderr +stdout+ >>stderr
@ -81,8 +87,8 @@ MACRO: recover-cond ( alist -- )
: build-child ( -- status ) : build-child ( -- status )
{ {
{ [ notify-make-vm make-vm ] [ compile-failed ] } { [ notify-make-vm make-mason-child-vm ] [ compile-failed ] }
{ [ notify-boot boot ] [ boot-failed ] } { [ notify-boot bootstrap-mason-child ] [ boot-failed ] }
{ [ notify-test test ] [ test-failed ] } { [ notify-test test-mason-child ] [ test-failed ] }
[ success ] [ success ]
} recover-cond ; } recover-cond ;