diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 24d1d8e7b8..40e8a5994b 100755 --- a/basis/io/launcher/launcher.factor +++ b/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 -combinators vocabs.loader init threads continuations math accessors -concurrency.flags destructors environment io io.encodings.ascii -io.backend io.timeouts io.pipes io.pipes.private io.encodings -io.encodings.utf8 io.streams.duplex io.ports debugger prettyprint -summary calendar ; +USING: system kernel namespaces strings hashtables sequences +assocs combinators vocabs.loader init threads continuations math +accessors concurrency.flags destructors environment fry io +io.encodings.ascii io.backend io.timeouts io.pipes +io.pipes.private io.encodings io.encodings.utf8 +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 - dup dup run-process* process-started - dup timeout>> [ over set-timeout ] when* ; + >process [ dup run-process* process-started ] keep ; : 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 ; + ( desc -- process pipe ) + >process (pipe) |dispose [ >>pipe ] keep ; + +PRIVATE> + : ( desc encoding -- stream process ) [ [ - (pipe) { - [ |dispose drop ] - [ - swap >process - [ swap out>> or ] change-stdout - run-detached - ] + { + [ '[ _ out>> or ] change-stdout ] + [ drop run-detached ] [ out>> dispose ] [ in>> ] } cleave @@ -203,13 +207,9 @@ M: object run-pipeline-element : ( desc encoding -- stream process ) [ [ - (pipe) { - [ |dispose drop ] - [ - swap >process - [ swap in>> or ] change-stdin - run-detached - ] + { + [ '[ _ in>> or ] change-stdin ] + [ drop run-detached ] [ in>> dispose ] [ out>> ] } cleave diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor index 4f6615ca5b..46b3d9f8a5 100644 --- a/basis/io/launcher/unix/unix-tests.factor +++ b/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 -tools.test io.launcher arrays io namespaces continuations math -io.encodings.binary io.encodings.ascii accessors kernel -sequences io.encodings.utf8 destructors io.streams.duplex locals -concurrency.promises threads unix.process calendar unix -unix.process debugger.unix io.timeouts io.launcher.unix ; +USING: io.backend.unix io.files io.files.temp io.directories +io.pathnames tools.test io.launcher arrays io namespaces +continuations math io.encodings.binary io.encodings.ascii +accessors kernel sequences io.encodings.utf8 destructors +io.streams.duplex locals concurrency.promises threads +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 +[ + + { "sleep" "10" } >>command + 1 seconds >>timeout + run-process +] [ process-was-killed? ] must-fail-with + +[ + + { "sleep" "10" } >>command + 1 seconds >>timeout + try-process +] [ process-was-killed? ] must-fail-with + +[ + + { "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