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

fix flush-output when write-out is port indirection

Browse Source
This commit is contained in:
Ryan Culpepper 2018-10-19 18:20:38 +02:00
parent 31d35ebe88
commit d4691fb219
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
racket/src/io/port/flush-output.rkt
View File

@ -10,10 +10,15 @@
(define/who (flush-output [p (current-output-port)])
(check who output-port? p)
(let ([p (->core-output-port p)])
(let ([write-out
(let wo-loop ([p p])
(let ([write-out (core-output-port-write-out (->core-output-port p))])
(cond
[(procedure? write-out) write-out]
[else (wo-loop write-out)])))])
(let loop ()
(define r (atomically
((core-output-port-write-out p) #"" 0 0 #f #f #f)))
(write-out #"" 0 0 #f #f #f)))
(let r-loop ([r r])
(cond
[(eq? r 0) (void)]

4
racket/src/io/port/output-port.rkt
View File

@ -33,7 +33,7 @@
(output-port-via-property? p)))
;; This function should not be called in atomic mode,
;; since it can invoke an artitrary function
;; since it can invoke an arbitrary function
(define (->core-output-port v)
(cond
[(core-output-port? v) (if (impersonator? v)
@ -58,7 +58,7 @@
evt ; An evt that is ready when writing a byte won't block
write-out ; (bstr start-k end-k no-block/buffer? enable-break? copy? -> ...)
write-out ; port or (bstr start-k end-k no-block/buffer? enable-break? copy? -> ...)
;; Called in atomic mode.
;; Doesn't block if `no-block/buffer?` is true.
;; Does enable breaks while blocking if `enable-break?` is true.