103 lines
3.4 KiB
Racket
103 lines
3.4 KiB
Racket
(module srfi-4-test mzscheme
|
|
|
|
(require rackunit)
|
|
(require rackunit/text-ui
|
|
srfi/4)
|
|
|
|
(provide srfi-4-tests)
|
|
|
|
(define-syntax (check-struct-info-binding stx)
|
|
(syntax-case stx ()
|
|
[(_ name)
|
|
(if (identifier? (syntax name))
|
|
#'#t
|
|
#'(fail "Identifier not bound"))]))
|
|
|
|
(define-check (check-srfi-4-type make pred length ref set to-list from-list)
|
|
(check-pred pred (from-list '(1 2 3 4)))
|
|
(check-pred list? (to-list (from-list '(1 2 3 4))))
|
|
(check-equal? (to-list (from-list '(1 2 3 4))) '(1 2 3 4))
|
|
(check-pred pred (make 4 1))
|
|
(let ([vec (make 4 1)])
|
|
(check-equal? (ref vec 0) 1)
|
|
(check-equal? (ref vec 1) 1)
|
|
(check-equal? (ref vec 2) 1)
|
|
(check-equal? (ref vec 3) 1)
|
|
(set vec 0 5)
|
|
(check-equal? (ref vec 0) 5)
|
|
(check-equal? (length vec) 4)))
|
|
|
|
(define-check (check-srfi-4-float-type make pred length ref set to-list from-list)
|
|
(check-pred pred (from-list '(1. 2. 3. 4.)))
|
|
(check-pred list? (to-list (from-list '(1. 2. 3. 4.))))
|
|
(check-equal? (to-list (from-list '(1. 2. 3. 4.))) '(1. 2. 3. 4.))
|
|
(check-pred pred (make 4 1.))
|
|
(let ([vec (make 4 1.)])
|
|
(check-equal? (ref vec 0) 1.)
|
|
(check-equal? (ref vec 1) 1.)
|
|
(check-equal? (ref vec 2) 1.)
|
|
(check-equal? (ref vec 3) 1.)
|
|
(set vec 0 5.)
|
|
(check-equal? (ref vec 0) 5.)
|
|
(check-equal? (length vec) 4)))
|
|
|
|
(define srfi-4-tests
|
|
(test-suite
|
|
"All tests for srfi-4"
|
|
|
|
(test-case
|
|
"s8"
|
|
(check-srfi-4-type make-s8vector s8vector? s8vector-length s8vector-ref s8vector-set! s8vector->list list->s8vector)
|
|
(check-struct-info-binding s8))
|
|
|
|
(test-case
|
|
"u8"
|
|
(check-srfi-4-type make-u8vector u8vector? u8vector-length u8vector-ref u8vector-set! u8vector->list list->u8vector))
|
|
|
|
(test-case
|
|
"s16"
|
|
(check-srfi-4-type make-s16vector s16vector? s16vector-length s16vector-ref s16vector-set! s16vector->list list->s16vector)
|
|
(check-struct-info-binding s16))
|
|
|
|
(test-case
|
|
"u16"
|
|
(check-srfi-4-type make-u16vector u16vector? u16vector-length u16vector-ref u16vector-set! u16vector->list list->u16vector)
|
|
(check-struct-info-binding u16))
|
|
|
|
(test-case
|
|
"s32"
|
|
(check-srfi-4-type make-s32vector s32vector? s32vector-length s32vector-ref s32vector-set! s32vector->list list->s32vector)
|
|
(check-struct-info-binding s32))
|
|
|
|
(test-case
|
|
"u32"
|
|
(check-srfi-4-type make-u32vector u32vector? u32vector-length u32vector-ref u32vector-set! u32vector->list list->u32vector)
|
|
(check-struct-info-binding u32))
|
|
|
|
(test-case
|
|
"s64"
|
|
(check-srfi-4-type make-s64vector s64vector? s64vector-length s64vector-ref s64vector-set! s64vector->list list->s64vector)
|
|
(check-struct-info-binding s64))
|
|
|
|
(test-case
|
|
"u64"
|
|
(check-srfi-4-type make-u64vector u64vector? u64vector-length u64vector-ref u64vector-set! u64vector->list list->u64vector)
|
|
(check-struct-info-binding u64))
|
|
|
|
(test-case
|
|
"f32"
|
|
(check-srfi-4-float-type make-f32vector f32vector? f32vector-length f32vector-ref f32vector-set! f32vector->list list->f32vector)
|
|
(check-struct-info-binding f32))
|
|
|
|
(test-case
|
|
"f64"
|
|
(check-srfi-4-float-type make-f64vector f64vector? f64vector-length f64vector-ref f64vector-set! f64vector->list list->f64vector)
|
|
(check-struct-info-binding f64))
|
|
|
|
))
|
|
|
|
|
|
(run-tests srfi-4-tests)
|
|
|
|
)
|