bytevectors.test 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738
  1. ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
  2. ;;;;
  3. ;;;; Copyright (C) 2009-2015 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. (define-module (test-bytevector)
  21. :use-module (test-suite lib)
  22. :use-module (system base compile)
  23. :use-module (rnrs bytevectors)
  24. :use-module (srfi srfi-4))
  25. (define exception:decoding-error
  26. (cons 'decoding-error "input (locale conversion|decoding) error"))
  27. ;;; Some of the tests in here are examples taken from the R6RS Standard
  28. ;;; Libraries document.
  29. (with-test-prefix/c&e "2.2 General Operations"
  30. (pass-if "native-endianness"
  31. (not (not (memq (native-endianness) '(big little)))))
  32. (pass-if "make-bytevector"
  33. (and (bytevector? (make-bytevector 20))
  34. (bytevector? (make-bytevector 20 3))))
  35. (pass-if "bytevector-length"
  36. (= (bytevector-length (make-bytevector 20)) 20))
  37. (pass-if "bytevector=?"
  38. (and (bytevector=? (make-bytevector 20 7)
  39. (make-bytevector 20 7))
  40. (not (bytevector=? (make-bytevector 20 7)
  41. (make-bytevector 20 0)))))
  42. ;; This failed prior to Guile 2.0.12.
  43. ;; See <http://bugs.gnu.org/19027>.
  44. (pass-if-equal "bytevector-fill! with fill 255"
  45. #vu8(255 255 255 255)
  46. (let ((bv (make-bytevector 4)))
  47. (bytevector-fill! bv 255)
  48. bv))
  49. ;; This is a Guile-specific extension.
  50. (pass-if-equal "bytevector-fill! with fill -128"
  51. #vu8(128 128 128 128)
  52. (let ((bv (make-bytevector 4)))
  53. (bytevector-fill! bv -128)
  54. bv))
  55. (pass-if "bytevector-copy! overlapping"
  56. ;; See <http://debbugs.gnu.org/10070>.
  57. (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
  58. (bytevector-copy! b 0 b 3 4)
  59. (bytevector->u8-list b)
  60. (bytevector=? b #vu8(1 2 3 1 2 3 4 8)))))
  61. (with-test-prefix/c&e "2.3 Operations on Bytes and Octets"
  62. (pass-if "bytevector-{u8,s8}-ref"
  63. (equal? '(-127 129 -1 255)
  64. (let ((b1 (make-bytevector 16 -127))
  65. (b2 (make-bytevector 16 255)))
  66. (list (bytevector-s8-ref b1 0)
  67. (bytevector-u8-ref b1 0)
  68. (bytevector-s8-ref b2 0)
  69. (bytevector-u8-ref b2 0)))))
  70. (pass-if "bytevector-{u8,s8}-set!"
  71. (equal? '(-126 130 -10 246)
  72. (let ((b (make-bytevector 16 -127)))
  73. (bytevector-s8-set! b 0 -126)
  74. (bytevector-u8-set! b 1 246)
  75. (list (bytevector-s8-ref b 0)
  76. (bytevector-u8-ref b 0)
  77. (bytevector-s8-ref b 1)
  78. (bytevector-u8-ref b 1)))))
  79. (pass-if "bytevector->u8-list"
  80. (let ((lst '(1 2 3 128 150 255)))
  81. (equal? lst
  82. (bytevector->u8-list
  83. (let ((b (make-bytevector 6)))
  84. (for-each (lambda (i v)
  85. (bytevector-u8-set! b i v))
  86. (iota 6)
  87. lst)
  88. b)))))
  89. (pass-if "u8-list->bytevector"
  90. (let ((lst '(1 2 3 128 150 255)))
  91. (equal? lst
  92. (bytevector->u8-list (u8-list->bytevector lst)))))
  93. (pass-if "bytevector-uint-{ref,set!} [small]"
  94. (let ((b (make-bytevector 15)))
  95. (bytevector-uint-set! b 0 #x1234
  96. (endianness little) 2)
  97. (equal? (bytevector-uint-ref b 0 (endianness big) 2)
  98. #x3412)))
  99. (pass-if "bytevector-uint-set! [large]"
  100. (let ((b (make-bytevector 16)))
  101. (bytevector-uint-set! b 0 (- (expt 2 128) 3)
  102. (endianness little) 16)
  103. (equal? (bytevector->u8-list b)
  104. '(253 255 255 255 255 255 255 255
  105. 255 255 255 255 255 255 255 255))))
  106. (pass-if "bytevector-uint-{ref,set!} [large]"
  107. (let ((b (make-bytevector 120)))
  108. (bytevector-uint-set! b 0 (- (expt 2 128) 3)
  109. (endianness little) 16)
  110. (equal? (bytevector-uint-ref b 0 (endianness little) 16)
  111. #xfffffffffffffffffffffffffffffffd)))
  112. (pass-if "bytevector-sint-ref [small]"
  113. (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
  114. (equal? (bytevector-sint-ref b 0 (endianness big) 2)
  115. (bytevector-sint-ref b 1 (endianness little) 2)
  116. -16)))
  117. (pass-if "bytevector-sint-ref [large]"
  118. (let ((b (make-bytevector 50)))
  119. (bytevector-uint-set! b 0 (- (expt 2 128) 3)
  120. (endianness little) 16)
  121. (equal? (bytevector-sint-ref b 0 (endianness little) 16)
  122. -3)))
  123. (pass-if "bytevector-sint-set! [small]"
  124. (let ((b (make-bytevector 3)))
  125. (bytevector-sint-set! b 0 -16 (endianness big) 2)
  126. (bytevector-sint-set! b 1 -16 (endianness little) 2)
  127. (equal? (bytevector->u8-list b)
  128. '(#xff #xf0 #xff))))
  129. (pass-if "equal?"
  130. (let ((bv1 (u8-list->bytevector (iota 123)))
  131. (bv2 (u8-list->bytevector (iota 123))))
  132. (equal? bv1 bv2))))
  133. (with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size"
  134. (pass-if "bytevector->sint-list"
  135. (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
  136. (equal? (bytevector->sint-list b (endianness little) 2)
  137. '(513 -253 513 513))))
  138. (pass-if "bytevector->uint-list"
  139. (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
  140. (equal? (bytevector->uint-list b (endianness big) 2)
  141. '(513 65283 513 513))))
  142. (pass-if "bytevector->uint-list [empty]"
  143. (let ((b (make-bytevector 0)))
  144. (null? (bytevector->uint-list b (endianness big) 2))))
  145. (pass-if-exception "bytevector->sint-list [out-of-range]"
  146. exception:out-of-range
  147. (bytevector->sint-list (make-bytevector 6) (endianness little) -1))
  148. (pass-if-exception "bytevector->uint-list [out-of-range]"
  149. exception:out-of-range
  150. (bytevector->uint-list (make-bytevector 6) (endianness little) 0))
  151. (pass-if-exception "bytevector->uint-list [word size doesn't divide length]"
  152. exception:wrong-type-arg
  153. (bytevector->uint-list (make-bytevector 6) (endianness little) 4))
  154. (pass-if "{sint,uint}-list->bytevector"
  155. (let ((b1 (sint-list->bytevector '(513 -253 513 513)
  156. (endianness little) 2))
  157. (b2 (uint-list->bytevector '(513 65283 513 513)
  158. (endianness little) 2))
  159. (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
  160. (and (bytevector=? b1 b2)
  161. (bytevector=? b2 b3))))
  162. (pass-if "sint-list->bytevector [limits]"
  163. (bytevector=? (sint-list->bytevector '(-32768 32767)
  164. (endianness big) 2)
  165. (let ((bv (make-bytevector 4)))
  166. (bytevector-u8-set! bv 0 #x80)
  167. (bytevector-u8-set! bv 1 #x00)
  168. (bytevector-u8-set! bv 2 #x7f)
  169. (bytevector-u8-set! bv 3 #xff)
  170. bv)))
  171. (pass-if-exception "sint-list->bytevector [out-of-range]"
  172. exception:out-of-range
  173. (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
  174. 2))
  175. (pass-if-exception "uint-list->bytevector [out-of-range]"
  176. exception:out-of-range
  177. (uint-list->bytevector '(0 -1) (endianness big) 2)))
  178. (with-test-prefix/c&e "2.5 Operations on 16-Bit Integers"
  179. (pass-if "bytevector-u16-ref"
  180. (let ((b (u8-list->bytevector
  181. '(255 255 255 255 255 255 255 255
  182. 255 255 255 255 255 255 255 253))))
  183. (and (equal? (bytevector-u16-ref b 14 (endianness little))
  184. #xfdff)
  185. (equal? (bytevector-u16-ref b 14 (endianness big))
  186. #xfffd))))
  187. (pass-if "bytevector-s16-ref"
  188. (let ((b (u8-list->bytevector
  189. '(255 255 255 255 255 255 255 255
  190. 255 255 255 255 255 255 255 253))))
  191. (and (equal? (bytevector-s16-ref b 14 (endianness little))
  192. -513)
  193. (equal? (bytevector-s16-ref b 14 (endianness big))
  194. -3))))
  195. (pass-if "bytevector-s16-ref [unaligned]"
  196. (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
  197. (equal? (bytevector-s16-ref b 1 (endianness little))
  198. -16)))
  199. (pass-if "bytevector-{u16,s16}-ref"
  200. (let ((b (make-bytevector 2)))
  201. (bytevector-u16-set! b 0 44444 (endianness little))
  202. (and (equal? (bytevector-u16-ref b 0 (endianness little))
  203. 44444)
  204. (equal? (bytevector-s16-ref b 0 (endianness little))
  205. (- 44444 65536)))))
  206. (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
  207. (let ((b (make-bytevector 2)))
  208. (bytevector-u16-native-set! b 0 44444)
  209. (and (equal? (bytevector-u16-native-ref b 0)
  210. 44444)
  211. (equal? (bytevector-s16-native-ref b 0)
  212. (- 44444 65536)))))
  213. (pass-if "bytevector-s16-{ref,set!} [unaligned]"
  214. (let ((b (make-bytevector 3)))
  215. (bytevector-s16-set! b 1 -77 (endianness little))
  216. (equal? (bytevector-s16-ref b 1 (endianness little))
  217. -77))))
  218. (with-test-prefix/c&e "2.6 Operations on 32-bit Integers"
  219. (pass-if "bytevector-u32-ref"
  220. (let ((b (u8-list->bytevector
  221. '(255 255 255 255 255 255 255 255
  222. 255 255 255 255 255 255 255 253))))
  223. (and (equal? (bytevector-u32-ref b 12 (endianness little))
  224. #xfdffffff)
  225. (equal? (bytevector-u32-ref b 12 (endianness big))
  226. #xfffffffd))))
  227. (pass-if "bytevector-s32-ref"
  228. (let ((b (u8-list->bytevector
  229. '(255 255 255 255 255 255 255 255
  230. 255 255 255 255 255 255 255 253))))
  231. (and (equal? (bytevector-s32-ref b 12 (endianness little))
  232. -33554433)
  233. (equal? (bytevector-s32-ref b 12 (endianness big))
  234. -3))))
  235. (pass-if "bytevector-{u32,s32}-ref"
  236. (let ((b (make-bytevector 4)))
  237. (bytevector-u32-set! b 0 2222222222 (endianness little))
  238. (and (equal? (bytevector-u32-ref b 0 (endianness little))
  239. 2222222222)
  240. (equal? (bytevector-s32-ref b 0 (endianness little))
  241. (- 2222222222 (expt 2 32))))))
  242. (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
  243. (let ((b (make-bytevector 4)))
  244. (bytevector-u32-native-set! b 0 2222222222)
  245. (and (equal? (bytevector-u32-native-ref b 0)
  246. 2222222222)
  247. (equal? (bytevector-s32-native-ref b 0)
  248. (- 2222222222 (expt 2 32)))))))
  249. (with-test-prefix/c&e "2.7 Operations on 64-bit Integers"
  250. (pass-if "bytevector-u64-ref"
  251. (let ((b (u8-list->bytevector
  252. '(255 255 255 255 255 255 255 255
  253. 255 255 255 255 255 255 255 253))))
  254. (and (equal? (bytevector-u64-ref b 8 (endianness little))
  255. #xfdffffffffffffff)
  256. (equal? (bytevector-u64-ref b 8 (endianness big))
  257. #xfffffffffffffffd))))
  258. (pass-if "bytevector-s64-ref"
  259. (let ((b (u8-list->bytevector
  260. '(255 255 255 255 255 255 255 255
  261. 255 255 255 255 255 255 255 253))))
  262. (and (equal? (bytevector-s64-ref b 8 (endianness little))
  263. -144115188075855873)
  264. (equal? (bytevector-s64-ref b 8 (endianness big))
  265. -3))))
  266. (pass-if "bytevector-{u64,s64}-ref"
  267. (let ((b (make-bytevector 8))
  268. (big 9333333333333333333))
  269. (bytevector-u64-set! b 0 big (endianness little))
  270. (and (equal? (bytevector-u64-ref b 0 (endianness little))
  271. big)
  272. (equal? (bytevector-s64-ref b 0 (endianness little))
  273. (- big (expt 2 64))))))
  274. (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
  275. (let ((b (make-bytevector 8))
  276. (big 9333333333333333333))
  277. (bytevector-u64-native-set! b 0 big)
  278. (and (equal? (bytevector-u64-native-ref b 0)
  279. big)
  280. (equal? (bytevector-s64-native-ref b 0)
  281. (- big (expt 2 64))))))
  282. (pass-if "ref/set! with zero"
  283. (let ((b (make-bytevector 8)))
  284. (bytevector-s64-set! b 0 -1 (endianness big))
  285. (bytevector-u64-set! b 0 0 (endianness big))
  286. (= 0 (bytevector-u64-ref b 0 (endianness big)))))
  287. (pass-if-exception "bignum out of range"
  288. exception:out-of-range
  289. (bytevector-u64-set! (make-bytevector 8) 0 (expt 2 64) (endianness big))))
  290. (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations"
  291. (pass-if "single, little endian"
  292. ;; http://bugs.gnu.org/11310
  293. (let ((b (make-bytevector 4)))
  294. (bytevector-ieee-single-set! b 0 1.0 (endianness little))
  295. (equal? #vu8(0 0 128 63) b)))
  296. (pass-if "single, big endian"
  297. ;; http://bugs.gnu.org/11310
  298. (let ((b (make-bytevector 4)))
  299. (bytevector-ieee-single-set! b 0 1.0 (endianness big))
  300. (equal? #vu8(63 128 0 0) b)))
  301. (pass-if "bytevector-ieee-single-native-{ref,set!}"
  302. (let ((b (make-bytevector 4))
  303. (number 3.00))
  304. (bytevector-ieee-single-native-set! b 0 number)
  305. (equal? (bytevector-ieee-single-native-ref b 0)
  306. number)))
  307. (pass-if "bytevector-ieee-single-{ref,set!}"
  308. (let ((b (make-bytevector 8))
  309. (number 3.14))
  310. (bytevector-ieee-single-set! b 0 number (endianness little))
  311. (bytevector-ieee-single-set! b 4 number (endianness big))
  312. (equal? (bytevector-ieee-single-ref b 0 (endianness little))
  313. (bytevector-ieee-single-ref b 4 (endianness big)))))
  314. (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
  315. (let ((b (make-bytevector 9))
  316. (number 3.14))
  317. (bytevector-ieee-single-set! b 1 number (endianness little))
  318. (bytevector-ieee-single-set! b 5 number (endianness big))
  319. (equal? (bytevector-ieee-single-ref b 1 (endianness little))
  320. (bytevector-ieee-single-ref b 5 (endianness big)))))
  321. (pass-if "double, little endian"
  322. ;; http://bugs.gnu.org/11310
  323. (let ((b (make-bytevector 8)))
  324. (bytevector-ieee-double-set! b 0 1.0 (endianness little))
  325. (equal? #vu8(0 0 0 0 0 0 240 63) b)))
  326. (pass-if "double, big endian"
  327. ;; http://bugs.gnu.org/11310
  328. (let ((b (make-bytevector 8)))
  329. (bytevector-ieee-double-set! b 0 1.0 (endianness big))
  330. (equal? #vu8(63 240 0 0 0 0 0 0) b)))
  331. (pass-if "bytevector-ieee-double-native-{ref,set!}"
  332. (let ((b (make-bytevector 8))
  333. (number 3.14))
  334. (bytevector-ieee-double-native-set! b 0 number)
  335. (equal? (bytevector-ieee-double-native-ref b 0)
  336. number)))
  337. (pass-if "bytevector-ieee-double-{ref,set!}"
  338. (let ((b (make-bytevector 16))
  339. (number 3.14))
  340. (bytevector-ieee-double-set! b 0 number (endianness little))
  341. (bytevector-ieee-double-set! b 8 number (endianness big))
  342. (equal? (bytevector-ieee-double-ref b 0 (endianness little))
  343. (bytevector-ieee-double-ref b 8 (endianness big))))))
  344. ;; Default to the C locale for the following tests.
  345. (when (defined? 'setlocale)
  346. (setlocale LC_ALL "C"))
  347. (with-test-prefix "2.9 Operations on Strings"
  348. (pass-if "string->utf8"
  349. (let* ((str "hello, world")
  350. (utf8 (string->utf8 str)))
  351. (and (bytevector? utf8)
  352. (= (bytevector-length utf8)
  353. (string-length str))
  354. (equal? (string->list str)
  355. (map integer->char (bytevector->u8-list utf8))))))
  356. (pass-if "string->utf8 [latin-1]"
  357. (let* ((str "hé, ça va bien ?")
  358. (utf8 (string->utf8 str)))
  359. (and (bytevector? utf8)
  360. (= (bytevector-length utf8)
  361. (+ 2 (string-length str))))))
  362. (pass-if "string->utf16"
  363. (let* ((str "hello, world")
  364. (utf16 (string->utf16 str)))
  365. (and (bytevector? utf16)
  366. (= (bytevector-length utf16)
  367. (* 2 (string-length str)))
  368. (equal? (string->list str)
  369. (map integer->char
  370. (bytevector->uint-list utf16
  371. (endianness big) 2))))))
  372. (pass-if "string->utf16 [little]"
  373. (let* ((str "hello, world")
  374. (utf16 (string->utf16 str (endianness little))))
  375. (and (bytevector? utf16)
  376. (= (bytevector-length utf16)
  377. (* 2 (string-length str)))
  378. (equal? (string->list str)
  379. (map integer->char
  380. (bytevector->uint-list utf16
  381. (endianness little) 2))))))
  382. (pass-if "string->utf32"
  383. (let* ((str "hello, world")
  384. (utf32 (string->utf32 str)))
  385. (and (bytevector? utf32)
  386. (= (bytevector-length utf32)
  387. (* 4 (string-length str)))
  388. (equal? (string->list str)
  389. (map integer->char
  390. (bytevector->uint-list utf32
  391. (endianness big) 4))))))
  392. (pass-if "string->utf32 [Greek]"
  393. (let* ((str "Ἄνεμοι")
  394. (utf32 (string->utf32 str)))
  395. (and (bytevector? utf32)
  396. (equal? (bytevector->uint-list utf32 (endianness big) 4)
  397. '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9)))))
  398. (pass-if "string->utf32 [little]"
  399. (let* ((str "hello, world")
  400. (utf32 (string->utf32 str (endianness little))))
  401. (and (bytevector? utf32)
  402. (= (bytevector-length utf32)
  403. (* 4 (string-length str)))
  404. (equal? (string->list str)
  405. (map integer->char
  406. (bytevector->uint-list utf32
  407. (endianness little) 4))))))
  408. (pass-if "utf8->string"
  409. (let* ((utf8 (u8-list->bytevector (map char->integer
  410. (string->list "hello, world"))))
  411. (str (utf8->string utf8)))
  412. (and (string? str)
  413. (= (string-length str)
  414. (bytevector-length utf8))
  415. (equal? (string->list str)
  416. (map integer->char (bytevector->u8-list utf8))))))
  417. (pass-if "utf8->string [latin-1]"
  418. (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
  419. (str (utf8->string utf8)))
  420. (and (string? str)
  421. (= (string-length str)
  422. (- (bytevector-length utf8) 2)))))
  423. (pass-if-equal "utf8->string [replacement character]"
  424. '(104 105 65533)
  425. (map char->integer
  426. (string->list (utf8->string #vu8(104 105 239 191 189)))))
  427. (pass-if-exception "utf8->string [invalid encoding]"
  428. exception:decoding-error
  429. (utf8->string #vu8(104 105 239 191 50)))
  430. (pass-if "utf16->string"
  431. (let* ((utf16 (uint-list->bytevector (map char->integer
  432. (string->list "hello, world"))
  433. (endianness big) 2))
  434. (str (utf16->string utf16)))
  435. (and (string? str)
  436. (= (* 2 (string-length str))
  437. (bytevector-length utf16))
  438. (equal? (string->list str)
  439. (map integer->char
  440. (bytevector->uint-list utf16 (endianness big)
  441. 2))))))
  442. (pass-if "utf16->string [little]"
  443. (let* ((utf16 (uint-list->bytevector (map char->integer
  444. (string->list "hello, world"))
  445. (endianness little) 2))
  446. (str (utf16->string utf16 (endianness little))))
  447. (and (string? str)
  448. (= (* 2 (string-length str))
  449. (bytevector-length utf16))
  450. (equal? (string->list str)
  451. (map integer->char
  452. (bytevector->uint-list utf16 (endianness little)
  453. 2))))))
  454. (pass-if "utf32->string"
  455. (let* ((utf32 (uint-list->bytevector (map char->integer
  456. (string->list "hello, world"))
  457. (endianness big) 4))
  458. (str (utf32->string utf32)))
  459. (and (string? str)
  460. (= (* 4 (string-length str))
  461. (bytevector-length utf32))
  462. (equal? (string->list str)
  463. (map integer->char
  464. (bytevector->uint-list utf32 (endianness big)
  465. 4))))))
  466. (pass-if "utf32->string [little]"
  467. (let* ((utf32 (uint-list->bytevector (map char->integer
  468. (string->list "hello, world"))
  469. (endianness little) 4))
  470. (str (utf32->string utf32 (endianness little))))
  471. (and (string? str)
  472. (= (* 4 (string-length str))
  473. (bytevector-length utf32))
  474. (equal? (string->list str)
  475. (map integer->char
  476. (bytevector->uint-list utf32 (endianness little)
  477. 4)))))))
  478. (with-test-prefix "Datum Syntax"
  479. (pass-if "empty"
  480. (equal? (with-input-from-string "#vu8()" read)
  481. (make-bytevector 0)))
  482. (pass-if "simple"
  483. (equal? (with-input-from-string "#vu8(1 2 3 4 5)" read)
  484. (u8-list->bytevector '(1 2 3 4 5))))
  485. (pass-if ">127"
  486. (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
  487. (u8-list->bytevector '(0 255 127 128))))
  488. (pass-if "self-evaluating?"
  489. (self-evaluating? (make-bytevector 1)))
  490. (pass-if "self-evaluating"
  491. (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
  492. (current-module))
  493. (u8-list->bytevector '(1 2 3 4 5))))
  494. (pass-if "quoted"
  495. (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read)
  496. (current-module))
  497. (u8-list->bytevector '(1 2 3 4 5))))
  498. (pass-if "literal simple"
  499. (equal? #vu8(1 2 3 4 5)
  500. (u8-list->bytevector '(1 2 3 4 5))))
  501. (pass-if "literal >127"
  502. (equal? #vu8(0 255 127 128)
  503. (u8-list->bytevector '(0 255 127 128))))
  504. (pass-if "literal quoted"
  505. (equal? '#vu8(1 2 3 4 5)
  506. (u8-list->bytevector '(1 2 3 4 5))))
  507. (pass-if-exception "incorrect prefix"
  508. exception:read-error
  509. (with-input-from-string "#vi8(1 2 3)" read))
  510. (pass-if-exception "extraneous space"
  511. exception:read-error
  512. (with-input-from-string "#vu8 (1 2 3)" read))
  513. (pass-if-exception "negative integers"
  514. exception:wrong-type-arg
  515. (with-input-from-string "#vu8(-1 -2 -3)" read))
  516. (pass-if-exception "out-of-range integers"
  517. exception:wrong-type-arg
  518. (with-input-from-string "#vu8(0 256)" read)))
  519. (with-test-prefix "Arrays"
  520. (pass-if "array?"
  521. (array? #vu8(1 2 3)))
  522. (pass-if "array-length"
  523. (equal? (iota 16)
  524. (map array-length
  525. (map make-bytevector (iota 16)))))
  526. (pass-if "array-ref"
  527. (let ((bv #vu8(255 127)))
  528. (and (= 255 (array-ref bv 0))
  529. (= 127 (array-ref bv 1)))))
  530. (pass-if-exception "array-ref [index out-of-range]"
  531. exception:out-of-range
  532. (let ((bv #vu8(1 2)))
  533. (array-ref bv 2)))
  534. (pass-if "array-set!"
  535. (let ((bv (make-bytevector 2)))
  536. (array-set! bv 255 0)
  537. (array-set! bv 77 1)
  538. (equal? '(255 77)
  539. (bytevector->u8-list bv))))
  540. (pass-if-exception "array-set! [index out-of-range]"
  541. exception:out-of-range
  542. (let ((bv (make-bytevector 2)))
  543. (array-set! bv 0 2)))
  544. (pass-if-exception "array-set! [value out-of-range]"
  545. exception:out-of-range
  546. (let ((bv (make-bytevector 2)))
  547. (array-set! bv 256 0)))
  548. (pass-if "array-type"
  549. (eq? 'vu8 (array-type #vu8())))
  550. (pass-if "array-contents"
  551. (let ((bv (u8-list->bytevector (iota 10))))
  552. (eq? bv (array-contents bv))))
  553. (pass-if "array-ref"
  554. (let ((bv (u8-list->bytevector (iota 10))))
  555. (equal? (iota 10)
  556. (map (lambda (i) (array-ref bv i))
  557. (iota 10)))))
  558. (pass-if "array-set!"
  559. (let ((bv (make-bytevector 10)))
  560. (for-each (lambda (i)
  561. (array-set! bv i i))
  562. (iota 10))
  563. (equal? (iota 10)
  564. (bytevector->u8-list bv))))
  565. (pass-if "make-typed-array"
  566. (let ((bv (make-typed-array 'vu8 77 33)))
  567. (equal? bv (u8-list->bytevector (make-list 33 77)))))
  568. (pass-if-exception "make-typed-array [out-of-range]"
  569. exception:out-of-range
  570. (make-typed-array 'vu8 256 77)))
  571. (with-test-prefix "uniform-array->bytevector"
  572. (pass-if "bytevector"
  573. (let ((bv #vu8(0 1 128 255)))
  574. (equal? bv (uniform-array->bytevector bv))))
  575. (pass-if "empty bitvector"
  576. (let ((bv (uniform-array->bytevector (make-bitvector 0))))
  577. (equal? bv #vu8())))
  578. (pass-if "bitvector < 8"
  579. (let ((bv (uniform-array->bytevector (make-bitvector 4 #t))))
  580. (= (bytevector-length bv) 4)))
  581. (pass-if "bitvector == 8"
  582. (let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
  583. (= (bytevector-length bv) 4)))
  584. (pass-if "bitvector > 8"
  585. (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
  586. (= (bytevector-length bv) 4)))
  587. (pass-if "bitvector == 32"
  588. (let ((bv (uniform-array->bytevector (make-bitvector 32 #t))))
  589. (= (bytevector-length bv) 4)))
  590. (pass-if "bitvector > 32"
  591. (let ((bv (uniform-array->bytevector (make-bitvector 33 #t))))
  592. (= (bytevector-length bv) 8))))
  593. (with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors"
  594. ;; This failed prior to Guile 2.0.12.
  595. ;; See <http://bugs.gnu.org/18866>.
  596. (pass-if-equal "bytevector-copy on srfi-4 arrays"
  597. (make-bytevector 8 #xFF)
  598. (bytevector-copy (make-u32vector 2 #xFFFFFFFF))))
  599. ;;; Local Variables:
  600. ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
  601. ;;; End: