Merge commit '0ce224594ae5a673f6a397c284db5f5a61935334'

[bpt/guile.git] / test-suite / tests / bytevectors.test

diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
index 3007434..c4ae1bb 100644 (file)
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,6 +1,8 @@
 ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011 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
@@ -157,12 +159,15 @@
 
   (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)
@@ -325,6 +330,18 @@
 \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))
@@ -348,6 +365,18 @@
       (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))
@@ -366,7 +395,8 @@
 \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"
@@ -565,42 +595,42 @@
     (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())))
@@ -644,12 +674,24 @@
 
   (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: