fix race in subprocess test

This commit is contained in:
Matthew Flatt 2011-12-12 12:26:55 -07:00
parent 610efbbe75
commit b99eb54f16

View File

@ -238,23 +238,33 @@
;; strings for everyone ;; strings for everyone
(let ([f (open-input-string (string-append (let ([all-strings
"1" (lambda (stderr-is-stdout?)
(make-string 50000 #\0) (let ([f (open-input-string (string-append
"\n"))] "1"
[f2 (open-output-string)]) (make-string 50000 #\0)
(let ([p (process*/ports f2 f f2 cat "-" "nosuchfile")]) "\n"))]
(test #f car p) [f2 (open-output-string)]
(test #f cadr p) [f3 (if stderr-is-stdout?
(test #f cadddr p) 'stdout
(open-output-string))])
(let ([p (process*/ports f2 f f3 cat "-" "nosuchfile")])
(test #f car p)
(test #f cadr p)
(test #f cadddr p)
((list-ref p 4) 'wait) ((list-ref p 4) 'wait)
(test 'done-error (list-ref p 4) 'status) (test 'done-error (list-ref p 4) 'status)
(let ([p (open-input-string (get-output-string f2))]) (let ([p (open-input-string (get-output-string f2))])
(test (expt 10 50000) read p) (test (expt 10 50000) read p)
(test "" read-line p) (test "" read-line p)
(test '("nosuchfile") regexp-match "nosuchfile" (read-line p))))) (let ([p (if (eq? f3 'stdout)
p
(open-input-string (get-output-string f3)))])
(test '("nosuchfile") regexp-match "nosuchfile" (read-line p)))))))])
(all-strings #t)
(all-strings #f))
;; Check error cases ;; Check error cases