-! 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
timeout
handle status
-killed ;
+killed
+
+pipe ;
SYMBOL: +closed+
SYMBOL: +stdout+
[ (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
: 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 ;
3bi
wait-for-process ;
+<PRIVATE
+
+: <process-with-pipe> ( desc -- process pipe )
+ >process (pipe) |dispose [ >>pipe ] keep ;
+
+PRIVATE>
+
: <process-reader*> ( desc encoding -- stream process )
[
[
- (pipe) {
- [ |dispose drop ]
- [
- swap >process
- [ swap out>> or ] change-stdout
- run-detached
- ]
+ <process-with-pipe> {
+ [ '[ _ out>> or ] change-stdout ]
+ [ drop run-detached ]
[ out>> dispose ]
[ in>> <input-port> ]
} cleave
: <process-writer*> ( desc encoding -- stream process )
[
[
- (pipe) {
- [ |dispose drop ]
- [
- swap >process
- [ swap in>> or ] change-stdin
- run-detached
- ]
+ <process-with-pipe> {
+ [ '[ _ in>> or ] change-stdin ]
+ [ drop run-detached ]
[ in>> dispose ]
[ out>> <output-port> ]
} cleave
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
] 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