racket/system: add some missing synchronization
These changes are intended to address "input port is closed" errors that have been showing up with Racket CS, possibly because its scheduler exposed missing synchronization.
This commit is contained in:
parent
0bffb7035d
commit
40846e3ed9
|
@ -25,17 +25,19 @@
|
|||
|
||||
(define (streamify-in cin in ready-for-break)
|
||||
(if (and cin (not (file-stream-port? cin)))
|
||||
(thread (lambda ()
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(with-handlers ([exn:break? void])
|
||||
(ready-for-break #t)
|
||||
(copy-port cin in)
|
||||
(ready-for-break #f)))
|
||||
(lambda () (close-output-port in)))
|
||||
(ready-for-break #t)))
|
||||
in))
|
||||
(parameterize-break #f
|
||||
(thread (lambda ()
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(with-handlers ([exn:break? void])
|
||||
(parameterize-break #t
|
||||
(ready-for-break #t)
|
||||
(copy-port cin in)
|
||||
(ready-for-break #f))))
|
||||
(lambda () (close-output-port in)))
|
||||
(ready-for-break #t))))
|
||||
in))
|
||||
|
||||
(define (streamify-out cout out)
|
||||
(if (and cout
|
||||
|
|
|
@ -195,7 +195,8 @@
|
|||
(when it
|
||||
;; stop piping output to subprocess
|
||||
(semaphore-wait it-ready)
|
||||
(break-thread it))
|
||||
(break-thread it)
|
||||
(thread-wait it))
|
||||
;; wait for other pipes to run dry:
|
||||
(when (thread? ot) (thread-wait ot))
|
||||
(when (thread? et) (thread-wait et))
|
||||
|
|
Loading…
Reference in New Issue
Block a user