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

support progress evts in result of `make-limited-input-port'

Browse Source 
and also adjust initial position in various port constructions
 to use `file-position' instead of `port-next-location'
This commit is contained in:
Matthew Flatt 2011-06-16 09:18:47 -06:00
parent 83d002a9aa
commit a919062143
2 changed files with 41 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mzlib/port.rkt
View File

@ -529,8 +529,7 @@
(lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
(lambda () (port-next-location p))
(lambda () (port-count-lines! p))
(let-values ([(line col pos) (port-next-location p)])
(or pos (file-position p))))))
(add1 (file-position p)))))
;; Not kill-safe.
(define make-pipe-with-specials
@ -891,9 +890,14 @@
n)))))
(lambda ()
(when close-orig?
(close-input-port port)))))))
(close-input-port port)))
(and (port-provides-progress-evts? port)
(lambda () (port-progress-evt port)))
(and (port-provides-progress-evts? port)
(lambda (n evt target-evt) (port-commit-peeked n evt target-evt port)))
(lambda () (port-next-location port))
(lambda () (port-count-lines! port))
(add1 (file-position port))))))
(define special-filter-input-port
(lambda (p filter [close? #t])
@ -927,8 +931,7 @@
(lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
(lambda () (port-next-location p))
(lambda () (port-count-lines! p))
(let-values ([(l c p) (port-next-location p)])
p))))
(add1 (file-position p)))))
;; ----------------------------------------
@ -1758,8 +1761,7 @@
(let ([new (transplant-output-port
p
(lambda () (port-next-location p))
(let-values ([(line col pos) (port-next-location p)])
(or pos (file-position p)))
(add1 (file-position p))
close?
(lambda () (port-count-lines! p)))])
(port-display-handler new (port-display-handler p))
@ -1771,8 +1773,7 @@
(let ([new (transplant-input-port
p
(lambda () (port-next-location p))
(let-values ([(line col pos) (port-next-location p)])
(or pos (file-position p)))
(add1 (file-position p))
close?
(lambda () (port-count-lines! p)))])
(port-read-handler new (port-read-handler p))

50
collects/tests/racket/portlib.rktl
View File

@ -540,8 +540,13 @@
(test #"12345" peek-bytes 6 0 s2)
(test #"12" read-bytes 2 s2)
(test #"345" read-bytes 6 s2)
(test eof read-bytes 6 s2)
(test #f port-provides-progress-evts? s2))
(test eof read-bytes 6 s2))
(let* ([s (open-input-string "123456789")]
[s2 (make-limited-input-port s 5)])
(test #t port-provides-progress-evts? s2)
(test #"123" peek-bytes 3 0 s2)
(test #t port-commit-peeked 3 (port-progress-evt s2) always-evt s2)
(test #"45" read-bytes 2 s2))
(let-values ([(i o) (make-pipe)])
(let ([s (make-limited-input-port i 5)])
(test #f char-ready? s)
@ -763,29 +768,32 @@
(define (check-all count-lines!)
(define (check-made first-three-bytes char-len
[get-loc #f] [on-consume void]
[init-pos 1])
[init-pos 1]
#:wrap [wrap values])
(define stream (append first-three-bytes (list (char->integer #\4))))
(define p (make-input-port/read-to-peek
'made
(lambda (bstr)
(let ([b (car stream)])
(set! stream (cdr stream))
(if (byte? b)
(begin
(bytes-set! bstr 0 b)
1)
(lambda (srcloc line col pos) b))))
#f
void
get-loc
void
init-pos
#f
#f
on-consume))
(define p (wrap
(make-input-port/read-to-peek
'made
(lambda (bstr)
(let ([b (car stream)])
(set! stream (cdr stream))
(if (byte? b)
(begin
(bytes-set! bstr 0 b)
1)
(lambda (srcloc line col pos) b))))
#f
void
get-loc
void
init-pos
#f
#f
on-consume)))
(count-lines! p)
(check p (sub1 init-pos) first-three-bytes char-len))
(check-made (bytes->list #"123") 3)
(check-made (bytes->list #"123") 3 #:wrap (lambda (in) (make-limited-input-port in 5)))
(check-made (list (char->integer #\1) 'special (char->integer #\3)) 3)
(check-made (bytes->list (string->bytes/utf-8 "1\u3BB")) 2)
(let ()