From 90299783d6d6edd49c6df30b17f041c59763660e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 6 May 2008 21:23:18 -0500
Subject: [PATCH] Cleanup io.pipes and fix io.unix.pipes hang

---
 extra/io/launcher/launcher.factor            | 24 +++++------
 extra/io/pipes/pipes.factor                  | 43 +++++++++-----------
 extra/io/unix/launcher/launcher-tests.factor |  2 +-
 extra/io/unix/pipes/pipes-tests.factor       |  1 +
 4 files changed, 32 insertions(+), 38 deletions(-)

diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor
index 286febd589..e9fbdaea62 100755
--- a/extra/io/launcher/launcher.factor
+++ b/extra/io/launcher/launcher.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.backend io.timeouts io.pipes system kernel
-namespaces strings hashtables sequences assocs combinators
-vocabs.loader init threads continuations math io.encodings
-io.streams.duplex io.nonblocking io.streams.duplex accessors
-concurrency.flags destructors ;
+USING: system kernel namespaces strings hashtables sequences 
+assocs combinators vocabs.loader init threads continuations
+math accessors concurrency.flags destructors
+io io.backend io.timeouts io.pipes io.pipes.private io.encodings
+io.streams.duplex io.nonblocking ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -149,15 +149,11 @@ M: process set-timeout set-process-timeout ;
 
 M: process timed-out kill-process ;
 
-M: object pipeline-element-quot
-    [
-        >process
-            swap >>stdout
-            swap >>stdin
-        run-detached
-    ] curry ;
-
-M: process wait-for-pipeline-element wait-for-process ;
+M: object run-pipeline-element
+    [ >process swap >>stdout swap >>stdin run-detached ]
+    [ drop [ [ close-handle ] when* ] bi@ ]
+    3bi
+    wait-for-process ;
 
 : <process-reader*> ( process encoding -- process stream )
     [
diff --git a/extra/io/pipes/pipes.factor b/extra/io/pipes/pipes.factor
index 3e91c5e48e..72d27372f3 100644
--- a/extra/io/pipes/pipes.factor
+++ b/extra/io/pipes/pipes.factor
@@ -23,34 +23,31 @@ HOOK: (pipe) io-backend ( -- pipe )
         r> <encoder-duplex>
     ] with-destructors ;
 
-: with-fds ( input-fd output-fd quot -- )
-    >r >r [ <reader> dup add-always-destructor ] [ input-stream get ] if* r> r> [
-        >r [ <writer> dup add-always-destructor ] [ output-stream get ] if* r>
-        with-output-stream*
-    ] 2curry with-input-stream* ; inline
+<PRIVATE
 
-: <pipes> ( n -- pipes )
-    [ (pipe) dup add-always-destructor ] replicate
-    f f pipe boa [ prefix ] [ suffix ] bi
-    2 <clumps> ;
+: ?reader [ <reader> dup add-always-destructor ] [ input-stream get ] if* ;
+: ?writer [ <writer> dup add-always-destructor ] [ output-stream get ] if* ;
 
-: with-pipe-fds ( seq -- results )
+GENERIC: run-pipeline-element ( input-fd output-fd obj -- quot )
+
+M: callable run-pipeline-element
     [
-        [ length dup zero? [ drop { } ] [ 1- <pipes> ] if ] keep
-        [ >r [ first in>> ] [ second out>> ] bi r> 2curry ] 2map
-        [ call ] parallel-map
+        >r [ ?reader ] [ ?writer ] bi*
+        r> with-streams*
     ] with-destructors ;
 
-GENERIC: pipeline-element-quot ( obj -- quot )
+: <pipes> ( n -- pipes )
+    [
+        [ (pipe) dup add-error-destructor ] replicate
+        T{ pipe } [ prefix ] [ suffix ] bi
+        2 <clumps>
+    ] with-destructors ;
 
-M: callable pipeline-element-quot
-    [ with-fds ] curry ;
-
-GENERIC: wait-for-pipeline-element ( obj -- result )
-
-M: object wait-for-pipeline-element ;
+PRIVATE>
 
 : run-pipeline ( seq -- results )
-    [ pipeline-element-quot ] map
-    with-pipe-fds
-    [ wait-for-pipeline-element ] map ;
+    [ length dup zero? [ drop { } ] [ 1- <pipes> ] if ] keep
+    [
+        >r [ first in>> ] [ second out>> ] bi
+        r> run-pipeline-element
+    ] 2parallel-map ;
diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor
index 97ffc5287f..177c5775dc 100755
--- a/extra/io/unix/launcher/launcher-tests.factor
+++ b/extra/io/unix/launcher/launcher-tests.factor
@@ -99,7 +99,7 @@ accessors kernel sequences io.encodings.utf8 ;
     utf8 file-contents
 ] unit-test
 
-[ ] [ "append-test" temp-file delete-file ] unit-test
+[ "append-test" temp-file delete-file ] ignore-errors
 
 [ "hi\nhi\n" ] [
     2 [
diff --git a/extra/io/unix/pipes/pipes-tests.factor b/extra/io/unix/pipes/pipes-tests.factor
index 8ff9ba61c8..27a490d801 100644
--- a/extra/io/unix/pipes/pipes-tests.factor
+++ b/extra/io/unix/pipes/pipes-tests.factor
@@ -9,6 +9,7 @@ IN: io.unix.pipes.tests
         "ls"
         [
             input-stream [ utf8 <decoder> ] change
+            output-stream [ utf8 <encoder> ] change
             input-stream get lines reverse [ print ] each f
         ]
         "grep x"