1 ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
2 ;;;; Martin Grabmueller, 2001-06-26
4 ;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013 Free Software Foundation, Inc.
6 ;;;; This library is free software; you can redistribute it and/or
7 ;;;; modify it under the terms of the GNU Lesser General Public
8 ;;;; License as published by the Free Software Foundation; either
9 ;;;; version 3 of the License, or (at your option) any later version.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
16 ;;;; You should have received a copy of the GNU Lesser General Public
17 ;;;; License along with this library; if not, write to the Free Software
18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (use-modules (srfi srfi-4)
24 (with-test-prefix "u8 vectors"
26 (pass-if "u8vector? success"
27 (u8vector? (u8vector)))
29 (pass-if "u8vector? failure"
30 (not (u8vector? (s8vector))))
32 (pass-if "u8vector-length success 1"
33 (= (u8vector-length (u8vector)) 0))
35 (pass-if "u8vector-length success 2"
36 (= (u8vector-length (u8vector 3)) 1))
38 (pass-if "u8vector-length failure"
39 (not (= (u8vector-length (u8vector 3)) 3)))
41 (pass-if "u8vector-ref"
42 (= (u8vector-ref (u8vector 1 2 3) 1) 2))
44 (pass-if "u8vector-set!/ref"
45 (= (let ((s (make-u8vector 10 0)))
46 (u8vector-set! s 4 33)
47 (u8vector-ref s 4)) 33))
49 (pass-if "u8vector->list/list->u8vector"
50 (equal? (u8vector->list (u8vector 1 2 3 4))
51 (u8vector->list (list->u8vector '(1 2 3 4)))))
53 (pass-if "u8vector->list/uniform-vector->list"
54 (equal? (u8vector->list (u8vector 1 2 3 4))
55 (uniform-vector->list (u8vector 1 2 3 4))))
57 (pass-if "make-u8vector"
58 (equal? (list->u8vector '(7 7 7 7))
59 (make-u8vector 4 7))))
61 (with-test-prefix "s8 vectors"
63 (pass-if "s8vector? success"
64 (s8vector? (s8vector)))
66 (pass-if "s8vector? failure"
67 (not (s8vector? (u8vector))))
69 (pass-if "s8vector-length success 1"
70 (= (s8vector-length (s8vector)) 0))
72 (pass-if "s8vector-length success 2"
73 (= (s8vector-length (s8vector -3)) 1))
75 (pass-if "s8vector-length failure"
76 (not (= (s8vector-length (s8vector 3)) 3)))
78 (pass-if "s8vector-ref"
79 (= (s8vector-ref (s8vector 1 2 3) 1) 2))
81 (pass-if "s8vector-set!/ref"
82 (= (let ((s (make-s8vector 10 0)))
83 (s8vector-set! s 4 33)
84 (s8vector-ref s 4)) 33))
86 (pass-if "s8vector->list/list->s8vector"
87 (equal? (s8vector->list (s8vector 1 2 3 4))
88 (s8vector->list (list->s8vector '(1 2 3 4)))))
90 (pass-if "s8vector->list/uniform-vector->list"
91 (equal? (s8vector->list (s8vector 1 2 3 4))
92 (uniform-vector->list (s8vector 1 2 3 4))))
94 (pass-if "make-s8vector"
95 (equal? (list->s8vector '(7 7 7 7))
96 (make-s8vector 4 7))))
99 (with-test-prefix "u16 vectors"
101 (pass-if "u16vector? success"
102 (u16vector? (u16vector)))
104 (pass-if "u16vector? failure"
105 (not (u16vector? (s16vector))))
107 (pass-if "u16vector-length success 1"
108 (= (u16vector-length (u16vector)) 0))
110 (pass-if "u16vector-length success 2"
111 (= (u16vector-length (u16vector 3)) 1))
113 (pass-if "u16vector-length failure"
114 (not (= (u16vector-length (u16vector 3)) 3)))
116 (pass-if "u16vector-ref"
117 (= (u16vector-ref (u16vector 1 2 3) 1) 2))
119 (pass-if "u16vector-set!/ref"
120 (= (let ((s (make-u16vector 10 0)))
121 (u16vector-set! s 4 33)
122 (u16vector-ref s 4)) 33))
124 (pass-if "u16vector->list/list->u16vector"
125 (equal? (u16vector->list (u16vector 1 2 3 4))
126 (u16vector->list (list->u16vector '(1 2 3 4)))))
128 (pass-if "u16vector->list/uniform-vector->list"
129 (equal? (u16vector->list (u16vector 1 2 3 4))
130 (uniform-vector->list (u16vector 1 2 3 4))))
132 (pass-if "make-u16vector"
133 (equal? (list->u16vector '(7 7 7 7))
134 (make-u16vector 4 7))))
136 (with-test-prefix "s16 vectors"
138 (pass-if "s16vector? success"
139 (s16vector? (s16vector)))
141 (pass-if "s16vector? failure"
142 (not (s16vector? (u16vector))))
144 (pass-if "s16vector-length success 1"
145 (= (s16vector-length (s16vector)) 0))
147 (pass-if "s16vector-length success 2"
148 (= (s16vector-length (s16vector -3)) 1))
150 (pass-if "s16vector-length failure"
151 (not (= (s16vector-length (s16vector 3)) 3)))
153 (pass-if "s16vector-ref"
154 (= (s16vector-ref (s16vector 1 2 3) 1) 2))
156 (pass-if "s16vector-set!/ref"
157 (= (let ((s (make-s16vector 10 0)))
158 (s16vector-set! s 4 33)
159 (s16vector-ref s 4)) 33))
161 (pass-if "s16vector->list/list->s16vector"
162 (equal? (s16vector->list (s16vector 1 2 3 4))
163 (s16vector->list (list->s16vector '(1 2 3 4)))))
165 (pass-if "s16vector->list/uniform-vector->list"
166 (equal? (s16vector->list (s16vector 1 2 3 4))
167 (uniform-vector->list (s16vector 1 2 3 4))))
169 (pass-if "make-s16vector"
170 (equal? (list->s16vector '(7 7 7 7))
171 (make-s16vector 4 7))))
173 (with-test-prefix "u32 vectors"
175 (pass-if "u32vector? success"
176 (u32vector? (u32vector)))
178 (pass-if "u32vector? failure"
179 (not (u32vector? (s32vector))))
181 (pass-if "u32vector-length success 1"
182 (= (u32vector-length (u32vector)) 0))
184 (pass-if "u32vector-length success 2"
185 (= (u32vector-length (u32vector 3)) 1))
187 (pass-if "u32vector-length failure"
188 (not (= (u32vector-length (u32vector 3)) 3)))
190 (pass-if "u32vector-ref"
191 (= (u32vector-ref (u32vector 1 2 3) 1) 2))
193 (pass-if "u32vector-set!/ref"
194 (= (let ((s (make-u32vector 10 0)))
195 (u32vector-set! s 4 33)
196 (u32vector-ref s 4)) 33))
198 (pass-if "u32vector->list/list->u32vector"
199 (equal? (u32vector->list (u32vector 1 2 3 4))
200 (u32vector->list (list->u32vector '(1 2 3 4)))))
202 (pass-if "u32vector->list/uniform-vector->list"
203 (equal? (u32vector->list (u32vector 1 2 3 4))
204 (uniform-vector->list (u32vector 1 2 3 4))))
206 (pass-if "make-u32vector"
207 (equal? (list->u32vector '(7 7 7 7))
208 (make-u32vector 4 7))))
210 (with-test-prefix "s32 vectors"
212 (pass-if "s32vector? success"
213 (s32vector? (s32vector)))
215 (pass-if "s32vector? failure"
216 (not (s32vector? (u32vector))))
218 (pass-if "s32vector-length success 1"
219 (= (s32vector-length (s32vector)) 0))
221 (pass-if "s32vector-length success 2"
222 (= (s32vector-length (s32vector -3)) 1))
224 (pass-if "s32vector-length failure"
225 (not (= (s32vector-length (s32vector 3)) 3)))
227 (pass-if "s32vector-ref"
228 (= (s32vector-ref (s32vector 1 2 3) 1) 2))
230 (pass-if "s32vector-set!/ref"
231 (= (let ((s (make-s32vector 10 0)))
232 (s32vector-set! s 4 33)
233 (s32vector-ref s 4)) 33))
235 (pass-if "s32vector->list/list->s32vector"
236 (equal? (s32vector->list (s32vector 1 2 3 4))
237 (s32vector->list (list->s32vector '(1 2 3 4)))))
239 (pass-if "s32vector->list/uniform-vector->list"
240 (equal? (s32vector->list (s32vector 1 2 3 4))
241 (uniform-vector->list (s32vector 1 2 3 4))))
243 (pass-if "make-s32vector"
244 (equal? (list->s32vector '(7 7 7 7))
245 (make-s32vector 4 7))))
247 (with-test-prefix "u64 vectors"
249 (pass-if "u64vector? success"
250 (u64vector? (u64vector)))
252 (pass-if "u64vector? failure"
253 (not (u64vector? (s64vector))))
255 (pass-if "u64vector-length success 1"
256 (= (u64vector-length (u64vector)) 0))
258 (pass-if "u64vector-length success 2"
259 (= (u64vector-length (u64vector 3)) 1))
261 (pass-if "u64vector-length failure"
262 (not (= (u64vector-length (u64vector 3)) 3)))
264 (pass-if "u64vector-ref"
265 (= (u64vector-ref (u64vector 1 2 3) 1) 2))
267 (pass-if "u64vector-set!/ref"
268 (= (let ((s (make-u64vector 10 0)))
269 (u64vector-set! s 4 33)
270 (u64vector-ref s 4)) 33))
272 (pass-if "u64vector->list/list->u64vector"
273 (equal? (u64vector->list (u64vector 1 2 3 4))
274 (u64vector->list (list->u64vector '(1 2 3 4)))))
276 (pass-if "u64vector->list/uniform-vector->list"
277 (equal? (u64vector->list (u64vector 1 2 3 4))
278 (uniform-vector->list (u64vector 1 2 3 4))))
280 (pass-if "make-u64vector"
281 (equal? (list->u64vector '(7 7 7 7))
282 (make-u64vector 4 7))))
284 (with-test-prefix "s64 vectors"
286 (pass-if "s64vector? success"
287 (s64vector? (s64vector)))
289 (pass-if "s64vector? failure"
290 (not (s64vector? (u64vector))))
292 (pass-if "s64vector-length success 1"
293 (= (s64vector-length (s64vector)) 0))
295 (pass-if "s64vector-length success 2"
296 (= (s64vector-length (s64vector -3)) 1))
298 (pass-if "s64vector-length failure"
299 (not (= (s64vector-length (s64vector 3)) 3)))
301 (pass-if "s64vector-ref"
302 (= (s64vector-ref (s64vector 1 2 3) 1) 2))
304 (pass-if "s64vector-set!/ref"
305 (= (let ((s (make-s64vector 10 0)))
306 (s64vector-set! s 4 33)
307 (s64vector-ref s 4)) 33))
309 (pass-if "s64vector->list/list->s64vector"
310 (equal? (s64vector->list (s64vector 1 2 3 4))
311 (s64vector->list (list->s64vector '(1 2 3 4)))))
313 (pass-if "s64vector->list/uniform-vector->list"
314 (equal? (s64vector->list (s64vector 1 2 3 4))
315 (uniform-vector->list (s64vector 1 2 3 4))))
317 (pass-if "make-s64vector"
318 (equal? (list->s64vector '(7 7 7 7))
319 (make-s64vector 4 7))))
321 (with-test-prefix "f32 vectors"
323 (pass-if "f32vector? success"
324 (f32vector? (f32vector)))
326 (pass-if "f32vector? failure"
327 (not (f32vector? (s8vector))))
329 (pass-if "f32vector-length success 1"
330 (= (f32vector-length (f32vector)) 0))
332 (pass-if "f32vector-length success 2"
333 (= (f32vector-length (f32vector -3)) 1))
335 (pass-if "f32vector-length failure"
336 (not (= (f32vector-length (f32vector 3)) 3)))
338 (pass-if "f32vector-ref"
339 (= (f32vector-ref (f32vector 1 2 3) 1) 2))
341 (pass-if "f32vector-set!/ref"
342 (= (let ((s (make-f32vector 10 0)))
343 (f32vector-set! s 4 33)
344 (f32vector-ref s 4)) 33))
346 (pass-if "f32vector->list/list->f32vector"
347 (equal? (f32vector->list (f32vector 1 2 3 4))
348 (f32vector->list (list->f32vector '(1 2 3 4)))))
350 (pass-if "f32vector->list/uniform-vector->list"
351 (equal? (f32vector->list (f32vector 1 2 3 4))
352 (uniform-vector->list (f32vector 1 2 3 4))))
354 (pass-if "make-f32vector"
355 (equal? (list->f32vector '(7 7 7 7))
356 (make-f32vector 4 7)))
358 (pass-if "+inf.0, -inf.0, +nan.0 in f32vector"
359 (f32vector? #f32(+inf.0 -inf.0 +nan.0))))
361 (with-test-prefix "f64 vectors"
363 (pass-if "f64vector? success"
364 (f64vector? (f64vector)))
366 (pass-if "f64vector? failure"
367 (not (f64vector? (f32vector))))
369 (pass-if "f64vector-length success 1"
370 (= (f64vector-length (f64vector)) 0))
372 (pass-if "f64vector-length success 2"
373 (= (f64vector-length (f64vector -3)) 1))
375 (pass-if "f64vector-length failure"
376 (not (= (f64vector-length (f64vector 3)) 3)))
378 (pass-if "f64vector-ref"
379 (= (f64vector-ref (f64vector 1 2 3) 1) 2))
381 (pass-if "f64vector-set!/ref"
382 (= (let ((s (make-f64vector 10 0)))
383 (f64vector-set! s 4 33)
384 (f64vector-ref s 4)) 33))
386 (pass-if "f64vector->list/list->f64vector"
387 (equal? (f64vector->list (f64vector 1 2 3 4))
388 (f64vector->list (list->f64vector '(1 2 3 4)))))
390 (pass-if "f64vector->list/uniform-vector->list"
391 (equal? (f64vector->list (f64vector 1 2 3 4))
392 (uniform-vector->list (f64vector 1 2 3 4))))
394 (pass-if "make-f64vector"
395 (equal? (list->f64vector '(7 7 7 7))
396 (make-f64vector 4 7)))
398 (pass-if "+inf.0, -inf.0, +nan.0 in f64vector"
399 (f64vector? #f64(+inf.0 -inf.0 +nan.0))))
401 (with-test-prefix "c32 vectors"
403 (pass-if "c32vector? success"
404 (c32vector? (c32vector)))
406 (pass-if "c32vector? failure"
407 (not (c32vector? (s8vector))))
409 (pass-if "c32vector-length success 1"
410 (= (c32vector-length (c32vector)) 0))
412 (pass-if "c32vector-length success 2"
413 (= (c32vector-length (c32vector -3-2i)) 1))
415 (pass-if "c32vector-length failure"
416 (not (= (c32vector-length (c32vector 3)) 3)))
418 (pass-if "c32vector-ref"
419 (= (c32vector-ref (c32vector 1 2+13i 3) 1) 2+13i))
421 (pass-if "c32vector-set!/ref"
422 (= (let ((s (make-c32vector 10 0)))
423 (c32vector-set! s 4 33-1i)
424 (c32vector-ref s 4)) 33-1i))
426 (pass-if "c32vector->list/list->c32vector"
427 (equal? (c32vector->list (c32vector 1 2 3 4))
428 (c32vector->list (list->c32vector '(1 2 3 4)))))
430 (pass-if "c32vector->list/uniform-vector->list"
431 (equal? (c32vector->list (c32vector 1 2 3 4))
432 (uniform-vector->list (c32vector 1 2 3 4))))
434 (pass-if "make-c32vector"
435 (equal? (list->c32vector '(7 7 7 7))
436 (make-c32vector 4 7)))
438 (pass-if "+inf.0, -inf.0, +nan.0 in c32vector"
439 (c32vector? #c32(+inf.0 -inf.0 +nan.0)))
442 (let ((v (c32vector 1+1i)))
443 (= (c32vector-ref v 0)
446 (pass-if "array-set!"
450 (= x (array-ref v 0))))
452 (pass-if-exception "array-ref, out-of-range"
453 exception:out-of-range
454 (array-ref (c32vector 1.0) 1))
456 (pass-if-exception "array-set!, out-of-range"
457 exception:out-of-range
458 (array-set! (c32vector 1.0) 2.0 1)))
460 (with-test-prefix "c64 vectors"
462 (pass-if "c64vector? success"
463 (c64vector? (c64vector)))
465 (pass-if "c64vector? failure"
466 (not (c64vector? (s8vector))))
468 (pass-if "c64vector-length success 1"
469 (= (c64vector-length (c64vector)) 0))
471 (pass-if "c64vector-length success 2"
472 (= (c64vector-length (c64vector -3-2i)) 1))
474 (pass-if "c64vector-length failure"
475 (not (= (c64vector-length (c64vector 3)) 3)))
477 (pass-if "c64vector-ref"
478 (= (c64vector-ref (c64vector 1+2i 2+3i 3) 1) 2+3i))
480 (pass-if "c64vector-set!/ref"
481 (= (let ((s (make-c64vector 10 0)))
482 (c64vector-set! s 4 33+1i)
483 (c64vector-ref s 4)) 33+1i))
485 (pass-if "c64vector->list/list->c64vector"
486 (equal? (c64vector->list (c64vector 1 2 3 4))
487 (c64vector->list (list->c64vector '(1 2 3 4)))))
489 (pass-if "c64vector->list/uniform-vector->list"
490 (equal? (c64vector->list (c64vector 1 2 3 4))
491 (uniform-vector->list (c64vector 1 2 3 4))))
493 (pass-if "make-c64vector"
494 (equal? (list->c64vector '(7 7 7 7))
495 (make-c64vector 4 7)))
497 (pass-if "+inf.0, -inf.0, +nan.0 in c64vector"
498 (c64vector? #c64(+inf.0 -inf.0 +nan.0)))
501 (let ((v (c64vector 1+1i)))
502 (= (c64vector-ref v 0)
505 (pass-if "array-set!"
509 (= x (array-ref v 0))))
511 (pass-if-exception "array-ref, out-of-range"
512 exception:out-of-range
513 (array-ref (c64vector 1.0) 1))
515 (pass-if-exception "array-set!, out-of-range"
516 exception:out-of-range
517 (array-set! (c64vector 1.0) 2.0 1)))
519 (with-test-prefix "accessing uniform vectors of different types"
521 (pass-if "u32vector-length of u16vector"
522 (= 2 (u32vector-length (make-u16vector 4))))
524 (pass-if "u32vector-length of u8vector"
525 (= 2 (u32vector-length (make-u8vector 8))))
527 (pass-if "u8vector-length of u16vector"
528 (= 4 (u8vector-length (make-u16vector 2))))
530 (pass-if "u8vector-length of u32vector"
531 (= 8 (u8vector-length (make-u32vector 2))))
533 (pass-if "u32vector-set! of u16vector"
534 (let ((v (make-u16vector 4 #xFFFF)))
535 (u32vector-set! v 1 0)
536 (equal? v #u16(#xFFFF #xFFFF 0 0))))
538 (pass-if "u16vector-set! of u32vector"
539 (let ((v (make-u32vector 2 #xFFFFFFFF)))
540 (u16vector-set! v 2 0)
541 (u16vector-set! v 3 0)
542 (equal? v #u32(#xFFFFFFFF 0)))))