diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index ac6ce3792..da57f2ac0 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -20,293 +20,184 @@ (use-modules (srfi srfi-4)) -(with-test-prefix "u8 vectors" - - (pass-if "u8vector? success" - (u8vector? (u8vector))) - - (pass-if "u8vector? failure" - (not (u8vector? (s8vector)))) - - (pass-if "u8vector-length success 1" - (= (u8vector-length (u8vector)) 0)) - - (pass-if "u8vector-length success 2" - (= (u8vector-length (u8vector 3)) 1)) - - (pass-if "u8vector-length failure" - (not (= (u8vector-length (u8vector 3)) 3))) - - (pass-if "u8vector-ref" - (= (u8vector-ref (u8vector 1 2 3) 1) 2)) - - (pass-if "u8vector-set!/ref" - (= (let ((s (make-u8vector 10 0))) - (u8vector-set! s 4 33) - (u8vector-ref s 4)) 33)) - - (pass-if "u8vector->list/list->u8vector" - (equal? (u8vector->list (u8vector 1 2 3 4)) - (u8vector->list (list->u8vector '(1 2 3 4)))))) - -(with-test-prefix "s8 vectors" - - (pass-if "s8vector? success" - (s8vector? (s8vector))) - - (pass-if "s8vector? failure" - (not (s8vector? (u8vector)))) - - (pass-if "s8vector-length success 1" - (= (s8vector-length (s8vector)) 0)) - - (pass-if "s8vector-length success 2" - (= (s8vector-length (s8vector -3)) 1)) - - (pass-if "s8vector-length failure" - (not (= (s8vector-length (s8vector 3)) 3))) - - (pass-if "s8vector-ref" - (= (s8vector-ref (s8vector 1 2 3) 1) 2)) - - (pass-if "s8vector-set!/ref" - (= (let ((s (make-s8vector 10 0))) - (s8vector-set! s 4 33) - (s8vector-ref s 4)) 33)) - - (pass-if "s8vector->list/list->s8vector" - (equal? (s8vector->list (s8vector 1 2 3 4)) - (s8vector->list (list->s8vector '(1 2 3 4)))))) - - -(with-test-prefix "u16 vectors" - - (pass-if "u16vector? success" - (u16vector? (u16vector))) - - (pass-if "u16vector? failure" - (not (u16vector? (s16vector)))) - - (pass-if "u16vector-length success 1" - (= (u16vector-length (u16vector)) 0)) - - (pass-if "u16vector-length success 2" - (= (u16vector-length (u16vector 3)) 1)) - - (pass-if "u16vector-length failure" - (not (= (u16vector-length (u16vector 3)) 3))) - - (pass-if "u16vector-ref" - (= (u16vector-ref (u16vector 1 2 3) 1) 2)) - - (pass-if "u16vector-set!/ref" - (= (let ((s (make-u16vector 10 0))) - (u16vector-set! s 4 33) - (u16vector-ref s 4)) 33)) - - (pass-if "u16vector->list/list->u16vector" - (equal? (u16vector->list (u16vector 1 2 3 4)) - (u16vector->list (list->u16vector '(1 2 3 4)))))) - -(with-test-prefix "s16 vectors" - - (pass-if "s16vector? success" - (s16vector? (s16vector))) - - (pass-if "s16vector? failure" - (not (s16vector? (u16vector)))) - - (pass-if "s16vector-length success 1" - (= (s16vector-length (s16vector)) 0)) - - (pass-if "s16vector-length success 2" - (= (s16vector-length (s16vector -3)) 1)) - - (pass-if "s16vector-length failure" - (not (= (s16vector-length (s16vector 3)) 3))) - - (pass-if "s16vector-ref" - (= (s16vector-ref (s16vector 1 2 3) 1) 2)) - - (pass-if "s16vector-set!/ref" - (= (let ((s (make-s16vector 10 0))) - (s16vector-set! s 4 33) - (s16vector-ref s 4)) 33)) - - (pass-if "s16vector->list/list->s16vector" - (equal? (s16vector->list (s16vector 1 2 3 4)) - (s16vector->list (list->s16vector '(1 2 3 4)))))) - -(with-test-prefix "u32 vectors" - - (pass-if "u32vector? success" - (u32vector? (u32vector))) - - (pass-if "u32vector? failure" - (not (u32vector? (s32vector)))) - - (pass-if "u32vector-length success 1" - (= (u32vector-length (u32vector)) 0)) - - (pass-if "u32vector-length success 2" - (= (u32vector-length (u32vector 3)) 1)) - - (pass-if "u32vector-length failure" - (not (= (u32vector-length (u32vector 3)) 3))) - - (pass-if "u32vector-ref" - (= (u32vector-ref (u32vector 1 2 3) 1) 2)) - - (pass-if "u32vector-set!/ref" - (= (let ((s (make-u32vector 10 0))) - (u32vector-set! s 4 33) - (u32vector-ref s 4)) 33)) - - (pass-if "u32vector->list/list->u32vector" - (equal? (u32vector->list (u32vector 1 2 3 4)) - (u32vector->list (list->u32vector '(1 2 3 4)))))) - -(with-test-prefix "s32 vectors" - - (pass-if "s32vector? success" - (s32vector? (s32vector))) - - (pass-if "s32vector? failure" - (not (s32vector? (u32vector)))) - - (pass-if "s32vector-length success 1" - (= (s32vector-length (s32vector)) 0)) - - (pass-if "s32vector-length success 2" - (= (s32vector-length (s32vector -3)) 1)) - - (pass-if "s32vector-length failure" - (not (= (s32vector-length (s32vector 3)) 3))) - - (pass-if "s32vector-ref" - (= (s32vector-ref (s32vector 1 2 3) 1) 2)) - - (pass-if "s32vector-set!/ref" - (= (let ((s (make-s32vector 10 0))) - (s32vector-set! s 4 33) - (s32vector-ref s 4)) 33)) - - (pass-if "s32vector->list/list->s32vector" - (equal? (s32vector->list (s32vector 1 2 3 4)) - (s32vector->list (list->s32vector '(1 2 3 4)))))) - -(with-test-prefix "u64 vectors" - - (pass-if "u64vector? success" - (u64vector? (u64vector))) - - (pass-if "u64vector? failure" - (not (u64vector? (s64vector)))) - - (pass-if "u64vector-length success 1" - (= (u64vector-length (u64vector)) 0)) - - (pass-if "u64vector-length success 2" - (= (u64vector-length (u64vector 3)) 1)) - - (pass-if "u64vector-length failure" - (not (= (u64vector-length (u64vector 3)) 3))) - - (pass-if "u64vector-ref" - (= (u64vector-ref (u64vector 1 2 3) 1) 2)) - - (pass-if "u64vector-set!/ref" - (= (let ((s (make-u64vector 10 0))) - (u64vector-set! s 4 33) - (u64vector-ref s 4)) 33)) - - (pass-if "u64vector->list/list->u64vector" - (equal? (u64vector->list (u64vector 1 2 3 4)) - (u64vector->list (list->u64vector '(1 2 3 4)))))) - -(with-test-prefix "s64 vectors" - - (pass-if "s64vector? success" - (s64vector? (s64vector))) - - (pass-if "s64vector? failure" - (not (s64vector? (u64vector)))) - - (pass-if "s64vector-length success 1" - (= (s64vector-length (s64vector)) 0)) - - (pass-if "s64vector-length success 2" - (= (s64vector-length (s64vector -3)) 1)) - - (pass-if "s64vector-length failure" - (not (= (s64vector-length (s64vector 3)) 3))) - - (pass-if "s64vector-ref" - (= (s64vector-ref (s64vector 1 2 3) 1) 2)) - - (pass-if "s64vector-set!/ref" - (= (let ((s (make-s64vector 10 0))) - (s64vector-set! s 4 33) - (s64vector-ref s 4)) 33)) - - (pass-if "s64vector->list/list->s64vector" - (equal? (s64vector->list (s64vector 1 2 3 4)) - (s64vector->list (list->s64vector '(1 2 3 4)))))) - -(with-test-prefix "f32 vectors" - - (pass-if "f32vector? success" - (f32vector? (f32vector))) - - (pass-if "f32vector? failure" - (not (f32vector? (s8vector)))) - - (pass-if "f32vector-length success 1" - (= (f32vector-length (f32vector)) 0)) - - (pass-if "f32vector-length success 2" - (= (f32vector-length (f32vector -3)) 1)) - - (pass-if "f32vector-length failure" - (not (= (f32vector-length (f32vector 3)) 3))) - - (pass-if "f32vector-ref" - (= (f32vector-ref (f32vector 1 2 3) 1) 2)) - - (pass-if "f32vector-set!/ref" - (= (let ((s (make-f32vector 10 0))) - (f32vector-set! s 4 33) - (f32vector-ref s 4)) 33)) - - (pass-if "f32vector->list/list->f32vector" - (equal? (f32vector->list (f32vector 1 2 3 4)) - (f32vector->list (list->f32vector '(1 2 3 4)))))) - -(with-test-prefix "f64 vectors" - - (pass-if "f64vector? success" - (f64vector? (f64vector))) - - (pass-if "f64vector? failure" - (not (f64vector? (f32vector)))) - - (pass-if "f64vector-length success 1" - (= (f64vector-length (f64vector)) 0)) - - (pass-if "f64vector-length success 2" - (= (f64vector-length (f64vector -3)) 1)) - - (pass-if "f64vector-length failure" - (not (= (f64vector-length (f64vector 3)) 3))) - - (pass-if "f64vector-ref" - (= (f64vector-ref (f64vector 1 2 3) 1) 2)) - - (pass-if "f64vector-set!/ref" - (= (let ((s (make-f64vector 10 0))) - (f64vector-set! s 4 33) - (f64vector-ref s 4)) 33)) - - (pass-if "f64vector->list/list->f64vector" - (equal? (f64vector->list (f64vector 1 2 3 4)) - (f64vector->list (list->f64vector '(1 2 3 4)))))) +(define (test-uvector kind u? uconstruct umake uset uref ulen + uvec->list list->uvec + low high) + + (define (test-passthrough-write umake value) + (pass-if (string-append kind " vector write->read idempotency") + (let* ((v (umake 5 value)) + (str-rep (object->string v)) + (read-v (with-input-from-string str-rep read))) + (equal? v read-v)))) + + (with-test-prefix (string-append kind " vector") + + (pass-if (string-append kind "vector? success") + (u? (umake 0))) + + (pass-if (string-append kind "vector? failure") + (not (u? 0))) + + (pass-if (string-append kind "vector-length success 1") + (= (ulen (uconstruct)) 0)) + + (pass-if (string-append kind "vector-length success 2") + (= (ulen (uconstruct 3)) 1)) + + (pass-if (string-append kind "vector-length failure") + (not (= (ulen (uconstruct 3)) 3))) + + (pass-if (string-append kind "vector-ref") + (= (uref (uconstruct 1 2 3) 1) 2)) + + (pass-if (string-append kind "vector->list/list->vector") + (equal? (uvec->list (uconstruct 1 2 3 4)) + (uvec->list (list->uvec '(1 2 3 4))))) + + (test-passthrough-write umake 0) + (test-passthrough-write umake 1) + + (if (and low high) + ;; make sure we can store and retrieve values, including limits. + (let ((testvals `(("0" 0) + ("low" ,low) + ("high" ,high)))) + + (test-passthrough-write umake low) + (test-passthrough-write umake high) + + (for-each + (lambda (test) + (pass-if (string-append (string-append "fill " (car test))) + (= (cadr test) (uref (umake 1 (cadr test)) 0))) + (pass-if (string-append "set " (car test)) + (let ((vec (umake 1))) + (uset vec 0 (cadr test)) + (= (cadr test) (uref vec 0))))) + testvals))) + + (if (and low high) + ;; make sure we can't store and retrieve values outside the limits + (let ((testvals `(("(- low 1)" ,(- low 1)) + ("(+ high 1)" ,(+ high 1))))) + + (for-each + (lambda (test) + (pass-if-exception (string-append "fill " (car test)) + exception:out-of-range + (umake 1 (cadr test))) + (pass-if-exception (string-append "set " (car test)) + exception:out-of-range + (uset (umake 1) 0 (cadr test)))) + testvals))))) + +(test-uvector "u8" + u8vector? + u8vector + make-u8vector + u8vector-set! + u8vector-ref + u8vector-length + u8vector->list + list->u8vector + 0 255) + +(test-uvector "s8" + s8vector? + s8vector + make-s8vector + s8vector-set! + s8vector-ref + s8vector-length + s8vector->list + list->s8vector + -128 127) + +(test-uvector "u16" + u16vector? + u16vector + make-u16vector + u16vector-set! + u16vector-ref + u16vector-length + u16vector->list + list->u16vector + 0 65535) + +(test-uvector "s16" + s16vector? + s16vector + make-s16vector + s16vector-set! + s16vector-ref + s16vector-length + s16vector->list + list->s16vector + -32768 32767) + +(test-uvector "u32" + u32vector? + u32vector + make-u32vector + u32vector-set! + u32vector-ref + u32vector-length + u32vector->list + list->u32vector + 0 (- (expt 2 32) 1)) + +(test-uvector "s32" + s32vector? + s32vector + make-s32vector + s32vector-set! + s32vector-ref + s32vector-length + s32vector->list + list->s32vector + (- (expt 2 31)) (- (expt 2 31) 1)) + +(test-uvector "u64" + u64vector? + u64vector + make-u64vector + u64vector-set! + u64vector-ref + u64vector-length + u64vector->list + list->u64vector + 0 (- (expt 2 64) 1)) + +(test-uvector "s64" + s64vector? + s64vector + make-s64vector + s64vector-set! + s64vector-ref + s64vector-length + s64vector->list + list->s64vector + (- (expt 2 63)) (- (expt 2 63) 1)) + +(test-uvector "f32" + f32vector? + f32vector + make-f32vector + f32vector-set! + f32vector-ref + f32vector-length + f32vector->list + list->f32vector + #f #f) + +(test-uvector "f64" + f64vector? + f64vector + make-f64vector + f64vector-set! + f64vector-ref + f64vector-length + f64vector->list + list->f64vector + #f #f)