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

fix file-descriptor leak in process[*]/ports (PR 10229)

Browse Source 
svn: r14710
This commit is contained in:
Matthew Flatt 2009-05-04 12:22:01 +00:00
parent 8b4844cf5e
commit 83cd3964f4
2 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mzlib/process.ss
View File

@ -71,7 +71,11 @@
(define (streamify-out cout out get-thread?) (define (streamify-out cout out get-thread?)
(if (and cout (not (file-stream-port? cout))) (if (and cout (not (file-stream-port? cout)))
(let ([t (thread (lambda () (copy-port out cout)))]) (let ([t (thread (lambda ()
(dynamic-wind
void
(lambda () (copy-port out cout))
(lambda () (close-input-port out)))))])
(and get-thread? t)) (and get-thread? t))
out)) out))

25
collects/tests/mzscheme/subprocess.ss
View File

@ -48,7 +48,7 @@
;; Supply file for stdout ;; Supply file for stdout
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports f #f #f cat)]) (let ([p (process*/ports f #f #f cat)])
(test #f car p) (test #f car p)
@ -67,7 +67,7 @@
;; Supply file for stdout & stderr, only stdout writes ;; Supply file for stdout & stderr, only stdout writes
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports f #f f cat)]) (let ([p (process*/ports f #f f cat)])
(test #f car p) (test #f car p)
(test #f cadddr p) (test #f cadddr p)
@ -84,7 +84,7 @@
;; Supply file for stderr ;; Supply file for stderr
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports #f #f f cat "nosuchfile")]) (let ([p (process*/ports #f #f f cat "nosuchfile")])
(test #f cadddr p) (test #f cadddr p)
@ -104,7 +104,7 @@
;; Supply file for stdout & stderr, only stderr writes ;; Supply file for stdout & stderr, only stderr writes
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports f #f f cat "nosuchfile")]) (let ([p (process*/ports f #f f cat "nosuchfile")])
(test #f car p) (test #f car p)
(test #f cadddr p) (test #f cadddr p)
@ -121,7 +121,7 @@
;; Supply file for stdout & stderr, both write ;; Supply file for stdout & stderr, both write
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports f #f f cat "-" "nosuchfile")]) (let ([p (process*/ports f #f f cat "-" "nosuchfile")])
(test #f car p) (test #f car p)
(test #f cadddr p) (test #f cadddr p)
@ -141,8 +141,8 @@
;; Supply separate files for stdout & stderr ;; Supply separate files for stdout & stderr
(let ([f (open-output-file tmpfile 'truncate/replace)] (let ([f (open-output-file tmpfile #:exists 'truncate/replace)]
[f2 (open-output-file tmpfile2 'truncate/replace)]) [f2 (open-output-file tmpfile2 #:exists 'truncate/replace)])
(let ([p (process*/ports f #f f2 cat "-" "nosuchfile")]) (let ([p (process*/ports f #f f2 cat "-" "nosuchfile")])
(test #f car p) (test #f car p)
(test #f cadddr p) (test #f cadddr p)
@ -168,7 +168,7 @@
;; Supply file for stdin ;; Supply file for stdin
(let ([f (open-output-file tmpfile 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(fprintf f "Howdy~n") (fprintf f "Howdy~n")
(close-output-port f)) (close-output-port f))
(let ([f (open-input-file tmpfile)]) (let ([f (open-input-file tmpfile)])
@ -187,7 +187,7 @@
;; Files for everyone ;; Files for everyone
(let ([f (open-input-file tmpfile)] (let ([f (open-input-file tmpfile)]
[f2 (open-output-file tmpfile2 'truncate/replace)]) [f2 (open-output-file tmpfile2 #:exists 'truncate/replace)])
(let ([p (process*/ports f2 f f2 cat "-" "nosuchfile")]) (let ([p (process*/ports f2 f f2 cat "-" "nosuchfile")])
(test #f car p) (test #f car p)
(test #f cadr p) (test #f cadr p)
@ -227,7 +227,7 @@
;; Check error cases ;; Check error cases
(let ([f (open-input-file tmpfile)] (let ([f (open-input-file tmpfile)]
[f2 (open-output-file tmpfile2 'truncate/replace)]) [f2 (open-output-file tmpfile2 #:exists 'truncate/replace)])
(let ([test (let ([test
(lambda (o i e) (lambda (o i e)
@ -245,16 +245,17 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-values (r w id e f) (define-values (r w id e f)
(apply values (process* self "-mvq" (apply values (process* self
"-e" "-e"
"(let loop () (unless (eof-object? (eval (read))) (loop)))"))) "(let loop () (unless (eof-object? (eval (read))) (loop)))")))
(define (test-line out in) (define (test-line out in)
(fprintf w "~a~n" in) (fprintf w "~a~n" in)
(flush-output w)
(when out (when out
(test out (lambda (ignored) (read-line r)) in))) (test out (lambda (ignored) (read-line r)) in)))
(test-line "17" "(display 17) (newline)") (test-line "17" "(display 17) (newline) (flush-output)")
(close-input-port r) (close-input-port r)
(close-input-port e) (close-input-port e)