1;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- 2;;;; 3;;;; Copyright (C) 2009-2015, 2018, 2021 Free Software Foundation, Inc. 4;;;; 5;;;; Ludovic Courtès 6;;;; 7;;;; This library is free software; you can redistribute it and/or 8;;;; modify it under the terms of the GNU Lesser General Public 9;;;; License as published by the Free Software Foundation; either 10;;;; version 3 of the License, or (at your option) any later version. 11;;;; 12;;;; This library is distributed in the hope that it will be useful, 13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;;;; Lesser General Public License for more details. 16;;;; 17;;;; You should have received a copy of the GNU Lesser General Public 18;;;; License along with this library; if not, write to the Free Software 19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20 21(define-module (test-bytevector) 22 #:use-module (test-suite lib) 23 #:use-module (system base compile) 24 #:use-module (rnrs bytevectors) 25 #:use-module (srfi srfi-1) 26 #:use-module (srfi srfi-4)) 27 28(define exception:decoding-error 29 (cons 'decoding-error "input (locale conversion|decoding) error")) 30 31;;; Some of the tests in here are examples taken from the R6RS Standard 32;;; Libraries document. 33 34 35(with-test-prefix/c&e "2.2 General Operations" 36 37 (pass-if "native-endianness" 38 (not (not (memq (native-endianness) '(big little))))) 39 40 (pass-if "make-bytevector" 41 (and (bytevector? (make-bytevector 20)) 42 (bytevector? (make-bytevector 20 3)))) 43 44 (pass-if "bytevector-length" 45 (= (bytevector-length (make-bytevector 20)) 20)) 46 47 (pass-if "bytevector=?" 48 (and (bytevector=? (make-bytevector 20 7) 49 (make-bytevector 20 7)) 50 (not (bytevector=? (make-bytevector 20 7) 51 (make-bytevector 20 0))))) 52 53 ;; This failed prior to Guile 2.0.12. 54 ;; See <http://bugs.gnu.org/19027>. 55 (pass-if-equal "bytevector-fill! with fill 255" 56 #vu8(255 255 255 255) 57 (let ((bv (make-bytevector 4))) 58 (bytevector-fill! bv 255) 59 bv)) 60 61 ;; This is a Guile-specific extension. 62 (pass-if-equal "bytevector-fill! with fill -128" 63 #vu8(128 128 128 128) 64 (let ((bv (make-bytevector 4))) 65 (bytevector-fill! bv -128) 66 bv)) 67 68 (pass-if "bytevector-copy! overlapping" 69 ;; See <http://debbugs.gnu.org/10070>. 70 (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8)))) 71 (bytevector-copy! b 0 b 3 4) 72 (bytevector->u8-list b) 73 (bytevector=? b #vu8(1 2 3 1 2 3 4 8))))) 74 75 76(with-test-prefix/c&e "2.3 Operations on Bytes and Octets" 77 78 (pass-if "bytevector-{u8,s8}-ref" 79 (equal? '(-127 129 -1 255) 80 (let ((b1 (make-bytevector 16 -127)) 81 (b2 (make-bytevector 16 255))) 82 (list (bytevector-s8-ref b1 0) 83 (bytevector-u8-ref b1 0) 84 (bytevector-s8-ref b2 0) 85 (bytevector-u8-ref b2 0))))) 86 87 (pass-if "bytevector-{u8,s8}-set!" 88 (equal? '(-126 130 -10 246) 89 (let ((b (make-bytevector 16 -127))) 90 91 (bytevector-s8-set! b 0 -126) 92 (bytevector-u8-set! b 1 246) 93 94 (list (bytevector-s8-ref b 0) 95 (bytevector-u8-ref b 0) 96 (bytevector-s8-ref b 1) 97 (bytevector-u8-ref b 1))))) 98 99 (pass-if "bytevector->u8-list" 100 (let ((lst '(1 2 3 128 150 255))) 101 (equal? lst 102 (bytevector->u8-list 103 (let ((b (make-bytevector 6))) 104 (for-each (lambda (i v) 105 (bytevector-u8-set! b i v)) 106 (iota 6) 107 lst) 108 b))))) 109 110 (pass-if "u8-list->bytevector" 111 (let ((lst '(1 2 3 128 150 255))) 112 (equal? lst 113 (bytevector->u8-list (u8-list->bytevector lst))))) 114 115 (pass-if-exception "u8-list->bytevector [invalid argument type]" 116 exception:wrong-type-arg 117 (u8-list->bytevector 'not-a-list)) 118 119 (pass-if-exception "u8-list->bytevector [circular list]" 120 exception:wrong-type-arg 121 (u8-list->bytevector (circular-list 1 2 3))) 122 123 (pass-if "bytevector-uint-{ref,set!} [small]" 124 (let ((b (make-bytevector 15))) 125 (bytevector-uint-set! b 0 #x1234 126 (endianness little) 2) 127 (equal? (bytevector-uint-ref b 0 (endianness big) 2) 128 #x3412))) 129 130 (pass-if "bytevector-uint-set! [large]" 131 (let ((b (make-bytevector 16))) 132 (bytevector-uint-set! b 0 (- (expt 2 128) 3) 133 (endianness little) 16) 134 (equal? (bytevector->u8-list b) 135 '(253 255 255 255 255 255 255 255 136 255 255 255 255 255 255 255 255)))) 137 138 (pass-if "bytevector-uint-{ref,set!} [large]" 139 (let ((b (make-bytevector 120))) 140 (bytevector-uint-set! b 0 (- (expt 2 128) 3) 141 (endianness little) 16) 142 (equal? (bytevector-uint-ref b 0 (endianness little) 16) 143 #xfffffffffffffffffffffffffffffffd))) 144 145 (pass-if "bytevector-sint-ref [small]" 146 (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) 147 (equal? (bytevector-sint-ref b 0 (endianness big) 2) 148 (bytevector-sint-ref b 1 (endianness little) 2) 149 -16))) 150 151 (pass-if "bytevector-sint-ref [large]" 152 (let ((b (make-bytevector 50))) 153 (bytevector-uint-set! b 0 (- (expt 2 128) 3) 154 (endianness little) 16) 155 (equal? (bytevector-sint-ref b 0 (endianness little) 16) 156 -3))) 157 158 (pass-if "bytevector-sint-set! [small]" 159 (let ((b (make-bytevector 3))) 160 (bytevector-sint-set! b 0 -16 (endianness big) 2) 161 (bytevector-sint-set! b 1 -16 (endianness little) 2) 162 (equal? (bytevector->u8-list b) 163 '(#xff #xf0 #xff)))) 164 165 (pass-if "equal?" 166 (let ((bv1 (u8-list->bytevector (iota 123))) 167 (bv2 (u8-list->bytevector (iota 123)))) 168 (equal? bv1 bv2)))) 169 170 171(with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size" 172 173 (pass-if "bytevector->sint-list" 174 (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) 175 (equal? (bytevector->sint-list b (endianness little) 2) 176 '(513 -253 513 513)))) 177 178 (pass-if "bytevector->uint-list" 179 (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1)))) 180 (equal? (bytevector->uint-list b (endianness big) 2) 181 '(513 65283 513 513)))) 182 183 (pass-if "bytevector->uint-list [empty]" 184 (let ((b (make-bytevector 0))) 185 (null? (bytevector->uint-list b (endianness big) 2)))) 186 187 (pass-if-exception "bytevector->sint-list [out-of-range]" 188 exception:out-of-range 189 (bytevector->sint-list (make-bytevector 6) (endianness little) -1)) 190 191 (pass-if-exception "bytevector->uint-list [out-of-range]" 192 exception:out-of-range 193 (bytevector->uint-list (make-bytevector 6) (endianness little) 0)) 194 195 (pass-if-exception "bytevector->uint-list [word size doesn't divide length]" 196 exception:wrong-type-arg 197 (bytevector->uint-list (make-bytevector 6) (endianness little) 4)) 198 199 (pass-if "{sint,uint}-list->bytevector" 200 (let ((b1 (sint-list->bytevector '(513 -253 513 513) 201 (endianness little) 2)) 202 (b2 (uint-list->bytevector '(513 65283 513 513) 203 (endianness little) 2)) 204 (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) 205 (and (bytevector=? b1 b2) 206 (bytevector=? b2 b3)))) 207 208 (pass-if "sint-list->bytevector [limits]" 209 (bytevector=? (sint-list->bytevector '(-32768 32767) 210 (endianness big) 2) 211 (let ((bv (make-bytevector 4))) 212 (bytevector-u8-set! bv 0 #x80) 213 (bytevector-u8-set! bv 1 #x00) 214 (bytevector-u8-set! bv 2 #x7f) 215 (bytevector-u8-set! bv 3 #xff) 216 bv))) 217 218 (pass-if-exception "sint-list->bytevector [invalid argument type]" 219 exception:wrong-type-arg 220 (sint-list->bytevector 'not-a-list (endianness big) 2)) 221 222 (pass-if-exception "uint-list->bytevector [invalid argument type]" 223 exception:wrong-type-arg 224 (uint-list->bytevector 'not-a-list (endianness big) 2)) 225 226 (pass-if-exception "sint-list->bytevector [circular list]" 227 exception:wrong-type-arg 228 (sint-list->bytevector (circular-list 1 2 3) (endianness big) 229 2)) 230 231 (pass-if-exception "uint-list->bytevector [circular list]" 232 exception:wrong-type-arg 233 (uint-list->bytevector (circular-list 1 2 3) (endianness big) 234 2)) 235 236 (pass-if-exception "sint-list->bytevector [out-of-range]" 237 exception:out-of-range 238 (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big) 239 2)) 240 241 (pass-if-exception "uint-list->bytevector [out-of-range]" 242 exception:out-of-range 243 (uint-list->bytevector '(0 -1) (endianness big) 2))) 244 245 246(with-test-prefix/c&e "2.5 Operations on 16-Bit Integers" 247 248 (pass-if "bytevector-u16-ref" 249 (let ((b (u8-list->bytevector 250 '(255 255 255 255 255 255 255 255 251 255 255 255 255 255 255 255 253)))) 252 (and (equal? (bytevector-u16-ref b 14 (endianness little)) 253 #xfdff) 254 (equal? (bytevector-u16-ref b 14 (endianness big)) 255 #xfffd)))) 256 257 (pass-if "bytevector-s16-ref" 258 (let ((b (u8-list->bytevector 259 '(255 255 255 255 255 255 255 255 260 255 255 255 255 255 255 255 253)))) 261 (and (equal? (bytevector-s16-ref b 14 (endianness little)) 262 -513) 263 (equal? (bytevector-s16-ref b 14 (endianness big)) 264 -3)))) 265 266 (pass-if "bytevector-s16-ref [unaligned]" 267 (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) 268 (equal? (bytevector-s16-ref b 1 (endianness little)) 269 -16))) 270 271 (pass-if "bytevector-{u16,s16}-ref" 272 (let ((b (make-bytevector 2))) 273 (bytevector-u16-set! b 0 44444 (endianness little)) 274 (and (equal? (bytevector-u16-ref b 0 (endianness little)) 275 44444) 276 (equal? (bytevector-s16-ref b 0 (endianness little)) 277 (- 44444 65536))))) 278 279 (pass-if "bytevector-native-{u16,s16}-{ref,set!}" 280 (let ((b (make-bytevector 2))) 281 (bytevector-u16-native-set! b 0 44444) 282 (and (equal? (bytevector-u16-native-ref b 0) 283 44444) 284 (equal? (bytevector-s16-native-ref b 0) 285 (- 44444 65536))))) 286 287 (pass-if "bytevector-s16-{ref,set!} [unaligned]" 288 (let ((b (make-bytevector 3))) 289 (bytevector-s16-set! b 1 -77 (endianness little)) 290 (equal? (bytevector-s16-ref b 1 (endianness little)) 291 -77)))) 292 293 294(with-test-prefix/c&e "2.6 Operations on 32-bit Integers" 295 296 (pass-if "bytevector-u32-ref" 297 (let ((b (u8-list->bytevector 298 '(255 255 255 255 255 255 255 255 299 255 255 255 255 255 255 255 253)))) 300 (and (equal? (bytevector-u32-ref b 12 (endianness little)) 301 #xfdffffff) 302 (equal? (bytevector-u32-ref b 12 (endianness big)) 303 #xfffffffd)))) 304 305 (pass-if "bytevector-s32-ref" 306 (let ((b (u8-list->bytevector 307 '(255 255 255 255 255 255 255 255 308 255 255 255 255 255 255 255 253)))) 309 (and (equal? (bytevector-s32-ref b 12 (endianness little)) 310 -33554433) 311 (equal? (bytevector-s32-ref b 12 (endianness big)) 312 -3)))) 313 314 (pass-if "bytevector-{u32,s32}-ref" 315 (let ((b (make-bytevector 4))) 316 (bytevector-u32-set! b 0 2222222222 (endianness little)) 317 (and (equal? (bytevector-u32-ref b 0 (endianness little)) 318 2222222222) 319 (equal? (bytevector-s32-ref b 0 (endianness little)) 320 (- 2222222222 (expt 2 32)))))) 321 322 (pass-if "bytevector-{u32,s32}-native-{ref,set!}" 323 (let ((b (make-bytevector 4))) 324 (bytevector-u32-native-set! b 0 2222222222) 325 (and (equal? (bytevector-u32-native-ref b 0) 326 2222222222) 327 (equal? (bytevector-s32-native-ref b 0) 328 (- 2222222222 (expt 2 32))))))) 329 330 331(with-test-prefix/c&e "2.7 Operations on 64-bit Integers" 332 333 (pass-if "bytevector-u64-ref" 334 (let ((b (u8-list->bytevector 335 '(255 255 255 255 255 255 255 255 336 255 255 255 255 255 255 255 253)))) 337 (and (equal? (bytevector-u64-ref b 8 (endianness little)) 338 #xfdffffffffffffff) 339 (equal? (bytevector-u64-ref b 8 (endianness big)) 340 #xfffffffffffffffd)))) 341 342 (pass-if "bytevector-s64-ref" 343 (let ((b (u8-list->bytevector 344 '(255 255 255 255 255 255 255 255 345 255 255 255 255 255 255 255 253)))) 346 (and (equal? (bytevector-s64-ref b 8 (endianness little)) 347 -144115188075855873) 348 (equal? (bytevector-s64-ref b 8 (endianness big)) 349 -3)))) 350 351 (pass-if "bytevector-{u64,s64}-ref" 352 (let ((b (make-bytevector 8)) 353 (big 9333333333333333333)) 354 (bytevector-u64-set! b 0 big (endianness little)) 355 (and (equal? (bytevector-u64-ref b 0 (endianness little)) 356 big) 357 (equal? (bytevector-s64-ref b 0 (endianness little)) 358 (- big (expt 2 64)))))) 359 360 (pass-if "bytevector-{u64,s64}-native-{ref,set!}" 361 (let ((b (make-bytevector 8)) 362 (big 9333333333333333333)) 363 (bytevector-u64-native-set! b 0 big) 364 (and (equal? (bytevector-u64-native-ref b 0) 365 big) 366 (equal? (bytevector-s64-native-ref b 0) 367 (- big (expt 2 64)))))) 368 369 (pass-if "ref/set! with zero" 370 (let ((b (make-bytevector 8))) 371 (bytevector-s64-set! b 0 -1 (endianness big)) 372 (bytevector-u64-set! b 0 0 (endianness big)) 373 (= 0 (bytevector-u64-ref b 0 (endianness big))))) 374 375 (pass-if-exception "bignum out of range" 376 exception:out-of-range 377 (bytevector-u64-set! (make-bytevector 8) 0 (expt 2 64) (endianness big)))) 378 379 380(with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations" 381 382 (pass-if "single, little endian" 383 ;; http://bugs.gnu.org/11310 384 (let ((b (make-bytevector 4))) 385 (bytevector-ieee-single-set! b 0 1.0 (endianness little)) 386 (equal? #vu8(0 0 128 63) b))) 387 388 (pass-if "single, big endian" 389 ;; http://bugs.gnu.org/11310 390 (let ((b (make-bytevector 4))) 391 (bytevector-ieee-single-set! b 0 1.0 (endianness big)) 392 (equal? #vu8(63 128 0 0) b))) 393 394 (pass-if "bytevector-ieee-single-native-{ref,set!}" 395 (let ((b (make-bytevector 4)) 396 (number 3.00)) 397 (bytevector-ieee-single-native-set! b 0 number) 398 (equal? (bytevector-ieee-single-native-ref b 0) 399 number))) 400 401 (pass-if "bytevector-ieee-single-{ref,set!}" 402 (let ((b (make-bytevector 8)) 403 (number 3.14)) 404 (bytevector-ieee-single-set! b 0 number (endianness little)) 405 (bytevector-ieee-single-set! b 4 number (endianness big)) 406 (equal? (bytevector-ieee-single-ref b 0 (endianness little)) 407 (bytevector-ieee-single-ref b 4 (endianness big))))) 408 409 (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]" 410 (let ((b (make-bytevector 9)) 411 (number 3.14)) 412 (bytevector-ieee-single-set! b 1 number (endianness little)) 413 (bytevector-ieee-single-set! b 5 number (endianness big)) 414 (equal? (bytevector-ieee-single-ref b 1 (endianness little)) 415 (bytevector-ieee-single-ref b 5 (endianness big))))) 416 417 (pass-if "double, little endian" 418 ;; http://bugs.gnu.org/11310 419 (let ((b (make-bytevector 8))) 420 (bytevector-ieee-double-set! b 0 1.0 (endianness little)) 421 (equal? #vu8(0 0 0 0 0 0 240 63) b))) 422 423 (pass-if "double, big endian" 424 ;; http://bugs.gnu.org/11310 425 (let ((b (make-bytevector 8))) 426 (bytevector-ieee-double-set! b 0 1.0 (endianness big)) 427 (equal? #vu8(63 240 0 0 0 0 0 0) b))) 428 429 (pass-if "bytevector-ieee-double-native-{ref,set!}" 430 (let ((b (make-bytevector 8)) 431 (number 3.14)) 432 (bytevector-ieee-double-native-set! b 0 number) 433 (equal? (bytevector-ieee-double-native-ref b 0) 434 number))) 435 436 (pass-if "bytevector-ieee-double-{ref,set!}" 437 (let ((b (make-bytevector 16)) 438 (number 3.14)) 439 (bytevector-ieee-double-set! b 0 number (endianness little)) 440 (bytevector-ieee-double-set! b 8 number (endianness big)) 441 (equal? (bytevector-ieee-double-ref b 0 (endianness little)) 442 (bytevector-ieee-double-ref b 8 (endianness big)))))) 443 444 445 446;; Default to the C locale for the following tests. 447(when (defined? 'setlocale) 448 (setlocale LC_ALL "C")) 449 450 451(with-test-prefix "2.9 Operations on Strings" 452 453 (pass-if "string->utf8" 454 (let* ((str "hello, world") 455 (utf8 (string->utf8 str))) 456 (and (bytevector? utf8) 457 (= (bytevector-length utf8) 458 (string-length str)) 459 (equal? (string->list str) 460 (map integer->char (bytevector->u8-list utf8)))))) 461 462 (pass-if "string->utf8 [latin-1]" 463 (let* ((str "hé, ça va bien ?") 464 (utf8 (string->utf8 str))) 465 (and (bytevector? utf8) 466 (= (bytevector-length utf8) 467 (+ 2 (string-length str)))))) 468 469 (pass-if "string->utf16" 470 (let* ((str "hello, world") 471 (utf16 (string->utf16 str))) 472 (and (bytevector? utf16) 473 (= (bytevector-length utf16) 474 (* 2 (string-length str))) 475 (equal? (string->list str) 476 (map integer->char 477 (bytevector->uint-list utf16 478 (endianness big) 2)))))) 479 480 (pass-if "string->utf16 [little]" 481 (let* ((str "hello, world") 482 (utf16 (string->utf16 str (endianness little)))) 483 (and (bytevector? utf16) 484 (= (bytevector-length utf16) 485 (* 2 (string-length str))) 486 (equal? (string->list str) 487 (map integer->char 488 (bytevector->uint-list utf16 489 (endianness little) 2)))))) 490 491 492 (pass-if "string->utf32" 493 (let* ((str "hello, world") 494 (utf32 (string->utf32 str))) 495 (and (bytevector? utf32) 496 (= (bytevector-length utf32) 497 (* 4 (string-length str))) 498 (equal? (string->list str) 499 (map integer->char 500 (bytevector->uint-list utf32 501 (endianness big) 4)))))) 502 503 (pass-if "string->utf32 [Greek]" 504 (let* ((str "Ἄνεμοι") 505 (utf32 (string->utf32 str))) 506 (and (bytevector? utf32) 507 (equal? (bytevector->uint-list utf32 (endianness big) 4) 508 '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9))))) 509 510 (pass-if "string->utf32 [little]" 511 (let* ((str "hello, world") 512 (utf32 (string->utf32 str (endianness little)))) 513 (and (bytevector? utf32) 514 (= (bytevector-length utf32) 515 (* 4 (string-length str))) 516 (equal? (string->list str) 517 (map integer->char 518 (bytevector->uint-list utf32 519 (endianness little) 4)))))) 520 521 (pass-if "utf8->string" 522 (let* ((utf8 (u8-list->bytevector (map char->integer 523 (string->list "hello, world")))) 524 (str (utf8->string utf8))) 525 (and (string? str) 526 (= (string-length str) 527 (bytevector-length utf8)) 528 (equal? (string->list str) 529 (map integer->char (bytevector->u8-list utf8)))))) 530 531 (pass-if "utf8->string [latin-1]" 532 (let* ((utf8 (string->utf8 "hé, ça va bien ?")) 533 (str (utf8->string utf8))) 534 (and (string? str) 535 (= (string-length str) 536 (- (bytevector-length utf8) 2))))) 537 538 (pass-if-equal "utf8->string [replacement character]" 539 '(104 105 65533) 540 (map char->integer 541 (string->list (utf8->string #vu8(104 105 239 191 189))))) 542 543 (pass-if-exception "utf8->string [invalid encoding]" 544 exception:decoding-error 545 (utf8->string #vu8(104 105 239 191 50))) 546 547 (pass-if "utf16->string" 548 (let* ((utf16 (uint-list->bytevector (map char->integer 549 (string->list "hello, world")) 550 (endianness big) 2)) 551 (str (utf16->string utf16))) 552 (and (string? str) 553 (= (* 2 (string-length str)) 554 (bytevector-length utf16)) 555 (equal? (string->list str) 556 (map integer->char 557 (bytevector->uint-list utf16 (endianness big) 558 2)))))) 559 560 (pass-if "utf16->string [little]" 561 (let* ((utf16 (uint-list->bytevector (map char->integer 562 (string->list "hello, world")) 563 (endianness little) 2)) 564 (str (utf16->string utf16 (endianness little)))) 565 (and (string? str) 566 (= (* 2 (string-length str)) 567 (bytevector-length utf16)) 568 (equal? (string->list str) 569 (map integer->char 570 (bytevector->uint-list utf16 (endianness little) 571 2)))))) 572 (pass-if "utf32->string" 573 (let* ((utf32 (uint-list->bytevector (map char->integer 574 (string->list "hello, world")) 575 (endianness big) 4)) 576 (str (utf32->string utf32))) 577 (and (string? str) 578 (= (* 4 (string-length str)) 579 (bytevector-length utf32)) 580 (equal? (string->list str) 581 (map integer->char 582 (bytevector->uint-list utf32 (endianness big) 583 4)))))) 584 585 (pass-if "utf32->string [little]" 586 (let* ((utf32 (uint-list->bytevector (map char->integer 587 (string->list "hello, world")) 588 (endianness little) 4)) 589 (str (utf32->string utf32 (endianness little)))) 590 (and (string? str) 591 (= (* 4 (string-length str)) 592 (bytevector-length utf32)) 593 (equal? (string->list str) 594 (map integer->char 595 (bytevector->uint-list utf32 (endianness little) 596 4))))))) 597 598 599 600(with-test-prefix "Datum Syntax" 601 602 (pass-if "empty" 603 (equal? (with-input-from-string "#vu8()" read) 604 (make-bytevector 0))) 605 606 (pass-if "simple" 607 (equal? (with-input-from-string "#vu8(1 2 3 4 5)" read) 608 (u8-list->bytevector '(1 2 3 4 5)))) 609 610 (pass-if ">127" 611 (equal? (with-input-from-string "#vu8(0 255 127 128)" read) 612 (u8-list->bytevector '(0 255 127 128)))) 613 614 (pass-if "self-evaluating?" 615 (self-evaluating? (make-bytevector 1))) 616 617 (pass-if "self-evaluating" 618 (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read) 619 (current-module)) 620 (u8-list->bytevector '(1 2 3 4 5)))) 621 622 (pass-if "quoted" 623 (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read) 624 (current-module)) 625 (u8-list->bytevector '(1 2 3 4 5)))) 626 627 (pass-if "literal simple" 628 (equal? #vu8(1 2 3 4 5) 629 (u8-list->bytevector '(1 2 3 4 5)))) 630 631 (pass-if "literal >127" 632 (equal? #vu8(0 255 127 128) 633 (u8-list->bytevector '(0 255 127 128)))) 634 635 (pass-if "literal quoted" 636 (equal? '#vu8(1 2 3 4 5) 637 (u8-list->bytevector '(1 2 3 4 5)))) 638 639 (pass-if-exception "incorrect prefix" 640 exception:read-error 641 (with-input-from-string "#vi8(1 2 3)" read)) 642 643 (pass-if-exception "extraneous space" 644 exception:read-error 645 (with-input-from-string "#vu8 (1 2 3)" read)) 646 647 (pass-if-exception "negative integers" 648 exception:out-of-range 649 (with-input-from-string "#vu8(-1 -2 -3)" read)) 650 651 (pass-if-exception "out-of-range integers" 652 exception:out-of-range 653 (with-input-from-string "#vu8(0 256)" read))) 654 655 656(with-test-prefix "Arrays" 657 658 (pass-if "array?" 659 (array? #vu8(1 2 3))) 660 661 (pass-if "array-length" 662 (equal? (iota 16) 663 (map array-length 664 (map make-bytevector (iota 16))))) 665 666 (pass-if "array-ref" 667 (let ((bv #vu8(255 127))) 668 (and (= 255 (array-ref bv 0)) 669 (= 127 (array-ref bv 1))))) 670 671 (pass-if-exception "array-ref [index out-of-range]" 672 exception:out-of-range 673 (let ((bv #vu8(1 2))) 674 (array-ref bv 2))) 675 676 (pass-if "array-set!" 677 (let ((bv (make-bytevector 2))) 678 (array-set! bv 255 0) 679 (array-set! bv 77 1) 680 (equal? '(255 77) 681 (bytevector->u8-list bv)))) 682 683 (pass-if-exception "array-set! [index out-of-range]" 684 exception:out-of-range 685 (let ((bv (make-bytevector 2))) 686 (array-set! bv 0 2))) 687 688 (pass-if-exception "array-set! [value out-of-range]" 689 exception:out-of-range 690 (let ((bv (make-bytevector 2))) 691 (array-set! bv 256 0))) 692 693 (pass-if "array-type" 694 (eq? 'vu8 (array-type #vu8()))) 695 696 (pass-if "array-contents" 697 (let ((bv (u8-list->bytevector (iota 10)))) 698 (eq? bv (array-contents bv)))) 699 700 (pass-if "array-ref" 701 (let ((bv (u8-list->bytevector (iota 10)))) 702 (equal? (iota 10) 703 (map (lambda (i) (array-ref bv i)) 704 (iota 10))))) 705 706 (pass-if "array-set!" 707 (let ((bv (make-bytevector 10))) 708 (for-each (lambda (i) 709 (array-set! bv i i)) 710 (iota 10)) 711 (equal? (iota 10) 712 (bytevector->u8-list bv)))) 713 714 (pass-if "make-typed-array" 715 (let ((bv (make-typed-array 'vu8 77 33))) 716 (equal? bv (u8-list->bytevector (make-list 33 77))))) 717 718 (pass-if-exception "make-typed-array [out-of-range]" 719 exception:out-of-range 720 (make-typed-array 'vu8 256 77))) 721 722 723(with-test-prefix "uniform-array->bytevector" 724 725 (pass-if "bytevector" 726 (let ((bv #vu8(0 1 128 255))) 727 (equal? bv (uniform-array->bytevector bv)))) 728 729 (pass-if "empty bitvector" 730 (let ((bv (uniform-array->bytevector (make-bitvector 0)))) 731 (equal? bv #vu8()))) 732 733 (pass-if "bitvector < 8" 734 (let ((bv (uniform-array->bytevector (make-bitvector 4 #t)))) 735 (= (bytevector-length bv) 4))) 736 737 (pass-if "bitvector == 8" 738 (let ((bv (uniform-array->bytevector (make-bitvector 8 #t)))) 739 (= (bytevector-length bv) 4))) 740 741 (pass-if "bitvector > 8" 742 (let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) 743 (= (bytevector-length bv) 4))) 744 745 (pass-if "bitvector == 32" 746 (let ((bv (uniform-array->bytevector (make-bitvector 32 #t)))) 747 (= (bytevector-length bv) 4))) 748 749 (pass-if "bitvector > 32" 750 (let ((bv (uniform-array->bytevector (make-bitvector 33 #t)))) 751 (= (bytevector-length bv) 8)))) 752 753 754(with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors" 755 756 ;; This failed prior to Guile 2.0.12. 757 ;; See <http://bugs.gnu.org/18866>. 758 (pass-if-equal "bytevector-copy on srfi-4 arrays" 759 (make-bytevector 8 #xFF) 760 (bytevector-copy (make-u32vector 2 #xFFFFFFFF)))) 761 762;;; Local Variables: 763;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1) 764;;; End: 765