;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; 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
(define-module (test-bytevector)
:use-module (test-suite lib)
:use-module (system base compile)
- :use-module (rnrs bytevector))
+ :use-module (rnrs bytevectors))
;;; Some of the tests in here are examples taken from the R6RS Standard
;;; Libraries document.
-(define-syntax c&e
- (syntax-rules (pass-if pass-if-exception)
- ((_ (pass-if test-name exp))
- (begin (pass-if (string-append test-name " (eval)")
- (primitive-eval 'exp))
- (pass-if (string-append test-name " (compile)")
- (compile 'exp #:to 'value #:env (current-module)))))
- ((_ (pass-if-exception test-name exc exp))
- (begin (pass-if-exception (string-append test-name " (eval)")
- exc (primitive-eval 'exp))
- (pass-if-exception (string-append test-name " (compile)")
- exc (compile 'exp #:to 'value
- #:env (current-module)))))))
-
-(define-syntax with-test-prefix/c&e
- (syntax-rules ()
- ((_ section-name exp ...)
- (with-test-prefix section-name (c&e exp) ...))))
-
-
\f
(with-test-prefix/c&e "2.2 General Operations"
(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/c&e "2.3 Operations on Bytes and Octets"
(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 "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 [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)
\f
(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))
(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))
\f
;; 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"
(with-input-from-string "#vu8(0 256)" read)))
\f
-(with-test-prefix "Generalized Vectors"
+(with-test-prefix "Arrays"
- (pass-if "generalized-vector?"
- (generalized-vector? #vu8(1 2 3)))
+ (pass-if "array?"
+ (array? #vu8(1 2 3)))
- (pass-if "generalized-vector-length"
+ (pass-if "array-length"
(equal? (iota 16)
- (map generalized-vector-length
+ (map array-length
(map make-bytevector (iota 16)))))
- (pass-if "generalized-vector-ref"
+ (pass-if "array-ref"
(let ((bv #vu8(255 127)))
- (and (= 255 (generalized-vector-ref bv 0))
- (= 127 (generalized-vector-ref bv 1)))))
+ (and (= 255 (array-ref bv 0))
+ (= 127 (array-ref bv 1)))))
- (pass-if-exception "generalized-vector-ref [index out-of-range]"
+ (pass-if-exception "array-ref [index out-of-range]"
exception:out-of-range
(let ((bv #vu8(1 2)))
- (generalized-vector-ref bv 2)))
+ (array-ref bv 2)))
- (pass-if "generalized-vector-set!"
+ (pass-if "array-set!"
(let ((bv (make-bytevector 2)))
- (generalized-vector-set! bv 0 255)
- (generalized-vector-set! bv 1 77)
+ (array-set! bv 255 0)
+ (array-set! bv 77 1)
(equal? '(255 77)
(bytevector->u8-list bv))))
- (pass-if-exception "generalized-vector-set! [index out-of-range]"
+ (pass-if-exception "array-set! [index out-of-range]"
exception:out-of-range
(let ((bv (make-bytevector 2)))
- (generalized-vector-set! bv 2 0)))
+ (array-set! bv 0 2)))
- (pass-if-exception "generalized-vector-set! [value out-of-range]"
+ (pass-if-exception "array-set! [value out-of-range]"
exception:out-of-range
(let ((bv (make-bytevector 2)))
- (generalized-vector-set! bv 0 256)))
+ (array-set! bv 256 0)))
(pass-if "array-type"
(eq? 'vu8 (array-type #vu8())))
(pass-if "bitvector < 8"
(let ((bv (uniform-array->bytevector (make-bitvector 4 #t))))
- (= (bytevector-length bv) 1)))
+ (= (bytevector-length bv) 4)))
(pass-if "bitvector == 8"
(let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
- (= (bytevector-length bv) 1)))
+ (= (bytevector-length bv) 4)))
(pass-if "bitvector > 8"
(let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
- (= (bytevector-length bv) 2))))
+ (= (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:
+;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
+;;; End:
HCoop / bpt / guile.git / blobdiff