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

make-output-port': fix enable-break?' argument to callbacks

Browse Source
This commit is contained in:
Matthew Flatt 2012-08-27 16:39:45 -06:00
parent 310945ee73
commit 704cb4bd01
2 changed files with 39 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/tests/racket/port.rktl
View File

@ -394,14 +394,17 @@
(- end start))))
(lambda (special) always-evt)))
(test (void) display "hello" /dev/null-out)
(set! should-be-breakable? #f)
(test 5 write-bytes-avail #"hello" /dev/null-out)
(set! should-be-breakable? #t)
(test #t write-special 'hello /dev/null-out)
(test 5 sync (write-bytes-avail-evt #"hello" /dev/null-out))
(set! should-be-breakable? #f)
(test 5 write-bytes-avail/enable-break #"hello" /dev/null-out)
(test #t write-special-avail* 'hello /dev/null-out)
(parameterize-break #f
(test 5 write-bytes-avail/enable-break #"hello" /dev/null-out)
(set! should-be-breakable? #f)
(test 5 write-bytes-avail/enable-break #"hello" /dev/null-out)
(test #t write-special-avail* 'hello /dev/null-out)
(test 5 write-bytes-avail #"hello" /dev/null-out))
@ -639,6 +642,34 @@
#f
(try (lambda (x) (read-bytes-avail!/enable-break (make-bytes 10) x)))))
;; Check nonblock? and break? interaction (again):
(let ()
(define status '())
(define p (make-output-port
'p
always-evt
(lambda (bstr start end nonblock? break?)
(set! status (list nonblock? break? (break-enabled)))
(- end start))
void
(lambda (v nonblock? break?)
(set! status (list 'special nonblock? break? (break-enabled)))
#t)))
(write-bytes #"hi" p)
(test '(#f #t #f) values status)
(parameterize-break
#f
(write-bytes #"hi" p))
(test '(#f #f #f) values status)
(write-bytes-avail #"hi" p)
(test '(#t #f #f) values status)
(write-bytes-avail* #"hi" p)
(test '(#t #f #f) values status)
(write-special 'any p)
(test '(special #f #t #f) values status)
(write-special-avail* 'any p)
(test '(special #t #f #f) values status))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that an uncooperative output port doesn't keep breaks
;; disabled too long:

9
src/racket/src/portfun.c
View File

@ -1375,7 +1375,9 @@ user_write_bytes(Scheme_Output_Port *port, const char *str, intptr_t offset, int
int n, re_enable_break;
Scheme_Cont_Frame_Data cframe;
if (enable_break)
if (rarely_block)
re_enable_break = 0;
else if (enable_break)
re_enable_break = 1;
else
re_enable_break = scheme_can_break(scheme_current_thread);
@ -1512,7 +1514,10 @@ user_write_special (Scheme_Output_Port *port, Scheme_Object *v, int nonblock)
int re_enable_break;
Scheme_Cont_Frame_Data cframe;
re_enable_break = scheme_can_break(scheme_current_thread);
if (nonblock)
re_enable_break = 0;
else
re_enable_break = scheme_can_break(scheme_current_thread);
a[0] = v;
a[1] = (nonblock ? scheme_true : scheme_false);