suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: a9a08c22b44ecbb469bb73db659837e079a17837
This commit is contained in:
Matthew Flatt 2001-05-15 20:00:39 +00:00
parent 464a1d3fe0
commit 42e0d52ead
1 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/mzlib/process.ss
View File

@ -43,20 +43,22 @@
"input port" "input port"
p)))) p))))
(define (streamify-in cin in) (define (streamify-in cin in get-thread?)
(if (and cin (not (file-stream-port? cin))) (if (and cin (not (file-stream-port? cin)))
(begin (let ([t (thread (lambda ()
(thread (lambda () (dynamic-wind
(copy-port cin in) void
(close-output-port in))) (lambda ()
#f) (with-handlers ([exn:break? void])
(copy-port cin in)))
(lambda () (close-output-port in)))))])
(and get-thread? t))
in)) in))
(define (streamify-out cout out) (define (streamify-out cout out get-thread?)
(if (and cout (not (file-stream-port? cout))) (if (and cout (not (file-stream-port? cout)))
(begin (let ([t (thread (lambda () (copy-port out cout)))])
(thread (lambda () (copy-port out cout))) (and get-thread? t))
#f)
out)) out))
;; Old-style functions: ---------------------------------------- ;; Old-style functions: ----------------------------------------
@ -67,10 +69,10 @@
(if-stream-in cin) (if-stream-in cin)
(if-stream-out cerr) (if-stream-out cerr)
exe args)]) exe args)])
(list (streamify-out cout out) (list (streamify-out cout out #f)
(streamify-in cin in) (streamify-in cin in #f)
(subprocess-pid subp) (subprocess-pid subp)
(streamify-out cerr err) (streamify-out cerr err #f)
(letrec ((control (letrec ((control
(lambda (m) (lambda (m)
(case m (case m
@ -109,10 +111,16 @@
(if-stream-in cin) (if-stream-in cin)
(if-stream-out cerr) (if-stream-out cerr)
exe args)]) exe args)])
(streamify-out cout out) (let ([ot (streamify-out cout out #t)]
(streamify-in cin in) [it (streamify-in cin in #t)]
(streamify-out cerr err) [et (streamify-out cerr err #t)])
(subprocess-wait subp) (subprocess-wait subp)
(break-thread it) ; stop piping output to subprocess
;; wait for other pipes to run dry:
(when (thread? ot)
(thread-wait ot))
(when (thread? et)
(thread-wait et)))
(zero? (subprocess-status subp)))))) (zero? (subprocess-status subp))))))
(define (system str) (define (system str)