io.launcher: change kill-process to also close the pipe, if there is one, so that try-output-process can timeout even if the process spawns a subprocess which inherits the pipe. This fixes part of #307

basis/io/launcher/launcher.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2008, 2010 Slava Pestov.
+! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel namespaces strings hashtables sequences assocs
+USING: system kernel namespaces strings hashtables sequences
-combinators vocabs.loader init threads continuations math accessors
+assocs combinators vocabs.loader init threads continuations math
-concurrency.flags destructors environment io io.encodings.ascii
+accessors concurrency.flags destructors environment fry io
-io.backend io.timeouts io.pipes io.pipes.private io.encodings
+io.encodings.ascii io.backend io.timeouts io.pipes
-io.encodings.utf8 io.streams.duplex io.ports debugger prettyprint
+io.pipes.private io.encodings io.encodings.utf8
-summary calendar ;
+io.streams.duplex io.ports debugger prettyprint summary calendar ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -25,7 +25,9 @@ priority
 timeout
 
 handle status
-killed ;
+killed
+
+pipe ;
 
 SYMBOL: +closed+
 SYMBOL: +stdout+
@@ -136,9 +138,7 @@ M: process-was-killed error.
     [ (wait-for-process) ] with-timeout ;
 
 : run-detached ( desc -- process )
-    >process
+    >process [ dup run-process* process-started ] keep ;
-    dup dup run-process* process-started
-    dup timeout>> [ over set-timeout ] when* ;
 
 : run-process ( desc -- process )
     run-detached
@@ -162,11 +162,12 @@ HOOK: kill-process* io-backend ( handle -- )
 
 : kill-process ( process -- )
     t >>killed
-    handle>> [ kill-process* ] when* ;
+    [ pipe>> [ dispose ] when* ]
+    [ handle>> [ kill-process* ] when* ] bi ;
 
 M: process timeout timeout>> ;
 
-M: process set-timeout swap >>timeout drop ;
+M: process set-timeout timeout<< ;
 
 M: process cancel-operation kill-process ;
 
@@ -176,16 +177,19 @@ M: object run-pipeline-element
     3bi
     wait-for-process ;
 
+<PRIVATE
+
+: <process-with-pipe> ( desc -- process pipe )
+    >process (pipe) |dispose [ >>pipe ] keep ;
+
+PRIVATE>
+
 : <process-reader*> ( desc encoding -- stream process )
     [
         [
-            (pipe) {
+            <process-with-pipe> {
-                [ |dispose drop ]
+                [ '[ _ out>> or ] change-stdout ]
-                [
+                [ drop run-detached ]
-                    swap >process
-                        [ swap out>> or ] change-stdout
-                    run-detached
-                ]
                 [ out>> dispose ]
                 [ in>> <input-port> ]
             } cleave
@@ -203,13 +207,9 @@ M: object run-pipeline-element
 : <process-writer*> ( desc encoding -- stream process )
     [
         [
-            (pipe) {
+            <process-with-pipe> {
-                [ |dispose drop ]
+                [ '[ _ in>> or ] change-stdin ]
-                [
+                [ drop run-detached ]
-                    swap >process
-                        [ swap in>> or ] change-stdin
-                    run-detached
-                ]
                 [ in>> dispose ]
                 [ out>> <output-port> ]
             } cleave

basis/io/launcher/unix/unix-tests.factor

@@ -1,10 +1,11 @@
 IN: io.launcher.unix.tests
-USING: io.files io.files.temp io.directories io.pathnames
+USING: io.backend.unix io.files io.files.temp io.directories
-tools.test io.launcher arrays io namespaces continuations math
+io.pathnames tools.test io.launcher arrays io namespaces
-io.encodings.binary io.encodings.ascii accessors kernel
+continuations math io.encodings.binary io.encodings.ascii
-sequences io.encodings.utf8 destructors io.streams.duplex locals
+accessors kernel sequences io.encodings.utf8 destructors
-concurrency.promises threads unix.process calendar unix
+io.streams.duplex locals concurrency.promises threads
-unix.process debugger.unix io.timeouts io.launcher.unix ;
+unix.process calendar unix unix.process debugger.unix
+io.timeouts io.launcher.unix ;
 
 [ ] [
     [ "launcher-test-1" temp-file delete-file ] ignore-errors
@@ -124,6 +125,28 @@ unix.process debugger.unix io.timeouts io.launcher.unix ;
     ] with-stream
 ] unit-test
 
+! Test process timeouts
+[
+    <process>
+        { "sleep" "10" } >>command
+        1 seconds >>timeout
+    run-process
+] [ process-was-killed? ] must-fail-with
+
+[
+    <process>
+        { "sleep" "10" } >>command
+        1 seconds >>timeout
+    try-process
+] [ process-was-killed? ] must-fail-with
+
+[
+    <process>
+        { "sleep" "10" } >>command
+        1 seconds >>timeout
+    try-output-process
+] [ io-timeout? ] must-fail-with
+
 ! Killed processes were exiting with code 0 on FreeBSD
 [ f ] [
     [let