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,12 +238,17 @@
;; strings for everyone ;; strings for everyone
(let ([f (open-input-string (string-append (let ([all-strings
(lambda (stderr-is-stdout?)
(let ([f (open-input-string (string-append
"1" "1"
(make-string 50000 #\0) (make-string 50000 #\0)
"\n"))] "\n"))]
[f2 (open-output-string)]) [f2 (open-output-string)]
(let ([p (process*/ports f2 f f2 cat "-" "nosuchfile")]) [f3 (if stderr-is-stdout?
'stdout
(open-output-string))])
(let ([p (process*/ports f2 f f3 cat "-" "nosuchfile")])
(test #f car p) (test #f car p)
(test #f cadr p) (test #f cadr p)
(test #f cadddr p) (test #f cadddr p)
@ -254,7 +259,12 @@
(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