(module schemeunit mzscheme (require "random.ss" (all-except (lib "etc.ss") identity) "planet.ss") (require-schemeunit "test.ss") (require-for-syntax-scheme-utils) (provide check-randomly test-randomly) (define-for-syntax (check-stx! ok? desc stx err-stx) (unless (ok? (syntax-e stx)) (raise-syntax-error #f (format "expected ~a" desc) stx err-stx))) (define-for-syntax (check-stx-list! ok? desc stx err-stx) (for-each (lambda (elem) (check-stx! ok? desc elem err-stx)) (syntax->list stx))) (define-syntax (check-randomly stx) (syntax-case stx () [(c-r ([var gen . optional] . rest) . body) (quasisyntax/loc stx (let*-random ([var gen . optional]) (with-check-info (['#,(text->identifier "random-" #'var #:stx #'var) var]) (c-r rest . body))))] [(c-r () . body) (syntax/loc stx (let* () . body))])) (define-syntax (test-randomly stx) (syntax-case stx () [(t-r name count clauses . body) (syntax/loc stx (apply test-suite name (build-list count (lambda (index) (test-case (number->string (+ index 1)) (check-randomly clauses . body))))))])) )