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