Merge pull request #162 from KeenS/hotfix

fix bug of `{bytevector, vector}-copy!` with the same src and dst
This commit is contained in:
Yuichi Nishiwaki 2014-07-08 11:25:20 +09:00
commit 4b8c9851b0
1 changed files with 27 additions and 15 deletions

View File

@ -777,14 +777,20 @@
(apply vector list)) (apply vector list))
(define (vector-copy! to at from . opts) (define (vector-copy! to at from . opts)
(let ((start (if (pair? opts) (car opts) 0)) (let* ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2) (end (if (>= (length opts) 2)
(cadr opts) (cadr opts)
(vector-length from)))) (vector-length from)))
(vs #f))
(if (eq? from to)
(begin
(set! vs (make-vector (- end start)))
(vector-copy! vs 0 from start end)
(vector-copy! to at vs))
(do ((i at (+ i 1)) (do ((i at (+ i 1))
(j start (+ j 1))) (j start (+ j 1)))
((= j end)) ((= j end))
(vector-set! to i (vector-ref from j))))) (vector-set! to i (vector-ref from j))))))
(define (vector-copy v . opts) (define (vector-copy v . opts)
(let ((start (if (pair? opts) (car opts) 0)) (let ((start (if (pair? opts) (car opts) 0))
@ -836,14 +842,20 @@
(bytevector-u8-set! v i (car l)))))) (bytevector-u8-set! v i (car l))))))
(define (bytevector-copy! to at from . opts) (define (bytevector-copy! to at from . opts)
(let ((start (if (pair? opts) (car opts) 0)) (let* ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2) (end (if (>= (length opts) 2)
(cadr opts) (cadr opts)
(bytevector-length from)))) (bytevector-length from)))
(vs #f))
(if (eq? from to)
(begin
(set! vs (make-bytevector (- end start)))
(bytevector-copy! vs 0 from start end)
(bytevector-copy! to at vs))
(do ((i at (+ i 1)) (do ((i at (+ i 1))
(j start (+ j 1))) (j start (+ j 1)))
((= j end)) ((= j end))
(bytevector-u8-set! to i (bytevector-u8-ref from j))))) (bytevector-u8-set! to i (bytevector-u8-ref from j))))))
(define (bytevector-copy v . opts) (define (bytevector-copy v . opts)
(let ((start (if (pair? opts) (car opts) 0)) (let ((start (if (pair? opts) (car opts) 0))