-;;;; bytevectors.test --- Exercise the R6RS bytevector API.
+;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
-;;;; Ludovic Courtès
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
+;;;; 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 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; 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 (rnrs bytevector))
+ :use-module (system base compile)
+ :use-module (rnrs bytevectors))
;;; Some of the tests in here are examples taken from the R6RS Standard
;;; Libraries document.
\f
-(with-test-prefix "2.2 General Operations"
+(with-test-prefix/c&e "2.2 General Operations"
(pass-if "native-endianness"
(not (not (memq (native-endianness) '(big little)))))
(and (bytevector=? (make-bytevector 20 7)
(make-bytevector 20 7))
(not (bytevector=? (make-bytevector 20 7)
- (make-bytevector 20 0))))))
+ (make-bytevector 20 0)))))
+
+ (pass-if "bytevector-copy! overlapping"
+ ;; See <http://debbugs.gnu.org/10070>.
+ (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)))))
\f
-(with-test-prefix "2.3 Operations on Bytes and Octets"
+(with-test-prefix/c&e "2.3 Operations on Bytes and Octets"
(pass-if "bytevector-{u8,s8}-ref"
(equal? '(-127 129 -1 255)
(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)))))
+ '(#xff #xf0 #xff))))
+
+ (pass-if "equal?"
+ (let ((bv1 (u8-list->bytevector (iota 123)))
+ (bv2 (u8-list->bytevector (iota 123))))
+ (equal? bv1 bv2))))
\f
-(with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
+(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))))
(pass-if-exception "bytevector->sint-list [out-of-range]"
exception:out-of-range
- (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
+ (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 "bytevector->sint-list [off-by-one]"
- (equal? (bytevector->sint-list (make-bytevector 31 #xff)
- (endianness little) 8)
- '(-1 -1 -1)))
+ (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)
(uint-list->bytevector '(0 -1) (endianness big) 2)))
\f
-(with-test-prefix "2.5 Operations on 16-Bit Integers"
+(with-test-prefix/c&e "2.5 Operations on 16-Bit Integers"
(pass-if "bytevector-u16-ref"
(let ((b (u8-list->bytevector
-77))))
\f
-(with-test-prefix "2.6 Operations on 32-bit Integers"
+(with-test-prefix/c&e "2.6 Operations on 32-bit Integers"
(pass-if "bytevector-u32-ref"
(let ((b (u8-list->bytevector
(- 2222222222 (expt 2 32)))))))
\f
-(with-test-prefix "2.7 Operations on 64-bit Integers"
+(with-test-prefix/c&e "2.7 Operations on 64-bit Integers"
(pass-if "bytevector-u64-ref"
(let ((b (u8-list->bytevector
(= 0 (bytevector-u64-ref b 0 (endianness big))))))
\f
-(with-test-prefix "2.8 Operations on IEEE-754 Representations"
+(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))
(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-ref b 8 (endianness big))))))
\f
-(define (with-locale locale thunk)
- ;; Run THUNK under LOCALE.
- (let ((original-locale (setlocale LC_ALL)))
- (catch 'system-error
- (lambda ()
- (setlocale LC_ALL locale))
- (lambda (key . args)
- (throw 'unresolved)))
-
- (dynamic-wind
- (lambda ()
- #t)
- thunk
- (lambda ()
- (setlocale LC_ALL original-locale)))))
-
-(define (with-latin1-locale thunk)
- ;; Try out several ISO-8859-1 locales and run THUNK under the one that
- ;; works (if any).
- (define %locales
- (map (lambda (name)
- (string-append name ".ISO-8859-1"))
- '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
-
- (let loop ((locales %locales))
- (if (null? locales)
- (throw 'unresolved)
- (catch 'unresolved
- (lambda ()
- (with-locale (car locales) thunk))
- (lambda (key . args)
- (loop (cdr locales)))))))
-
;; Default to the C locale for the following tests.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
(with-test-prefix "2.9 Operations on Strings"
(map integer->char (bytevector->u8-list utf8))))))
(pass-if "string->utf8 [latin-1]"
- (with-latin1-locale
- (lambda ()
- (let* ((str "hé, ça va bien ?")
- (utf8 (string->utf8 str)))
- (and (bytevector? utf8)
- (= (bytevector-length utf8)
- (+ 2 (string-length str))))))))
+ (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")
(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))))
(map integer->char (bytevector->u8-list utf8))))))
(pass-if "utf8->string [latin-1]"
- (with-latin1-locale
- (lambda ()
- (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
- (str (utf8->string utf8)))
- (and (string? str)
- (= (string-length str)
- (- (bytevector-length utf8) 2)))))))
+ (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
4)))))))
+\f
+(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)))
+
+\f
+(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)))
+
+\f
+(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))))
+
;;; Local Variables:
-;;; coding: latin-1
-;;; mode: scheme
+;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
;;; End: