suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

do a better job of keeping the err/out ports IO in the right order

Browse Source 
... in the case that IO happens during the 'first-opened' method,
e.g., during teachpack running in an empty REPL
This commit is contained in:
Robby Findler 2014-05-20 17:19:09 -05:00
parent 4db7477b0d
commit 6be845ff30
1 changed files with 32 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
pkgs/drracket-pkgs/drracket/drracket/private/rep.rkt
View File

@ -1767,16 +1767,29 @@ TODO
(cond
[(null? ports) (channel-put io-chan io)]
[else
(apply sync
(map (λ (port) (handle-evt
port
(λ (_)
(define byte/special (read-byte-or-special port))
(if (eof-object? byte/special)
(loop (remq port ports) io)
(loop ports (cons (cons port byte/special)
io))))))
ports))]))))
(apply
sync
(for/list ([port (in-list ports)])
(handle-evt
port
(λ (_)
(define-values (the-bytes/specials eof?)
(let b-loop ([bytes '()])
(cond
[(byte-ready? port)
(define b (read-byte-or-special port))
(cond
[(eof-object? b) (values bytes #t)]
[else (b-loop (cons b bytes))])]
[else (values bytes #f)])))
(define new-io
(if (null? bytes)
io
(cons (cons port (reverse the-bytes/specials))
io)))
(if eof?
(loop (remq port ports) new-io)
(loop ports new-io))))))]))))
(run-in-evaluation-thread
(λ ()
@ -1808,13 +1821,15 @@ TODO
;; duplicate it over to the user's ports, now that there is
;; no danger of deadlock
(for ([i (in-list (reverse (channel-get io-chan)))])
(define obj (cdr i))
((if (byte? obj) write-byte write-special)
obj
(if (eq? (car i) sp-err-other-end)
(get-err-port)
(get-out-port))))
(define objs (cdr i))
(define port
(if (equal? (car i) sp-err-other-end)
(get-err-port)
(get-out-port)))
(for ([obj (in-list objs)])
((if (byte? obj) write-byte write-special)
obj
port)))
(flush-output (get-err-port))
(flush-output (get-out-port)))