;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; ;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;;;; ;;;; Ludovic Courtès ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-bytevector) :use-module (test-suite lib) :use-module (system base compile) :use-module (rnrs bytevectors) :use-module (srfi srfi-4)) ;;; Some of the tests in here are examples taken from the R6RS Standard ;;; Libraries document. (with-test-prefix/c&e "2.2 General Operations" (pass-if "native-endianness" (not (not (memq (native-endianness) '(big little))))) (pass-if "make-bytevector" (and (bytevector? (make-bytevector 20)) (bytevector? (make-bytevector 20 3)))) (pass-if "bytevector-length" (= (bytevector-length (make-bytevector 20)) 20)) (pass-if "bytevector=?" (and (bytevector=? (make-bytevector 20 7) (make-bytevector 20 7)) (not (bytevector=? (make-bytevector 20 7) (make-bytevector 20 0))))) ;; This failed prior to Guile 2.0.12. ;; See . (pass-if-equal "bytevector-fill! with fill 255" #vu8(255 255 255 255) (let ((bv (make-bytevector 4))) (bytevector-fill! bv 255) bv)) ;; This is a Guile-specific extension. (pass-if-equal "bytevector-fill! with fill -128" #vu8(128 128 128 128) (let ((bv (make-bytevector 4))) (bytevector-fill! bv -128) bv)) (pass-if "bytevector-copy! overlapping" ;; See . (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8)))) (bytevector-copy! b 0 b 3 4) (bytevector->u8-list b) (bytevector=? b #vu8(1 2 3 1 2 3 4 8))))) (with-test-prefix/c&e "2.3 Operations on Bytes and Octets" (pass-if "bytevector-{u8,s8}-ref" (equal? '(-127 129 -1 255) (let ((b1 (make-bytevector 16 -127)) (b2 (make-bytevector 16 255))) (list (bytevector-s8-ref b1 0) (bytevector-u8-ref b1 0) (bytevector-s8-ref b2 0) (bytevector-u8-ref b2 0))))) (pass-if "bytevector-{u8,s8}-set!" (equal? '(-126 130 -10 246) (let ((b (make-bytevector 16 -127))) (bytevector-s8-set! b 0 -126) (bytevector-u8-set! b 1 246) (list (bytevector-s8-ref b 0) (bytevector-u8-ref b 0) (bytevector-s8-ref b 1) (bytevector-u8-ref b 1))))) (pass-if "bytevector->u8-list" (let ((lst '(1 2 3 128 150 255))) (equal? lst (bytevector->u8-list (let ((b (make-bytevector 6))) (for-each (lambda (i v) (bytevector-u8-set! b i v)) (iota 6) lst) b))))) (pass-if "u8-list->bytevector" (let ((lst '(1 2 3 128 150 255))) (equal? lst (bytevector->u8-list (u8-list->bytevector lst))))) (pass-if "bytevector-uint-{ref,set!} [small]" (let ((b (make-bytevector 15))) (bytevector-uint-set! b 0 #x1234 (endianness little) 2) (equal? (bytevector-uint-ref b 0 (endianness big) 2) #x3412))) (pass-if "bytevector-uint-set! [large]" (let ((b (make-bytevector 16))) (bytevector-uint-set! b 0 (- (expt 2 128) 3) (endianness little) 16) (equal? (bytevector->u8-list b) '(253 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255)))) (pass-if "bytevector-uint-{ref,set!} [large]" (let ((b (make-bytevector 120))) (bytevector-uint-set! b 0 (- (expt 2 128) 3) (endianness little) 16) (equal? (bytevector-uint-ref b 0 (endianness little) 16) #xfffffffffffffffffffffffffffffffd))) (pass-if "bytevector-sint-ref [small]" (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) (equal? (bytevector-sint-ref b 0 (endianness big) 2) (bytevector-sint-ref b 1 (endianness little) 2) -16))) (pass-if "bytevector-sint-ref [large]" (let ((b (make-bytevector 50))) (bytevector-uint-set! b 0 (- (expt 2 128) 3) (endianness little) 16) (equal? (bytevector-sint-ref b 0 (endianness little) 16) -3))) (pass-if "bytevector-sint-set! [small]" (let ((b (make-bytevector 3))) (bytevector-sint-set! b 0 -16 (endianness big) 2) (bytevector-sint-set! b 1 -16 (endianness little) 2) (equal? (bytevector->u8-list b) '(#xff #xf0 #xff)))) (pass-if "equal?" (let ((bv1 (u8-list->bytevector (iota 123))) (bv2 (u8-list->bytevector (iota 123)))) (equal? bv1 bv2)))) (with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size" (pass-if "bytevector->sint-list" (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) (equal? (bytevector->sint-list b (endianness little) 2) '(513 -253 513 513)))) (pass-if "bytevector->uint-list" (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1)))) (equal? (bytevector->uint-list b (endianness big) 2) '(513 65283 513 513)))) (pass-if "bytevector->uint-list [empty]" (let ((b (make-bytevector 0))) (null? (bytevector->uint-list b (endianness big) 2)))) (pass-if-exception "bytevector->sint-list [out-of-range]" exception:out-of-range (bytevector->sint-list (make-bytevector 6) (endianness little) -1)) (pass-if-exception "bytevector->uint-list [out-of-range]" exception:out-of-range (bytevector->uint-list (make-bytevector 6) (endianness little) 0)) (pass-if-exception "bytevector->uint-list [word size doesn't divide length]" exception:wrong-type-arg (bytevector->uint-list (make-bytevector 6) (endianness little) 4)) (pass-if "{sint,uint}-list->bytevector" (let ((b1 (sint-list->bytevector '(513 -253 513 513) (endianness little) 2)) (b2 (uint-list->bytevector '(513 65283 513 513) (endianness little) 2)) (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) (and (bytevector=? b1 b2) (bytevector=? b2 b3)))) (pass-if "sint-list->bytevector [limits]" (bytevector=? (sint-list->bytevector '(-32768 32767) (endianness big) 2) (let ((bv (make-bytevector 4))) (bytevector-u8-set! bv 0 #x80) (bytevector-u8-set! bv 1 #x00) (bytevector-u8-set! bv 2 #x7f) (bytevector-u8-set! bv 3 #xff) bv))) (pass-if-exception "sint-list->bytevector [out-of-range]" exception:out-of-range (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big) 2)) (pass-if-exception "uint-list->bytevector [out-of-range]" exception:out-of-range (uint-list->bytevector '(0 -1) (endianness big) 2))) (with-test-prefix/c&e "2.5 Operations on 16-Bit Integers" (pass-if "bytevector-u16-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-u16-ref b 14 (endianness little)) #xfdff) (equal? (bytevector-u16-ref b 14 (endianness big)) #xfffd)))) (pass-if "bytevector-s16-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-s16-ref b 14 (endianness little)) -513) (equal? (bytevector-s16-ref b 14 (endianness big)) -3)))) (pass-if "bytevector-s16-ref [unaligned]" (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) (equal? (bytevector-s16-ref b 1 (endianness little)) -16))) (pass-if "bytevector-{u16,s16}-ref" (let ((b (make-bytevector 2))) (bytevector-u16-set! b 0 44444 (endianness little)) (and (equal? (bytevector-u16-ref b 0 (endianness little)) 44444) (equal? (bytevector-s16-ref b 0 (endianness little)) (- 44444 65536))))) (pass-if "bytevector-native-{u16,s16}-{ref,set!}" (let ((b (make-bytevector 2))) (bytevector-u16-native-set! b 0 44444) (and (equal? (bytevector-u16-native-ref b 0) 44444) (equal? (bytevector-s16-native-ref b 0) (- 44444 65536))))) (pass-if "bytevector-s16-{ref,set!} [unaligned]" (let ((b (make-bytevector 3))) (bytevector-s16-set! b 1 -77 (endianness little)) (equal? (bytevector-s16-ref b 1 (endianness little)) -77)))) (with-test-prefix/c&e "2.6 Operations on 32-bit Integers" (pass-if "bytevector-u32-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-u32-ref b 12 (endianness little)) #xfdffffff) (equal? (bytevector-u32-ref b 12 (endianness big)) #xfffffffd)))) (pass-if "bytevector-s32-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-s32-ref b 12 (endianness little)) -33554433) (equal? (bytevector-s32-ref b 12 (endianness big)) -3)))) (pass-if "bytevector-{u32,s32}-ref" (let ((b (make-bytevector 4))) (bytevector-u32-set! b 0 2222222222 (endianness little)) (and (equal? (bytevector-u32-ref b 0 (endianness little)) 2222222222) (equal? (bytevector-s32-ref b 0 (endianness little)) (- 2222222222 (expt 2 32)))))) (pass-if "bytevector-{u32,s32}-native-{ref,set!}" (let ((b (make-bytevector 4))) (bytevector-u32-native-set! b 0 2222222222) (and (equal? (bytevector-u32-native-ref b 0) 2222222222) (equal? (bytevector-s32-native-ref b 0) (- 2222222222 (expt 2 32))))))) (with-test-prefix/c&e "2.7 Operations on 64-bit Integers" (pass-if "bytevector-u64-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-u64-ref b 8 (endianness little)) #xfdffffffffffffff) (equal? (bytevector-u64-ref b 8 (endianness big)) #xfffffffffffffffd)))) (pass-if "bytevector-s64-ref" (let ((b (u8-list->bytevector '(255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 253)))) (and (equal? (bytevector-s64-ref b 8 (endianness little)) -144115188075855873) (equal? (bytevector-s64-ref b 8 (endianness big)) -3)))) (pass-if "bytevector-{u64,s64}-ref" (let ((b (make-bytevector 8)) (big 9333333333333333333)) (bytevector-u64-set! b 0 big (endianness little)) (and (equal? (bytevector-u64-ref b 0 (endianness little)) big) (equal? (bytevector-s64-ref b 0 (endianness little)) (- big (expt 2 64)))))) (pass-if "bytevector-{u64,s64}-native-{ref,set!}" (let ((b (make-bytevector 8)) (big 9333333333333333333)) (bytevector-u64-native-set! b 0 big) (and (equal? (bytevector-u64-native-ref b 0) big) (equal? (bytevector-s64-native-ref b 0) (- big (expt 2 64)))))) (pass-if "ref/set! with zero" (let ((b (make-bytevector 8))) (bytevector-s64-set! b 0 -1 (endianness big)) (bytevector-u64-set! b 0 0 (endianness big)) (= 0 (bytevector-u64-ref b 0 (endianness big)))))) (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations" (pass-if "single, little endian" ;; http://bugs.gnu.org/11310 (let ((b (make-bytevector 4))) (bytevector-ieee-single-set! b 0 1.0 (endianness little)) (equal? #vu8(0 0 128 63) b))) (pass-if "single, big endian" ;; http://bugs.gnu.org/11310 (let ((b (make-bytevector 4))) (bytevector-ieee-single-set! b 0 1.0 (endianness big)) (equal? #vu8(63 128 0 0) b))) (pass-if "bytevector-ieee-single-native-{ref,set!}" (let ((b (make-bytevector 4)) (number 3.00)) (bytevector-ieee-single-native-set! b 0 number) (equal? (bytevector-ieee-single-native-ref b 0) number))) (pass-if "bytevector-ieee-single-{ref,set!}" (let ((b (make-bytevector 8)) (number 3.14)) (bytevector-ieee-single-set! b 0 number (endianness little)) (bytevector-ieee-single-set! b 4 number (endianness big)) (equal? (bytevector-ieee-single-ref b 0 (endianness little)) (bytevector-ieee-single-ref b 4 (endianness big))))) (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]" (let ((b (make-bytevector 9)) (number 3.14)) (bytevector-ieee-single-set! b 1 number (endianness little)) (bytevector-ieee-single-set! b 5 number (endianness big)) (equal? (bytevector-ieee-single-ref b 1 (endianness little)) (bytevector-ieee-single-ref b 5 (endianness big))))) (pass-if "double, little endian" ;; http://bugs.gnu.org/11310 (let ((b (make-bytevector 8))) (bytevector-ieee-double-set! b 0 1.0 (endianness little)) (equal? #vu8(0 0 0 0 0 0 240 63) b))) (pass-if "double, big endian" ;; http://bugs.gnu.org/11310 (let ((b (make-bytevector 8))) (bytevector-ieee-double-set! b 0 1.0 (endianness big)) (equal? #vu8(63 240 0 0 0 0 0 0) b))) (pass-if "bytevector-ieee-double-native-{ref,set!}" (let ((b (make-bytevector 8)) (number 3.14)) (bytevector-ieee-double-native-set! b 0 number) (equal? (bytevector-ieee-double-native-ref b 0) number))) (pass-if "bytevector-ieee-double-{ref,set!}" (let ((b (make-bytevector 16)) (number 3.14)) (bytevector-ieee-double-set! b 0 number (endianness little)) (bytevector-ieee-double-set! b 8 number (endianness big)) (equal? (bytevector-ieee-double-ref b 0 (endianness little)) (bytevector-ieee-double-ref b 8 (endianness big)))))) ;; Default to the C locale for the following tests. (when (defined? 'setlocale) (setlocale LC_ALL "C")) (with-test-prefix "2.9 Operations on Strings" (pass-if "string->utf8" (let* ((str "hello, world") (utf8 (string->utf8 str))) (and (bytevector? utf8) (= (bytevector-length utf8) (string-length str)) (equal? (string->list str) (map integer->char (bytevector->u8-list utf8)))))) (pass-if "string->utf8 [latin-1]" (let* ((str "hé, ça va bien ?") (utf8 (string->utf8 str))) (and (bytevector? utf8) (= (bytevector-length utf8) (+ 2 (string-length str)))))) (pass-if "string->utf16" (let* ((str "hello, world") (utf16 (string->utf16 str))) (and (bytevector? utf16) (= (bytevector-length utf16) (* 2 (string-length str))) (equal? (string->list str) (map integer->char (bytevector->uint-list utf16 (endianness big) 2)))))) (pass-if "string->utf16 [little]" (let* ((str "hello, world") (utf16 (string->utf16 str (endianness little)))) (and (bytevector? utf16) (= (bytevector-length utf16) (* 2 (string-length str))) (equal? (string->list str) (map integer->char (bytevector->uint-list utf16 (endianness little) 2)))))) (pass-if "string->utf32" (let* ((str "hello, world") (utf32 (string->utf32 str))) (and (bytevector? utf32) (= (bytevector-length utf32) (* 4 (string-length str))) (equal? (string->list str) (map integer->char (bytevector->uint-list utf32 (endianness big) 4)))))) (pass-if "string->utf32 [Greek]" (let* ((str "Ἄνεμοι") (utf32 (string->utf32 str))) (and (bytevector? utf32) (equal? (bytevector->uint-list utf32 (endianness big) 4) '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9))))) (pass-if "string->utf32 [little]" (let* ((str "hello, world") (utf32 (string->utf32 str (endianness little)))) (and (bytevector? utf32) (= (bytevector-length utf32) (* 4 (string-length str))) (equal? (string->list str) (map integer->char (bytevector->uint-list utf32 (endianness little) 4)))))) (pass-if "utf8->string" (let* ((utf8 (u8-list->bytevector (map char->integer (string->list "hello, world")))) (str (utf8->string utf8))) (and (string? str) (= (string-length str) (bytevector-length utf8)) (equal? (string->list str) (map integer->char (bytevector->u8-list utf8)))))) (pass-if "utf8->string [latin-1]" (let* ((utf8 (string->utf8 "hé, ça va bien ?")) (str (utf8->string utf8))) (and (string? str) (= (string-length str) (- (bytevector-length utf8) 2))))) (pass-if "utf16->string" (let* ((utf16 (uint-list->bytevector (map char->integer (string->list "hello, world")) (endianness big) 2)) (str (utf16->string utf16))) (and (string? str) (= (* 2 (string-length str)) (bytevector-length utf16)) (equal? (string->list str) (map integer->char (bytevector->uint-list utf16 (endianness big) 2)))))) (pass-if "utf16->string [little]" (let* ((utf16 (uint-list->bytevector (map char->integer (string->list "hello, world")) (endianness little) 2)) (str (utf16->string utf16 (endianness little)))) (and (string? str) (= (* 2 (string-length str)) (bytevector-length utf16)) (equal? (string->list str) (map integer->char (bytevector->uint-list utf16 (endianness little) 2)))))) (pass-if "utf32->string" (let* ((utf32 (uint-list->bytevector (map char->integer (string->list "hello, world")) (endianness big) 4)) (str (utf32->string utf32))) (and (string? str) (= (* 4 (string-length str)) (bytevector-length utf32)) (equal? (string->list str) (map integer->char (bytevector->uint-list utf32 (endianness big) 4)))))) (pass-if "utf32->string [little]" (let* ((utf32 (uint-list->bytevector (map char->integer (string->list "hello, world")) (endianness little) 4)) (str (utf32->string utf32 (endianness little)))) (and (string? str) (= (* 4 (string-length str)) (bytevector-length utf32)) (equal? (string->list str) (map integer->char (bytevector->uint-list utf32 (endianness little) 4))))))) (with-test-prefix "Datum Syntax" (pass-if "empty" (equal? (with-input-from-string "#vu8()" read) (make-bytevector 0))) (pass-if "simple" (equal? (with-input-from-string "#vu8(1 2 3 4 5)" read) (u8-list->bytevector '(1 2 3 4 5)))) (pass-if ">127" (equal? (with-input-from-string "#vu8(0 255 127 128)" read) (u8-list->bytevector '(0 255 127 128)))) (pass-if "self-evaluating?" (self-evaluating? (make-bytevector 1))) (pass-if "self-evaluating" (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read) (current-module)) (u8-list->bytevector '(1 2 3 4 5)))) (pass-if "quoted" (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read) (current-module)) (u8-list->bytevector '(1 2 3 4 5)))) (pass-if "literal simple" (equal? #vu8(1 2 3 4 5) (u8-list->bytevector '(1 2 3 4 5)))) (pass-if "literal >127" (equal? #vu8(0 255 127 128) (u8-list->bytevector '(0 255 127 128)))) (pass-if "literal quoted" (equal? '#vu8(1 2 3 4 5) (u8-list->bytevector '(1 2 3 4 5)))) (pass-if-exception "incorrect prefix" exception:read-error (with-input-from-string "#vi8(1 2 3)" read)) (pass-if-exception "extraneous space" exception:read-error (with-input-from-string "#vu8 (1 2 3)" read)) (pass-if-exception "negative integers" exception:wrong-type-arg (with-input-from-string "#vu8(-1 -2 -3)" read)) (pass-if-exception "out-of-range integers" exception:wrong-type-arg (with-input-from-string "#vu8(0 256)" read))) (with-test-prefix "Arrays" (pass-if "array?" (array? #vu8(1 2 3))) (pass-if "array-length" (equal? (iota 16) (map array-length (map make-bytevector (iota 16))))) (pass-if "array-ref" (let ((bv #vu8(255 127))) (and (= 255 (array-ref bv 0)) (= 127 (array-ref bv 1))))) (pass-if-exception "array-ref [index out-of-range]" exception:out-of-range (let ((bv #vu8(1 2))) (array-ref bv 2))) (pass-if "array-set!" (let ((bv (make-bytevector 2))) (array-set! bv 255 0) (array-set! bv 77 1) (equal? '(255 77) (bytevector->u8-list bv)))) (pass-if-exception "array-set! [index out-of-range]" exception:out-of-range (let ((bv (make-bytevector 2))) (array-set! bv 0 2))) (pass-if-exception "array-set! [value out-of-range]" exception:out-of-range (let ((bv (make-bytevector 2))) (array-set! bv 256 0))) (pass-if "array-type" (eq? 'vu8 (array-type #vu8()))) (pass-if "array-contents" (let ((bv (u8-list->bytevector (iota 10)))) (eq? bv (array-contents bv)))) (pass-if "array-ref" (let ((bv (u8-list->bytevector (iota 10)))) (equal? (iota 10) (map (lambda (i) (array-ref bv i)) (iota 10))))) (pass-if "array-set!" (let ((bv (make-bytevector 10))) (for-each (lambda (i) (array-set! bv i i)) (iota 10)) (equal? (iota 10) (bytevector->u8-list bv)))) (pass-if "make-typed-array" (let ((bv (make-typed-array 'vu8 77 33))) (equal? bv (u8-list->bytevector (make-list 33 77))))) (pass-if-exception "make-typed-array [out-of-range]" exception:out-of-range (make-typed-array 'vu8 256 77))) (with-test-prefix "uniform-array->bytevector" (pass-if "bytevector" (let ((bv #vu8(0 1 128 255))) (equal? bv (uniform-array->bytevector bv)))) (pass-if "empty bitvector" (let ((bv (uniform-array->bytevector (make-bitvector 0)))) (equal? bv #vu8()))) (pass-if "bitvector < 8" (let ((bv (uniform-array->bytevector (make-bitvector 4 #t)))) (= (bytevector-length bv) 4))) (pass-if "bitvector == 8" (let ((bv (uniform-array->bytevector (make-bitvector 8 #t)))) (= (bytevector-length bv) 4))) (pass-if "bitvector > 8" (let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) (= (bytevector-length bv) 4))) (pass-if "bitvector == 32" (let ((bv (uniform-array->bytevector (make-bitvector 32 #t)))) (= (bytevector-length bv) 4))) (pass-if "bitvector > 32" (let ((bv (uniform-array->bytevector (make-bitvector 33 #t)))) (= (bytevector-length bv) 8)))) (with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors" ;; This failed prior to Guile 2.0.12. ;; See . (pass-if-equal "bytevector-copy on srfi-4 arrays" (make-bytevector 8 #xFF) (bytevector-copy (make-u32vector 2 #xFFFFFFFF)))) ;;; Local Variables: ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1) ;;; End: