(module littleunit mzscheme
(require
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
(provide
(rename little-test-case test-case)
(rename little-test-case/name test-case/name)
(rename little-test/text-ui test/text-ui)
(all-from-except (planet "test.ss" ("schematics" "schemeunit.plt" 2)) test-case))
(define current-tests (make-parameter null))
(define auto-run-tests (make-parameter #t))
(define (auto-run?)
(auto-run-tests))
(define (add-test test)
(current-tests (cons test (current-tests))))
(define-syntax basic-test-case
(syntax-rules ()
[(basic-test-case name expr ...)
(let ([case (test-case name expr ...)])
(add-test case)
(when (auto-run?)
(test/text-ui case)))]))
(define-syntax little-test-case
(syntax-rules ()
[(little-test-case expr ...)
(basic-test-case "Unnamed test" expr ...)]))
(define-syntax little-test-case/name
(syntax-rules ()
([test-case/name name expr ...]
(basic-test-case name expr ...))))
(define (little-test/text-ui)
(test/text-ui (current-tests)))
)