converters/codec-check.ss
#lang scheme

(require (planet schematics/schemeunit))

(define-syntax my-check-equal?
  (syntax-rules ()
    [(_ a b)
       (call-with-exception-handler (λ (e) (display (format "ERROR ~s == ~s~n" 'a 'b)) e)
                                    (λ () (check-equal? a b)))]))

(define (check-codec encode decode decoded encoded)
  (my-check-equal? (decode (encode decoded)) decoded)
  (my-check-equal? (encode (decode encoded)) encoded)
  (my-check-equal? (decode encoded) decoded)
  (my-check-equal? (encode decoded) encoded))


(define (test-codec name casts encode decode)
  (test-suite 
   name
   (let loop ([casts casts] [index 1])
     (if (null? casts) (void)
         (let ([cast (car casts)])
           (let ([name (car cast)]
                 [decoded (cadr cast)]
                 [encoded (cddr cast)])
             (test-case
              name
              (check-codec encode decode decoded encoded)))
           (loop (cdr casts) (+ index 1)))))))

(provide check-codec test-codec (all-from-out (planet schematics/schemeunit)))