chibi-scheme/lib/scheme/bytevector-test.sld

;; adapted from guile bytevectors.test by Ludovic Courtès

(define-library (scheme bytevector-test)
  (import (except (scheme base) bytevector-copy!)
          (scheme bytevector)
          (scheme list)
          (chibi test))
  (export run-tests)
  (begin
    (define (run-tests)
      (test-begin "scheme bytevector")
      ;; (test 258 (bytevector-uint-ref #u8(0 1 2 0) 1 (endianness big) 2))
      ;; (test 513 (bytevector-uint-ref #u8(0 1 2 0) 1 (endianness little) 2))
      ;; (test -65281
      ;;     (bytevector-sint-ref #u8(0 #xFF 1 0) 1 (endianness big) 2))
      ;; (test -65281
      ;;     (bytevector-sint-ref #u8(0 1 #xFF 0) 1 (endianness little) 2))
      (test-begin "2.2 General Operations")
      (test-assert "native-endianness"
        (not (not (memq (native-endianness) '(big little)))))

      (test-assert "make-bytevector"
        (and (bytevector? (make-bytevector 20))
             (bytevector? (make-bytevector 20 3))))

      (test-assert "bytevector-length"
        (= (bytevector-length (make-bytevector 20)) 20))

      (test-assert "bytevector=?"
        (and (bytevector=? (make-bytevector 20 7)
                           (make-bytevector 20 7))
             (not (bytevector=? (make-bytevector 20 7)
                                (make-bytevector 20 0)))))

      (test "bytevector-fill! with fill 255"
          #u8(255 255 255 255)
          (let ((bv (make-bytevector 4)))
            (bytevector-fill! bv 255)
            bv))

      (test "bytevector-copy! overlapping"
          #u8(1 2 3 1 2 3 4 8)
          (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
            (bytevector-copy! b 0 b 3 4)
            b))
      (test-end)

      (test-begin "2.3 Operations on Bytes and Octets")

      (test "bytevector-{u8,s8}-ref"
          '(-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))))

      (test "bytevector-{u8,s8}-set!"
          '(-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))))

      (test-assert "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)))))

      (test-assert "u8-list->bytevector"
        (let ((lst '(1 2 3 128 150 255)))
          (equal? lst
                  (bytevector->u8-list (u8-list->bytevector lst)))))

      (test-error "u8-list->bytevector [invalid argument type]"
                  (u8-list->bytevector 'not-a-list))

      (test-error "u8-list->bytevector [circular list]"
                  (u8-list->bytevector (circular-list 1 2 3)))

      (test "bytevector-uint-{ref,set!} [small]"
          #x3412
        (let ((b (make-bytevector 15)))
          (bytevector-uint-set! b 0 #x1234 (endianness little) 2)
          (bytevector-uint-ref b 0 (endianness big) 2)))

      (test "bytevector-uint-set! [large]"
          '(253 255 255 255 255 255 255 255
                255 255 255 255 255 255 255 255)
        (let ((b (make-bytevector 16)))
          (bytevector-uint-set! b 0 (- (expt 2 128) 3) (endianness little) 16)
          (bytevector->u8-list b)))

      (test "bytevector-uint-{ref,set!} [large]"
          #xfffffffffffffffffffffffffffffffd
        (let ((b (make-bytevector 120)))
          (bytevector-uint-set! b 0 (- (expt 2 128) 3)
                                (endianness little) 16)
          (bytevector-uint-ref b 0 (endianness little) 16)))

      (test "bytevector-sint-ref big [small]"
          -16
        (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
          (bytevector-sint-ref b 0 (endianness big) 2)))

      (test "bytevector-sint-ref little [small]"
          -16
        (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
          (bytevector-sint-ref b 1 (endianness little) 2)))

      (test "bytevector-sint-ref [large]"
          -3
        (let ((b (make-bytevector 50)))
          (bytevector-uint-set! b 0 (- (expt 2 128) 3) (endianness little) 16)
          (bytevector-sint-ref b 0 (endianness little) 16)))

      (test "bytevector-sint-set! [small]"
          '(#xff #xf0 #xff)
        (let ((b (make-bytevector 3)))
          (bytevector-sint-set! b 0 -16 (endianness big) 2)
          (bytevector-sint-set! b 1 -16 (endianness little) 2)
          (bytevector->u8-list b)))

      (test-assert "equal?"
        (let ((bv1 (u8-list->bytevector (iota 123)))
              (bv2 (u8-list->bytevector (iota 123))))
          (equal? bv1 bv2)))
      (test-end)

      (test-begin "2.4 Operations on Integers of Arbitrary Size")

      (test '(513 -253 513 513)
          (bytevector->sint-list #u8(1 2 3 255 1 2 1 2) (endianness little) 2))

      (test "bytevector->uint-list"
          '(513 65283 513 513)
        (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
          (bytevector->uint-list b (endianness big) 2)))

      (test "bytevector->uint-list [empty]"
          '()
        (let ((b (make-bytevector 0)))
          (bytevector->uint-list b (endianness big) 2)))

      (test-error "bytevector->sint-list [out-of-range]"
                  (bytevector->sint-list (make-bytevector 6) (endianness little) -1))

      (test-error "bytevector->uint-list [out-of-range]"
                  (bytevector->uint-list (make-bytevector 6) (endianness little) 0))

      (test-error "bytevector->uint-list [word size doesn't divide length]"
                  (bytevector->uint-list (make-bytevector 6) (endianness little) 4))

      (test-assert "{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))))

      (test-assert "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)))

      (test-error "sint-list->bytevector [invalid argument type]"
                  (sint-list->bytevector 'not-a-list (endianness big) 2))

      (test-error "uint-list->bytevector [invalid argument type]"
                  (uint-list->bytevector 'not-a-list (endianness big) 2))

      (test-error "sint-list->bytevector [circular list]"
                  (sint-list->bytevector (circular-list 1 2 3) (endianness big)
                                         2))

      (test-error "uint-list->bytevector [circular list]"
                  (uint-list->bytevector (circular-list 1 2 3) (endianness big)
                                         2))

      (test-error "sint-list->bytevector [out-of-range]"
                  (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
                                         2))

      (test-error "uint-list->bytevector [out-of-range]"
                  (uint-list->bytevector '(0 -1) (endianness big) 2))
      (test-end)

      (test-begin "2.5 Operations on 16-Bit Integers")

      (let ((b #u8(255 255 255 255 255 255 255 255
                       255 255 255 255 255 255 255 253)))
        (test #xfdff (bytevector-u16-ref b 14 (endianness little)))
        (test #xfffd (bytevector-u16-ref b 14 (endianness big))))

      (let ((b #u8(255 255 255 255 255 255 255 255
                       255 255 255 255 255 255 255 253)))
        (test -513 (bytevector-s16-ref b 14 (endianness little)))
        (test -3 (bytevector-s16-ref b 14 (endianness big))))

      (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
        (test -16 (bytevector-s16-ref b 1 (endianness little))))

      (test-assert "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)))))

      (test-assert "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)))))

      (test-assert "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)))
      (test-end)

      (test-begin "2.6 Operations on 32-bit Integers")

      (test-assert "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))))

      (test-assert "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))))

      (test-assert "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))))))

      (test-assert "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))))))
      (test-end)

      (test-begin "2.7 Operations on 64-bit Integers")

      (test-assert "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))))

      (test-assert "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))))

      (test-assert "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))))))

      (test-assert "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))))))

      (test-assert "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)))))

      (test-end)

      (test-begin "2.8 Operations on IEEE-754 Representations")

      (test-assert "single, little endian"
        (let ((b (make-bytevector 4)))
          (bytevector-ieee-single-set! b 0 1.0 (endianness little))
          (equal? #u8(0 0 128 63) b)))

      (test-assert "single, big endian"
        (let ((b (make-bytevector 4)))
          (bytevector-ieee-single-set! b 0 1.0 (endianness big))
          (equal? #u8(63 128 0 0) b)))

      (test-assert "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)))

      (test-assert "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)))))

      (test-assert "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)))))

      (test-assert "double, little endian"
        (let ((b (make-bytevector 8)))
          (bytevector-ieee-double-set! b 0 1.0 (endianness little))
          (equal? #u8(0 0 0 0 0 0 240 63) b)))

      (test-assert "double, big endian"
        (let ((b (make-bytevector 8)))
          (bytevector-ieee-double-set! b 0 1.0 (endianness big))
          (equal? #u8(63 240 0 0 0 0 0 0) b)))

      (test-assert "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)))

      (test-assert "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)))))
      (test-end)


      (test-begin "2.9 Operations on Strings")

      (test-assert "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))))))

      (test-assert "string->utf8 [latin-1]"
        (let* ((str  "hé, ça va bien ?")
               (utf8 (string->utf8 str)))
          (and (bytevector? utf8)
               (= (bytevector-length utf8)
                  (+ 2 (string-length str))))))

      (test-assert "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))))))

      (test-assert "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))))))


      (test-assert "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))))))

      (test-assert "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)))))

      (test-assert "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))))))

      (test-assert "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))))))

      (test-assert "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)))))

      (test "utf8->string [replacement character]"
          '(104 105 65533)
        (map char->integer
             (string->list (utf8->string #u8(104 105 239 191 189)))))

      (test-assert "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))))))

      (test-assert "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))))))
      (test-assert "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))))))

      (test-assert "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))))))
      (test-end)

      (test-end))))