fixed bug where put-bytevector was advancing the port index twice as
far as needed.
This commit is contained in:
parent
c2047badb9
commit
0bd854dedf
|
@ -2233,8 +2233,7 @@
|
||||||
[(fx>= room c)
|
[(fx>= room c)
|
||||||
;; hurray
|
;; hurray
|
||||||
(copy! bv ($port-buffer p) i idx c)
|
(copy! bv ($port-buffer p) i idx c)
|
||||||
(let ([idx (fx+ idx c)])
|
($set-port-index! p (fx+ idx c))]
|
||||||
($set-port-index! p (fx+ idx c)))]
|
|
||||||
[(fx> room 0)
|
[(fx> room 0)
|
||||||
($set-port-index! p (fx+ idx room))
|
($set-port-index! p (fx+ idx room))
|
||||||
(copy! bv ($port-buffer p) i idx room)
|
(copy! bv ($port-buffer p) i idx room)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1719
|
1720
|
||||||
|
|
|
@ -683,6 +683,30 @@
|
||||||
(check (make-custom-textual-input-port "foo" (lambda a 0) #f #f #f))
|
(check (make-custom-textual-input-port "foo" (lambda a 0) #f #f #f))
|
||||||
(check (make-custom-textual-output-port "foo" (lambda a 0) #f #f #f)))
|
(check (make-custom-textual-output-port "foo" (lambda a 0) #f #f #f)))
|
||||||
|
|
||||||
|
|
||||||
|
(define (test-put-bytevector)
|
||||||
|
(call-with-values open-bytevector-output-port
|
||||||
|
(lambda (p e)
|
||||||
|
(do ((i 0 (+ i 1))) ((= i 86))
|
||||||
|
(put-bytevector p '#vu8(0))
|
||||||
|
(put-u8 p 0))
|
||||||
|
(assert (equal? (e) (make-bytevector (* 86 2) 0)))))
|
||||||
|
|
||||||
|
(call-with-values open-bytevector-output-port
|
||||||
|
(lambda (p e)
|
||||||
|
(do ((i 0 (+ i 1))) ((= i 86))
|
||||||
|
(put-u8 p 0)
|
||||||
|
(put-u8 p 0))
|
||||||
|
(assert (equal? (e) (make-bytevector (* 86 2) 0)))))
|
||||||
|
|
||||||
|
(call-with-values open-bytevector-output-port
|
||||||
|
(lambda (p e)
|
||||||
|
(do ((i 0 (+ i 1))) ((= i 86))
|
||||||
|
(put-bytevector p '#vu8(0))
|
||||||
|
(put-bytevector p '#vu8(0)))
|
||||||
|
(assert (equal? (e) (make-bytevector (* 86 2) 0))))))
|
||||||
|
|
||||||
|
|
||||||
(define (run-tests)
|
(define (run-tests)
|
||||||
(test-custom-binary-input-ports)
|
(test-custom-binary-input-ports)
|
||||||
(test-custom-binary-output-ports)
|
(test-custom-binary-output-ports)
|
||||||
|
@ -690,6 +714,10 @@
|
||||||
(test-input-files)
|
(test-input-files)
|
||||||
(test-partial-reads)
|
(test-partial-reads)
|
||||||
(test-input-ports)
|
(test-input-ports)
|
||||||
(test-has-port-position))
|
(test-has-port-position)
|
||||||
|
(test-put-bytevector))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue