diff --git a/collects/racket/port.rkt b/collects/racket/port.rkt index 4cd56321a1..64fbf416a2 100644 --- a/collects/racket/port.rkt +++ b/collects/racket/port.rkt @@ -623,7 +623,10 @@ (lambda (n evt target-evt) (port-commit-peeked n evt target-evt p))) location-proc count-lines!-proc - pos))) + pos + (case-lambda + [(mode) (file-stream-buffer-mode p mode)] + [() (file-stream-buffer-mode p)])))) (define filter-read-input-port (lambda (p wrap-read wrap-peek [close? #t]) diff --git a/collects/racket/private/port.rkt b/collects/racket/private/port.rkt index b5990fd058..8f1343c480 100644 --- a/collects/racket/private/port.rkt +++ b/collects/racket/private/port.rkt @@ -56,15 +56,21 @@ (object-name p) p (lambda (s start end nonblock? breakable?) - (let ([v ((if nonblock? - write-bytes-avail* - (if breakable? - write-bytes-avail/enable-break - write-bytes-avail)) - s p start end)]) - (if (and (zero? v) (not (= start end))) - (wrap-evt p (lambda (x) #f)) - v))) + (if (= start end) + (parameterize-break + breakable? + (flush-output p) + 0) + (let ([v (if nonblock? + (write-bytes-avail* s p start end) + (if breakable? + (parameterize-break + #t + (write-bytes s p start end)) + (write-bytes s p start end)))]) + (if (and (zero? v) (not (= start end))) + (wrap-evt p (lambda (x) #f)) + v)))) (lambda () (when close? (close-output-port p))) @@ -87,7 +93,10 @@ (write-special-evt spec p))) location-proc count-lines!-proc - pos))) + pos + (case-lambda + [(mode) (file-stream-buffer-mode p mode)] + [() (file-stream-buffer-mode p)])))) (define (copy-port src dest . dests) (unless (input-port? src) diff --git a/collects/scribblings/reference/port-buffers.scrbl b/collects/scribblings/reference/port-buffers.scrbl index 0d89d95cf9..7af3578bbf 100644 --- a/collects/scribblings/reference/port-buffers.scrbl +++ b/collects/scribblings/reference/port-buffers.scrbl @@ -73,7 +73,7 @@ accordingly. If the port does not support setting the mode, the If @racket[mode] is not provided, the current mode is returned, or @racket[#f] is returned if the mode cannot be determined. If -@racket[file-stream-port] is an input port and @racket[mode] is +@racket[port] is an input port and @racket[mode] is @racket['line], the @exnraise[exn:fail:contract].} @defproc*[([(file-position [port port?]) exact-nonnegative-integer?] diff --git a/collects/scribblings/reference/port-lib.scrbl b/collects/scribblings/reference/port-lib.scrbl index 6b6737142b..e98bb9b04f 100644 --- a/collects/scribblings/reference/port-lib.scrbl +++ b/collects/scribblings/reference/port-lib.scrbl @@ -514,7 +514,7 @@ locations reported by @racket[in]. If @racket[count-lines!] is supplied, it is called when line counting is enabled for the resulting port. The default is @racket[void].} -@defproc[(transplant-output-port [in input-port?] +@defproc[(transplant-output-port [out output-port?] [get-location (or/c (-> (values @@ -529,6 +529,7 @@ is enabled for the resulting port. The default is @racket[void].} Like @racket[transplant-input-port], but for output ports.} + @defproc[(filter-read-input-port [in input-port?] [read-wrap (bytes? (or/c exact-nonnegative-integer? eof-object? diff --git a/collects/tests/racket/portlib.rktl b/collects/tests/racket/portlib.rktl index e56b376210..89d748c2ab 100644 --- a/collects/tests/racket/portlib.rktl +++ b/collects/tests/racket/portlib.rktl @@ -758,6 +758,42 @@ ;; -------------------------------------------------- +(let ([o (open-output-bytes)]) + (port-count-lines! o) + (define o2 (transplant-output-port o + (lambda () + (define-values (l c p) (port-next-location o)) + (values (* 2 l) (* 2 c) (* 2 p))) + 57)) + (test 0 file-position o) + (test 56 file-position o2) + (port-count-lines! o2) + (test-values '(1 0 1) (lambda () (port-next-location o))) + (test-values '(2 0 2) (lambda () (port-next-location o2))) + (write-byte 45 o2) + (test-values '(1 1 2) (lambda () (port-next-location o))) + (test-values '(2 2 4) (lambda () (port-next-location o2))) + (test (file-stream-buffer-mode o) file-stream-buffer-mode o2)) + +(let ([i (open-input-bytes #"x")]) + (port-count-lines! i) + (define i2 (transplant-input-port i + (lambda () + (define-values (l c p) (port-next-location i)) + (values (* 2 l) (* 2 c) (* 2 p))) + 57)) + (test 0 file-position i) + (test 56 file-position i2) + (port-count-lines! i2) + (test-values '(1 0 1) (lambda () (port-next-location i))) + (test-values '(2 0 2) (lambda () (port-next-location i2))) + (read-byte i) + (test-values '(1 1 2) (lambda () (port-next-location i))) + (test-values '(2 2 4) (lambda () (port-next-location i2))) + (test (file-stream-buffer-mode i) file-stream-buffer-mode i2)) + +;; -------------------------------------------------- + (let-values ([(in out) (make-pipe)]) (let ([in2 (dup-input-port in #f)] [out2 (dup-output-port out #f)])