fix a `subprocess' test

Merge to v5.3
(cherry picked from commit 8c10dc1579)
This commit is contained in:
Matthew Flatt 2012-07-26 08:47:06 -06:00 committed by Ryan Culpepper
parent 06439ad77f
commit 09a51a9b35

View File

@ -388,7 +388,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([try
(lambda (post-shutdown)
(lambda (post-shutdown wait?)
(let ([c (make-custodian)])
(let ([l (parameterize ([current-custodian c])
(process* self
@ -397,13 +397,16 @@
(test 'running (list-ref l 4) 'status)
(custodian-shutdown-all c)
(sleep 0.1)
(when (and wait?
(eq? post-shutdown 'done-error))
((list-ref l 4) 'wait))
(test post-shutdown (list-ref l 4) 'status)
((list-ref l 4) 'kill))))])
(try 'running)
(try 'running #f)
(parameterize ([current-subprocess-custodian-mode 'kill])
(try 'done-error))
(try 'done-error #f))
(parameterize ([current-subprocess-custodian-mode 'interrupt])
(try (if (eq? 'windows (system-type)) 'running 'done-error))))
(try (if (eq? 'windows (system-type)) 'running 'done-error) #t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; process groups