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