diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index b9cdab06f9..c5ea4feeaf 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -36,13 +36,16 @@ SYMBOL: +environment-mode+ SYMBOL: +stdin+ SYMBOL: +stdout+ SYMBOL: +stderr+ -SYMBOL: +closed+ + SYMBOL: +timeout+ SYMBOL: +prepend-environment+ SYMBOL: +replace-environment+ SYMBOL: +append-environment+ +SYMBOL: +closed+ +SYMBOL: +inherit+ + : default-descriptor H{ { +command+ f } diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor new file mode 100644 index 0000000000..fd2fb53cc5 --- /dev/null +++ b/extra/io/unix/launcher/launcher-tests.factor @@ -0,0 +1,80 @@ +IN: io.unix.launcher.tests +USING: io.files tools.test io.launcher arrays io namespaces +continuations math ; + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + "touch" + "launcher-test-1" temp-file + 2array + try-process +] unit-test + +[ t ] [ "launcher-test-1" temp-file exists? ] unit-test + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + [ + "echo Hello" +command+ set + "launcher-test-1" temp-file +stdout+ set + ] { } make-assoc try-process +] unit-test + +[ "Hello\n" ] [ + "cat" + "launcher-test-1" temp-file + 2array + contents +] unit-test + +[ "" ] [ + [ + "cat" + "launcher-test-1" temp-file + 2array +arguments+ set + +inherit+ +stdout+ set + ] { } make-assoc contents +] unit-test + +[ ] [ + [ "launcher-test-1" temp-file delete-file ] ignore-errors +] unit-test + +[ ] [ + [ + "cat" +command+ set + +closed+ +stdin+ set + "launcher-test-1" temp-file +stdout+ set + ] { } make-assoc try-process +] unit-test + +[ "" ] [ + "cat" + "launcher-test-1" temp-file + 2array + contents +] unit-test + +[ ] [ + 2 [ + "launcher-test-1" temp-file [ + [ + +stdout+ set + "echo Hello" +command+ set + ] { } make-assoc try-process + ] with-disposal + ] times +] unit-test + +[ "Hello\nHello\n" ] [ + "cat" + "launcher-test-1" temp-file + 2array + contents +] unit-test diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index a589af0457..58e41a06c0 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -16,14 +16,30 @@ USE: unix : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; -: (redirect) ( path mode fd -- ) - >r file-mode open dup io-error dup - r> dup2 io-error close ; +: redirect-fd ( oldfd fd -- ) + 2dup = [ 2drop ] [ dupd dup2 io-error close ] if ; + +: reset-fd ( fd -- ) F_SETFL 0 fcntl io-error ; + +: redirect-inherit ( obj mode fd -- ) + 2nip reset-fd ; + +: redirect-file ( obj mode fd -- ) + >r file-mode open dup io-error r> redirect-fd ; + +: redirect-closed ( obj mode fd -- ) + >r >r drop "/dev/null" r> r> redirect-file ; + +: redirect-stream ( obj mode fd -- ) + >r drop underlying-handle dup reset-fd r> redirect-fd ; : redirect ( obj mode fd -- ) { - { [ pick not ] [ 2nip F_SETFL 0 fcntl io-error ] } - { [ pick string? ] [ (redirect) ] } + { [ pick not ] [ redirect-inherit ] } + { [ pick string? ] [ redirect-file ] } + { [ pick +closed+ eq? ] [ redirect-closed ] } + { [ pick +inherit+ eq? ] [ redirect-closed ] } + { [ t ] [ redirect-stream ] } } cond ; : ?closed dup +closed+ eq? [ drop "/dev/null" ] when ;