(module schemeunit mzscheme (require "random.ss" (lib "etc.ss") (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))) (require-for-syntax (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 1)) (planet "combinators.ss" ("cce" "combinators.plt" 1 4))) (provide 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 (test-randomly stx) (syntax-case stx () [(t-r name count ([var gen] ...) body ...) (begin (check-stx! string? "a string literal" #'name stx) (check-stx! integer? "an integer literal" #'count stx) (check-stx-list! symbol? "an identifier" #'(var ...) stx) (with-syntax ([(tag ...) (map (curry syntax-prefix "FastTest ") (syntax->list #'(var ...)))]) (syntax/loc stx (apply test-suite name (build-list count (lambda (index) (test-case (number->string (+ index 1)) (let* ([var (generate gen)] ...) (with-check-info (['tag var] ...) body ...)))))))))])) )