From a21dacf0af286fd12a0d328350c74b86843d4a6a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 23 Apr 2017 17:49:25 -0700 Subject: [PATCH] Add test for bytevector-builder. --- tests/runtime/test-bytevector.scm | 46 +++++++++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm index a15ac631c..bd41fefc3 100644 --- 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))))) + +(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 -- 2.25.1