From 351d7948c07c20c24a31ebd30be46b731e655b29 Mon Sep 17 00:00:00 2001 From: "Sunrim KIM (keen)" <3han5chou7@gmail.com> Date: Mon, 7 Jul 2014 04:16:40 +0900 Subject: [PATCH] fix bug of `{bytevector, vector}-copy!` with the same src and dst --- piclib/built-in.scm | 42 +++++++++++++++++++++++++++--------------- 1 file changed, 27 insertions(+), 15 deletions(-) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 3f6eb5a7..c57aef21 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -777,14 +777,20 @@ (apply vector list)) (define (vector-copy! to at from . opts) - (let ((start (if (pair? opts) (car opts) 0)) - (end (if (>= (length opts) 2) - (cadr opts) - (vector-length from)))) - (do ((i at (+ i 1)) - (j start (+ j 1))) - ((= j end)) - (vector-set! to i (vector-ref from j))))) + (let* ((start (if (pair? opts) (car opts) 0)) + (end (if (>= (length opts) 2) + (cadr opts) + (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)) + (j start (+ j 1))) + ((= j end)) + (vector-set! to i (vector-ref from j)))))) (define (vector-copy v . opts) (let ((start (if (pair? opts) (car opts) 0)) @@ -836,14 +842,20 @@ (bytevector-u8-set! v i (car l)))))) (define (bytevector-copy! to at from . opts) - (let ((start (if (pair? opts) (car opts) 0)) - (end (if (>= (length opts) 2) + (let* ((start (if (pair? opts) (car opts) 0)) + (end (if (>= (length opts) 2) (cadr opts) - (bytevector-length from)))) - (do ((i at (+ i 1)) - (j start (+ j 1))) - ((= j end)) - (bytevector-u8-set! to i (bytevector-u8-ref from j))))) + (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)) + (j start (+ j 1))) + ((= j end)) + (bytevector-u8-set! to i (bytevector-u8-ref from j)))))) (define (bytevector-copy v . opts) (let ((start (if (pair? opts) (car opts) 0))