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