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

25
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,13 +860,16 @@
(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 ([read! ($port-read! p)])
(if (eq? read! all-data-in-buffer)
0
(let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)]) (let ([bv ($port-buffer p)] [i ($port-index p)] [j ($port-size p)])
(let ([c0 (fx- j i)]) (let ([c0 (fx- j i)])
(unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0)) (unless (fx= c0 0) (bytevector-copy! bv i bv 0 c0))
(let ([cookie ($port-cookie p)]) (let ([cookie ($port-cookie p)])
(set-cookie-pos! cookie (+ (cookie-pos cookie) i))) (set-cookie-pos! cookie (+ (cookie-pos cookie) i)))
(let* ([max (fx- (bytevector-length bv) c0)] (let* ([max (fx- (bytevector-length bv) c0)]
[c1 (($port-read! p) bv c0 max)]) [c1 (read! bv c0 max)])
(unless (fixnum? c1) (unless (fixnum? c1)
(die who "invalid return value from read! procedure" c1)) (die who "invalid return value from read! procedure" c1))
(cond (cond
@ -871,7 +880,7 @@
($set-port-size! p (fx+ c1 c0)) ($set-port-size! p (fx+ c1 c0))
c1] c1]
[else [else
(die who "read! returned a value out of range" c1)]))))) (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,6 +1149,8 @@
(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)])
(if (eq? read! all-data-in-buffer)
(eof-object)
(let ([n (read! str 0 (string-length str))]) (let ([n (read! str 0 (string-length str))])
(unless (fixnum? n) (unless (fixnum? n)
(die who "invalid return value from read!" n)) (die who "invalid return value from read!" n))
@ -1153,7 +1164,7 @@
[(fx= n 0) [(fx= n 0)
(eof-object)] (eof-object)]
[else [else
(string-ref str 0)])))) (string-ref str 0)])))))
;;; ;;;
(define (lookahead-char p) (define (lookahead-char p)
(define who 'lookahead-char) (define who 'lookahead-char)
@ -1194,6 +1205,8 @@
(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)])
(if (eq? read! all-data-in-buffer)
(eof-object)
(let ([n (read! str 0 (string-length str))]) (let ([n (read! str 0 (string-length str))])
(unless (fixnum? n) (unless (fixnum? n)
(die who "invalid return value from read!" n)) (die who "invalid return value from read!" n))
@ -1208,7 +1221,7 @@
(eof-object)] (eof-object)]
[else [else
($set-port-index! p 1) ($set-port-index! p 1)
(string-ref str 0)])))) (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