Add test for bytevector-builder.

diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm
index a15ac631c6a37b8f3048b521e09574cc8e2dee3f..bd41fefc34a0cf610926d4e4702efa4ce919003e 100644 (file)
--- a/tests/runtime/test-bytevector.scm
+++ b/tests/runtime/test-bytevector.scm
@@ -406,7 +406,49 @@ USA.
   (lambda ()
     (do ((i 0 (+ i 1)))
        ((not (< i #x100)))
-      (let* ((v (random-bytevector #x100)))
+      (let ((v (random-bytevector #x100)))
         (assert-equal (hexadecimal->bytevector
                       (string-upcase (bytevector->hexadecimal v)))
-                     v)))))
\ No newline at end of file
+                     v)))))
+\f
+(define-test 'bytevector-builder
+  (lambda ()
+    (let* ((end #x100)
+          (bv (random-bytevector end)))
+      (do ((i 0 (fix:+ i 1)))
+         ((not (fix:< i end)))
+       (let ((bytes (bytevector->list bv 0 i)))
+         (assert-equal (build-bytevector bytes) (bytes->bv bytes)))
+       (let ((bvs (make-test-bvs (fix:+ i 1) bv)))
+         (assert-equal (build-bytevector bvs)
+                       (apply bytevector-append bvs))))
+      (let ((bv1 (bytevector-copy bv 64 81)))
+       (assert-equal (build-bytevector (append (bytevector->list bv 0 11)
+                                               (list bv1)
+                                               (bytevector->list bv 11 22)
+                                               (list bv1)))
+                     (bytevector-append (bytevector-copy bv 0 11)
+                                        bv1
+                                        (bytevector-copy bv 11 22)
+                                        bv1))))))
+
+(define (build-bytevector objects)
+  (let ((builder (bytevector-builder)))
+    (for-each builder objects)
+    (builder)))
+
+(define (bytes->bv bytes)
+  (let ((bv (make-bytevector (length bytes))))
+    (do ((bytes bytes (cdr bytes))
+        (i 0 (fix:+ i 1)))
+       ((not (pair? bytes)))
+      (bytevector-u8-set! bv i (car bytes)))
+    bv))
+
+(define (make-test-bvs n bv)
+  (let ((end (bytevector-length bv)))
+    (let loop ((start 0) (bvs '()))
+      (let ((start* (fix:+ start n)))
+       (if (fix:<= start* end)
+           (loop start* (cons (bytevector-copy bv start start*) bvs))
+           (reverse! bvs))))))
\ No newline at end of file