From 790c7afeaf1b41d1d9a0635540f2aa5f823de082 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 22 Jan 2010 12:20:37 -0600
Subject: [PATCH] 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

---
 basis/io/launcher/launcher.factor            | 23 ++++++++++----------
 basis/io/launcher/windows/nt/nt-tests.factor | 14 ++++++++++++
 2 files changed, 26 insertions(+), 11 deletions(-)
 mode change 100644 => 100755 basis/io/launcher/launcher.factor
 mode change 100644 => 100755 basis/io/launcher/windows/nt/nt-tests.factor

diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor
old mode 100644
new mode 100755
index cb20f78a33..3999a026c0
--- a/basis/io/launcher/launcher.factor
+++ b/basis/io/launcher/launcher.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 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
@@ -127,16 +127,17 @@ M: process-was-killed error.
     "Launch descriptor:" print nl
     process>> . ;
 
-: wait-for-process ( process -- status )
+: (wait-for-process) ( process -- status )
+    dup handle>>
     [
-        dup handle>>
-        [
-            dup [ processes get at push ] curry
-            "process" suspend drop
-        ] when
-        dup killed>>
-        [ process-was-killed ] [ status>> ] if
-    ] with-timeout ;
+        dup [ processes get at push ] curry
+        "process" suspend drop
+    ] when
+    dup killed>>
+    [ process-was-killed ] [ status>> ] if ;
+
+: wait-for-process ( process -- status )
+    [ (wait-for-process) ] with-timeout ;
 
 : run-detached ( desc -- process )
     >process
@@ -264,7 +265,7 @@ M: output-process-error error.
     +stdout+ >>stderr
     [ +closed+ or ] change-stdin
     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 ;
 
 : notify-exit ( process status -- )
diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor
old mode 100644
new mode 100755
index 85999a89f7..c97c411d2c
--- a/basis/io/launcher/windows/nt/nt-tests.factor
+++ b/basis/io/launcher/windows/nt/nt-tests.factor
@@ -23,6 +23,20 @@ IN: io.launcher.windows.nt.tests
 
 [ 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 )
     vm ".exe" ?tail [ ".com" append ] when ;