Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing same source/dest in *-copy!.

Browse source
This commit is contained in:
Alex Shinn 2012-11-23 21:01:41 +09:00
parent 4a6af64dc4
commit bf2eaea22b
2 changed files with 43 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/scheme/extras.scm
View file

@ -176,9 +176,13 @@
(let* ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length from)))
(limit (min end (+ start (- (vector-length to) at)))))
(if (<= at start)
(do ((i at (+ i 1)) (j start (+ j 1)))
((>= j limit))
(vector-set! to i (vector-ref from j)))))
(vector-set! to i (vector-ref from j)))
(do ((i (+ at (- end start 1)) (- i 1)) (j (- limit 1) (- j 1)))
((< j start))
(vector-set! to i (vector-ref from j))))))
(define (vector->string vec . o)
(list->string (apply vector->list vec o)))
@ -199,9 +203,13 @@
(cadr o)
(bytevector-length from)))
(limit (min end (+ start (- (bytevector-length to) at)))))
(if (<= at start)
(do ((i at (+ i 1)) (j start (+ j 1)))
((>= j limit))
(bytevector-u8-set! to i (bytevector-u8-ref from j)))))
(bytevector-u8-set! to i (bytevector-u8-ref from j)))
(do ((i (+ at (- end start 1)) (- i 1)) (j (- limit 1) (- j 1)))
((< j start))
(bytevector-u8-set! to i (bytevector-u8-ref from j))))))
(define (bytevector-copy vec . o)
(if (null? o)
@ -223,9 +231,13 @@
(let* ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length from)))
(limit (min end (+ start (- (string-length to) at)))))
(if (<= at start)
(do ((i at (+ i 1)) (j start (+ j 1)))
((>= j limit))
(string-set! to i (string-ref from j)))))
(string-set! to i (string-ref from j)))
(do ((i (+ at (- end start 1)) (- i 1)) (j (- limit 1) (- j 1)))
((< j start))
(string-set! to i (string-ref from j))))))
(define truncate-quotient quotient)
(define truncate-remainder remainder)

22
tests/r7rs-tests.scm
View file

@ -1096,6 +1096,12 @@
(test "xx-xx"
(let ((str (make-string 5 #\x))) (string-copy! str 2 "-----" 2 3) str))
;; same source and dest
(test "aabde"
(let ((str (string-copy "abcde"))) (string-copy! str 1 str 0 2) str))
(test "abcab"
(let ((str (string-copy "abcde"))) (string-copy! str 3 str 0 2) str))
(test-end)
(test-begin "6.8 Vectors")
@ -1169,6 +1175,12 @@
(test #(1 2 c 4 5)
(let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 2 3) vec))
;; same source and dest
(test #(1 1 2 4 5)
(let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 vec 0 2) vec))
(test #(1 2 3 1 2)
(let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 3 vec 0 2) vec))
(test-end)
(test-begin "6.9 Bytevectors")
@ -1219,6 +1231,16 @@
(bytevector-copy! bv 2 #u8(6 7 8 9 10) 2 3)
bv))
;; same source and dest
(test #u8(1 1 2 4 5)
(let ((bv (bytevector 1 2 3 4 5)))
(bytevector-copy! bv 1 bv 0 2)
bv))
(test #u8(1 2 3 1 2)
(let ((bv (bytevector 1 2 3 4 5)))
(bytevector-copy! bv 3 bv 0 2)
bv))
(test #u8() (bytevector-append #u8()))
(test #u8() (bytevector-append #u8() #u8()))
(test #u8(0 1 2) (bytevector-append #u8() #u8(0 1 2)))