;;; run-tests.chicken-test-egg.scm ;;; ;;; csi -R r7rs -s run-tests.chicken-test-egg.scm (import (scheme base) (bytestructures utils) (bytestructures) (bytestructures numeric-metadata) (bytestructures bytevectors) (bytestructures explicit-endianness) (test)) (define-syntax-rule (test-eqv name expected expr) (test name expected expr)) (define-syntax-rule (test-= name expected expr) (test name expected expr #;0)) (define-syntax-rule (maybe-skip-syntax . ) (if-syntax-case (begin . ) (begin))) (test-begin "bytestructures") (test-group "numeric" (define-syntax test-numeric-descriptors (syntax-rules () ((_ ...) (let () (define (destructure-numeric-descriptor-entry descriptor-entry proc) (define descriptor (list-ref descriptor-entry 0)) (define name (list-ref descriptor-entry 1)) (define getter (list-ref descriptor-entry 2)) (define setter (list-ref descriptor-entry 3)) (define size (bytestructure-descriptor-size descriptor)) (define float? (assq descriptor float-descriptors)) (define signed? (or float? (assq descriptor signed-integer-descriptors))) (proc descriptor name getter setter size float? signed?)) (define (get-min/max float? signed? size) (cond (float? (inexact (expt 2 (case size ((4) 24) ((8) 53))))) (signed? (- (expt 256 (- size 1)))) (else (- (expt 256 size) 1)))) (destructure-numeric-descriptor-entry (assq numeric-descriptors) (lambda (descriptor name getter setter size float? signed?) (test-group (symbol->string name) (let ((test-value-1 (if float? 1.0 1)) (test-value-2 (if float? 2.0 1))) (test-group "procedural" (define min/max (get-min/max float? signed? size)) (define bs (bytestructure descriptor)) (test-eqv "size" size (bytevector-length (bytestructure-bytevector bs))) (test-= "ref" test-value-1 (begin (setter (bytestructure-bytevector bs) 0 test-value-1) (bytestructure-ref bs))) (test-= "set" test-value-2 (begin (bytestructure-set! bs test-value-2) (getter (bytestructure-bytevector bs) 0))) (test-= "min/max" min/max (begin (bytestructure-set! bs min/max) (bytestructure-ref bs)))) (maybe-skip-syntax (test-group "syntactic" (define min/max (get-min/max float? signed? size)) ;; Must insert the top-level reference here. (define-bytestructure-accessors bs-unwrapper bs-getter bs-setter) (define bv (make-bytevector size)) (test-= "ref" test-value-1 (begin (setter bv 0 test-value-1) (bs-getter bv))) (test-= "set" test-value-2 (begin (bs-setter bv test-value-2) (getter bv 0))) (test-= "min/max" min/max (begin (bs-setter bv min/max) (bs-getter bv))))))))) ...)))) (test-numeric-descriptors float32 float32le float32be float64 float64le float64be int8 int16 int32 int64 int16le int32le int64le int16be int32be int64be uint8 uint16 uint32 uint64 uint16le uint32le uint64le uint16be uint32be uint64be)) (test-exit)