1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
guile/test-suite/tests/bytevectors.test
Ludovic Courtès 8071964943 Allow overlapping regions to be passed to `bytevector-copy!'.
Reported by Dmitry Chestnykh <dmitry@codingrobots.com>.
Fixes <http://debbugs.gnu.org/10070>.

* libguile/bytevectors.c (scm_bytevector_copy_x): Use `memmove', not
  `memcpy'.

* test-suite/tests/bytevectors.test ("2.2 General
  Operations")["bytevector-copy! overlapping"]: New test.

* doc/ref/api-data.texi (Bytevector Manipulation): Mention possible
  overlapping.
2011-11-20 01:10:58 +01:00

655 lines
23 KiB
Scheme
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2009, 2010, 2011 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))
;;; 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)))))
(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)))))
(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) 8))
(pass-if "bytevector->sint-list [off-by-one]"
(equal? (bytevector->sint-list (make-bytevector 31 #xff)
(endianness little) 8)
'(-1 -1 -1)))
(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 "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 "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.
(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 "Generalized Vectors"
(pass-if "generalized-vector?"
(generalized-vector? #vu8(1 2 3)))
(pass-if "generalized-vector-length"
(equal? (iota 16)
(map generalized-vector-length
(map make-bytevector (iota 16)))))
(pass-if "generalized-vector-ref"
(let ((bv #vu8(255 127)))
(and (= 255 (generalized-vector-ref bv 0))
(= 127 (generalized-vector-ref bv 1)))))
(pass-if-exception "generalized-vector-ref [index out-of-range]"
exception:out-of-range
(let ((bv #vu8(1 2)))
(generalized-vector-ref bv 2)))
(pass-if "generalized-vector-set!"
(let ((bv (make-bytevector 2)))
(generalized-vector-set! bv 0 255)
(generalized-vector-set! bv 1 77)
(equal? '(255 77)
(bytevector->u8-list bv))))
(pass-if-exception "generalized-vector-set! [index out-of-range]"
exception:out-of-range
(let ((bv (make-bytevector 2)))
(generalized-vector-set! bv 2 0)))
(pass-if-exception "generalized-vector-set! [value out-of-range]"
exception:out-of-range
(let ((bv (make-bytevector 2)))
(generalized-vector-set! bv 0 256)))
(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) 1)))
(pass-if "bitvector == 8"
(let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
(= (bytevector-length bv) 1)))
(pass-if "bitvector > 8"
(let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
(= (bytevector-length bv) 2))))