io.launcher work in progress

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 }

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
+    <process-stream> contents
+] unit-test
+
+[ "" ] [
+    [
+        "cat"
+        "launcher-test-1" temp-file
+        2array +arguments+ set
+        +inherit+ +stdout+ set
+    ] { } make-assoc <process-stream> 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
+    <process-stream> contents
+] unit-test
+
+[ ] [
+    2 [
+        "launcher-test-1" temp-file <file-appender> [
+            [
+                +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
+    <process-stream> contents
+] unit-test

extra/io/unix/launcher/launcher.factor

@@ -16,14 +16,30 @@ USE: unix
 : assoc>env ( assoc -- env )
     [ "=" swap 3append ] { } assoc>map ;
 
-: (redirect) ( path mode fd -- )
+: redirect-fd ( oldfd fd -- )
-    >r file-mode open dup io-error dup
+    2dup = [ 2drop ] [ dupd dup2 io-error close ] if ;
-    r> dup2 io-error close ;
+
+: 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 not ] [ redirect-inherit ] }
-        { [ pick string? ] [ (redirect) ] }
+        { [ 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 ;