From 7c7a1f49743bdcccd9a4741e85a09d2b6ed3bf4f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 5 May 2008 03:15:24 -0500 Subject: [PATCH] Debugging pipelines --- extra/io/launcher/launcher.factor | 10 +++++++ extra/io/pipes/pipes-tests.factor | 27 ++++++++++------- extra/io/pipes/pipes.factor | 40 +++++++++++++++++--------- extra/io/unix/backend/backend.factor | 3 +- extra/io/unix/launcher/launcher.factor | 3 +- extra/io/unix/pipes/pipes-tests.factor | 16 +++++++++++ extra/io/unix/pipes/pipes.factor | 5 ++-- extra/unix/bsd/bsd.factor | 2 ++ 8 files changed, 78 insertions(+), 28 deletions(-) create mode 100644 extra/io/unix/pipes/pipes-tests.factor diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index d63b2cd9c0..f3590469b9 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -146,6 +146,16 @@ 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 ; + : ( process encoding -- process stream ) [ >r (pipe) { diff --git a/extra/io/pipes/pipes-tests.factor b/extra/io/pipes/pipes-tests.factor index 37237eea88..812128f792 100644 --- a/extra/io/pipes/pipes-tests.factor +++ b/extra/io/pipes/pipes-tests.factor @@ -1,19 +1,26 @@ -USING: io io.pipes io.streams.string io.encodings.utf8 -continuations tools.test kernel ; +USING: io io.pipes io.streams.string io.encodings.utf8 +io.streams.duplex io.encodings namespaces continuations +tools.test kernel ; IN: io.pipes.tests [ "Hello" ] [ - utf8 "Hello" over stream-write dispose - dup stream-readln swap dispose + utf8 [ + "Hello" print flush + readln + ] with-stream ] unit-test -[ { } ] [ { } utf8 with-pipes ] unit-test -[ { f } ] [ { [ f ] } utf8 with-pipes ] unit-test -[ { "Hello" } ] [ "Hello" [ { [ readln ] } utf8 with-pipes ] with-string-reader ] unit-test +[ { } ] [ { } with-pipeline ] unit-test +[ { f } ] [ { [ f ] } with-pipeline ] unit-test +[ { "Hello" } ] [ + "Hello" [ + { [ input-stream [ utf8 ] change readln ] } with-pipeline + ] with-string-reader +] unit-test [ { f "Hello" } ] [ { - [ "Hello" print flush f ] - [ readln ] - } utf8 with-pipes + [ output-stream [ utf8 ] change "Hello" print flush f ] + [ input-stream [ utf8 ] change readln ] + } with-pipeline ] unit-test diff --git a/extra/io/pipes/pipes.factor b/extra/io/pipes/pipes.factor index 274d933f0d..304aca9812 100644 --- a/extra/io/pipes/pipes.factor +++ b/extra/io/pipes/pipes.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.encodings io.backend io.nonblocking io.streams.duplex io splitting sequences sequences.lib namespaces kernel -destructors math concurrency.combinators locals accessors -arrays continuations ; +destructors math concurrency.combinators accessors +arrays continuations quotations ; IN: io.pipes TUPLE: pipe in out ; @@ -13,23 +13,24 @@ M: pipe dispose ( pipe -- ) HOOK: (pipe) io-backend ( -- pipe ) -:: ( encoding -- input-stream output-stream ) +: ( encoding -- stream ) [ - (pipe) + >r (pipe) [ add-error-destructor ] - [ in>> encoding ] - [ out>> encoding ] + [ in>> ] + [ out>> ] tri + r> ] with-destructors ; -:: with-fds ( input-fd output-fd quot encoding -- ) - input-fd [ encoding dup add-always-destructor ] [ input-stream get ] if* [ - output-fd [ encoding dup add-always-destructor ] [ output-stream get ] if* - quot with-output-stream* - ] with-input-stream* ; inline +: with-fds ( input-fd output-fd quot -- ) + >r >r [ dup add-always-destructor ] [ input-stream get ] if* r> r> [ + >r [ dup add-always-destructor ] [ output-stream get ] if* r> + with-output-stream* + ] 2curry with-input-stream* ; inline : ( n -- pipes ) - [ (pipe) dup add-error-destructor ] replicate + [ (pipe) dup add-always-destructor ] replicate f f pipe boa [ prefix ] [ suffix ] bi 2 ; @@ -40,5 +41,16 @@ HOOK: (pipe) io-backend ( -- pipe ) [ call ] parallel-map ] with-destructors ; -: with-pipes ( seq encoding -- results ) - [ [ with-fds ] 2curry ] curry map with-pipe-fds ; +GENERIC: pipeline-element-quot ( obj -- quot ) + +M: callable pipeline-element-quot + [ with-fds ] curry ; + +GENERIC: wait-for-pipeline-element ( obj -- result ) + +M: object wait-for-pipeline-element ; + +: with-pipeline ( seq -- results ) + [ pipeline-element-quot ] map + with-pipe-fds + [ wait-for-pipeline-element ] map ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index db1a942fc4..08ff526f14 100644 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -78,7 +78,8 @@ M: integer init-handle ( fd -- ) #! since on OS X 10.3, this operation fails from init-io #! when running the Factor.app (presumably because fd 0 and #! 1 are closed). - F_SETFL O_NONBLOCK fcntl drop ; + [ F_SETFL O_NONBLOCK fcntl drop ] + [ F_SETFD FD_CLOEXEC fcntl drop ] bi ; M: integer close-handle ( fd -- ) close ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index b7f01dbdfb..ce66a1dd0c 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -36,7 +36,8 @@ USE: unix : reset-fd ( fd -- ) #! We drop the error code because on *BSD, fcntl of #! /dev/null fails. - F_SETFL 0 fcntl drop ; + [ F_SETFL 0 fcntl drop ] + [ F_SETFD 0 fcntl drop ] bi ; : redirect-inherit ( obj mode fd -- ) 2nip reset-fd ; diff --git a/extra/io/unix/pipes/pipes-tests.factor b/extra/io/unix/pipes/pipes-tests.factor new file mode 100644 index 0000000000..755809de36 --- /dev/null +++ b/extra/io/unix/pipes/pipes-tests.factor @@ -0,0 +1,16 @@ +USING: tools.test io.pipes io.unix.pipes io.encodings.utf8 io +namespaces sequences ; +IN: io.unix.pipes.tests + +[ { 0 0 } ] [ { "ls" "grep x" } with-pipeline ] unit-test + +! [ ] [ +! { +! "ls" +! [ +! input-stream [ utf8 ] change +! input-stream get lines reverse [ print ] each f +! ] +! "grep x" +! } with-pipeline +! ] unit-test diff --git a/extra/io/unix/pipes/pipes.factor b/extra/io/unix/pipes/pipes.factor index a7d4f3b4f7..4fc5acf634 100644 --- a/extra/io/unix/pipes/pipes.factor +++ b/extra/io/unix/pipes/pipes.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system alien.c-types kernel unix math sequences -qualified io.unix.backend ; +qualified io.unix.backend io.nonblocking ; IN: io.unix.pipes QUALIFIED: io.pipes M: unix io.pipes:(pipe) ( -- pair ) 2 "int" dup pipe io-error - 2 c-int-array> first2 io.pipes:pipe boa ; + 2 c-int-array> first2 + [ [ init-handle ] bi@ ] [ io.pipes:pipe boa ] 2bi ; diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor index d80db44348..158dbeaddb 100755 --- a/extra/unix/bsd/bsd.factor +++ b/extra/unix/bsd/bsd.factor @@ -21,7 +21,9 @@ IN: unix : SO_SNDTIMEO HEX: 1005 ; inline : SO_RCVTIMEO HEX: 1006 ; inline +: F_SETFD 2 ; inline : F_SETFL 4 ; inline +: FD_CLOEXEC 1 ; inline : O_NONBLOCK 4 ; inline C-STRUCT: sockaddr-in