steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.launcher: since process timeouts only kick in when wait-for-process is called, try-output-process would hang indefinitely. Fix this by splitting up wait-for-process and wrapping stream-contents in a with-timeout

db4
Slava Pestov 2010-01-22 12:20:37 -06:00
parent 098ef42202
commit 790c7afeaf
2 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/io/launcher/launcher.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: system kernel namespaces strings hashtables sequences assocs USING: system kernel namespaces strings hashtables sequences assocs
combinators vocabs.loader init threads continuations math accessors combinators vocabs.loader init threads continuations math accessors
@ -127,16 +127,17 @@ M: process-was-killed error.
"Launch descriptor:" print nl "Launch descriptor:" print nl
process>> . ; process>> . ;
: wait-for-process ( process -- status ) : (wait-for-process) ( process -- status )
dup handle>>
[ [
dup handle>> dup [ processes get at push ] curry
[ "process" suspend drop
dup [ processes get at push ] curry ] when
"process" suspend drop dup killed>>
] when [ process-was-killed ] [ status>> ] if ;
dup killed>>
[ process-was-killed ] [ status>> ] if : wait-for-process ( process -- status )
] with-timeout ; [ (wait-for-process) ] with-timeout ;
: run-detached ( desc -- process ) : run-detached ( desc -- process )
>process >process
@ -264,7 +265,7 @@ M: output-process-error error.
+stdout+ >>stderr +stdout+ >>stderr
[ +closed+ or ] change-stdin [ +closed+ or ] change-stdin
utf8 <process-reader*> utf8 <process-reader*>
[ stream-contents ] [ dup wait-for-process ] bi* [ [ stream-contents ] [ dup (wait-for-process) ] bi* ] with-timeout
0 = [ 2drop ] [ output-process-error ] if ; 0 = [ 2drop ] [ output-process-error ] if ;
: notify-exit ( process status -- ) : notify-exit ( process status -- )

14
basis/io/launcher/windows/nt/nt-tests.factor Normal file → Executable file
View File

@ -23,6 +23,20 @@ IN: io.launcher.windows.nt.tests
[ f ] [ "notepad" get process-running? ] unit-test [ f ] [ "notepad" get process-running? ] unit-test
[
<process>
"notepad" >>command
1/2 seconds >>timeout
try-process
] must-fail
[
<process>
"notepad" >>command
1/2 seconds >>timeout
try-output-process
] must-fail
: console-vm ( -- path ) : console-vm ( -- path )
vm ".exe" ?tail [ ".com" append ] when ; vm ".exe" ?tail [ ".com" append ] when ;