conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixed a bug when reading past eof in bytevector and string input 

ports where the index and size of the buffer get messed up.
This commit is contained in:
Abdulaziz Ghuloum 2009-09-21 09:29:31 +03:00
parent 4c2b13ebe0
commit 574942c1b0
2 changed files with 63 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
scheme/ikarus.io.ss
View File

@ -143,6 +143,12 @@
)) ))
;(define-syntax assert* (identifier-syntax assert)) ;(define-syntax assert* (identifier-syntax assert))
;;; all-data-in-buffer is used in place of the read!
;;; procedure to mark ports whose buffer is all the
;;; data there is.
(define all-data-in-buffer 'all-data-in-buffer)
(define-syntax assert* (syntax-rules () [(_ . x) (void)])) (define-syntax assert* (syntax-rules () [(_ . x) (void)]))
(module UNSAFE (module UNSAFE
@ -512,7 +518,7 @@
0 (bytevector-length bv) bv 0 (bytevector-length bv) bv
maybe-transcoder maybe-transcoder
"*bytevector-input-port*" "*bytevector-input-port*"
(lambda (bv i c) 0) ;;; read! all-data-in-buffer ;;; read!
#f ;;; write! #f ;;; write!
#t ;;; get-position #t ;;; get-position
#t ;;; set-position! #t ;;; set-position!
@ -677,7 +683,7 @@
0 (string-length str) str 0 (string-length str) str
#t ;;; transcoder #t ;;; transcoder
id id
(lambda (str i c) 0) ;;; read! all-data-in-buffer ;;; read!
#f ;;; write! #f ;;; write!
#t ;;; get-position #t ;;; get-position
#t ;;; set-position! #t ;;; set-position!
@ -854,24 +860,27 @@
(define (refill-bv-buffer p who) (define (refill-bv-buffer p who)
(when ($port-closed? p) (die who "port is closed" p)) (when ($port-closed? p) (die who "port is closed" p))
(let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)]) (let ([read! ($port-read! p)])
(let ([c0 (fx- j i)]) (if (eq? read! all-data-in-buffer)
(unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0)) 0
(let ([cookie ($port-cookie p)]) (let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)])
(set-cookie-pos! cookie (+ (cookie-pos cookie) i))) (let ([c0 (fx- j i)])
(let* ([max (fx- (bytevector-length bv) c0)] (unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0))
[c1 (($port-read! p) bv c0 max)]) (let ([cookie ($port-cookie p)])
(unless (fixnum? c1) (set-cookie-pos! cookie (+ (cookie-pos cookie) i)))
(die who "invalid return value from read! procedure" c1)) (let* ([max (fx- (bytevector-length bv) c0)]
(cond [c1 (read! bv c0 max)])
[(fx>= c1 0) (unless (fixnum? c1)
(unless (fx<= c1 max) (die who "invalid return value from read! procedure" c1))
(die who "read! returned a value out of range" c1)) (cond
($set-port-index! p 0) [(fx>= c1 0)
($set-port-size! p (fx+ c1 c0)) (unless (fx<= c1 max)
c1] (die who "read! returned a value out of range" c1))
[else ($set-port-index! p 0)
(die who "read! returned a value out of range" c1)]))))) ($set-port-size! p (fx+ c1 c0))
c1]
[else
(die who "read! returned a value out of range" c1)])))))))
;;; ---------------------------------------------------------- ;;; ----------------------------------------------------------
(module (read-char get-char lookahead-char) (module (read-char get-char lookahead-char)
@ -1140,20 +1149,22 @@
(define (lookahead-char-char-mode p who) (define (lookahead-char-char-mode p who)
(let ([str ($port-buffer p)] (let ([str ($port-buffer p)]
[read! ($port-read! p)]) [read! ($port-read! p)])
(let ([n (read! str 0 (string-length str))]) (if (eq? read! all-data-in-buffer)
(unless (fixnum? n) (eof-object)
(die who "invalid return value from read!" n)) (let ([n (read! str 0 (string-length str))])
(unless (<= 0 n (string-length str)) (unless (fixnum? n)
(die who "return value from read! is out of range" n)) (die who "invalid return value from read!" n))
(let ([idx ($port-index p)] [cookie ($port-cookie p)]) (unless (<= 0 n (string-length str))
(set-cookie-pos! cookie (+ idx (cookie-pos cookie)))) (die who "return value from read! is out of range" n))
($set-port-index! p 0) (let ([idx ($port-index p)] [cookie ($port-cookie p)])
($set-port-size! p n) (set-cookie-pos! cookie (+ idx (cookie-pos cookie))))
(cond ($set-port-index! p 0)
[(fx= n 0) ($set-port-size! p n)
(eof-object)] (cond
[else [(fx= n 0)
(string-ref str 0)])))) (eof-object)]
[else
(string-ref str 0)])))))
;;; ;;;
(define (lookahead-char p) (define (lookahead-char p)
(define who 'lookahead-char) (define who 'lookahead-char)
@ -1194,21 +1205,23 @@
(define (get-char-char-mode p who) (define (get-char-char-mode p who)
(let ([str ($port-buffer p)] (let ([str ($port-buffer p)]
[read! ($port-read! p)]) [read! ($port-read! p)])
(let ([n (read! str 0 (string-length str))]) (if (eq? read! all-data-in-buffer)
(unless (fixnum? n) (eof-object)
(die who "invalid return value from read!" n)) (let ([n (read! str 0 (string-length str))])
(unless (<= 0 n (string-length str)) (unless (fixnum? n)
(die who "return value from read! is out of range" n)) (die who "invalid return value from read!" n))
(let ([idx ($port-index p)] [cookie ($port-cookie p)]) (unless (<= 0 n (string-length str))
(set-cookie-pos! cookie (+ idx (cookie-pos cookie)))) (die who "return value from read! is out of range" n))
($set-port-size! p n) (let ([idx ($port-index p)] [cookie ($port-cookie p)])
(cond (set-cookie-pos! cookie (+ idx (cookie-pos cookie))))
[(fx= n 0) ($set-port-size! p n)
($set-port-index! p 0) (cond
(eof-object)] [(fx= n 0)
[else ($set-port-index! p 0)
($set-port-index! p 1) (eof-object)]
(string-ref str 0)])))) [else
($set-port-index! p 1)
(string-ref str 0)])))))
(define (peek-utf16 p who endianness) (define (peek-utf16 p who endianness)
(define integer->char/invalid (define integer->char/invalid
(lambda (n) (lambda (n)

2
scheme/last-revision
View File

@ -1 +1 @@
1855 1856