diff --git a/d-/test.scm b/d-/test.scm index a8ee521..b3a4471 100644 --- a/d-/test.scm +++ b/d-/test.scm @@ -1,21 +1,33 @@ (define-module (d- test) + #:use-module (srfi srfi-1) #:use-module (ice-9 format) #:use-module (ice-9 control) - #:export (define-test-suite)) + #:export (define-test-suite anything)) + +(define *anysym* (gensym)) +(define (anything) *anysym*) (define (assert expected actual eq? fail) - (when (not (eq? expected actual)) + (when (and (not (eq? expected actual))) (format #t "fail - expected ~a but got ~a" expected actual) (newline) (fail))) +(define (equal-or-any? expected actual) + (cond + [(eq? *anysym* expected) #t] + [(or (not (list? expected)) + (not (list? actual))) + (equal? expected actual)] + [else (every equal-or-any? expected actual)])) + (define-syntax define-test-suite (lambda (stx) (with-syntax ([fail (datum->syntax stx 'fail)]) (define (assert-stx expr) (syntax-case expr (assert-equal assert-not-equal assert-unspecified) - [(assert-equal e a) #'(assert e a equal? fail)] - [(assert-not-equal e a) #'(assert e a (compose not equal?) fail)] + [(assert-equal e a) #'(assert e a equal-or-any? fail)] + [(assert-not-equal e a) #'(assert e a (compose not equal-or-any?) fail)] [(assert-unspecified v) #'(assert (when #f 'a) v eq? fail)] [else #'else])) (define (define-test-stx test) diff --git a/test.scm b/test.scm index 4dc7554..5badd1d 100644 --- a/test.scm +++ b/test.scm @@ -1,7 +1,7 @@ (use-modules (d-) - (d- test) (d- json) - (srfi srfi-1)) + (srfi srfi-1) + (d- test)) (define-test-suite "~>" (define-test "unwrapped" @@ -116,6 +116,10 @@ (list betty ethel joan kitty mary))) (assert-equal '(3 5 2 1 4) (liars)))) +(define-test-suite "test" + (define-test "anything" + (assert-equal `(dog ,(anything)) '(dog cat)))) + (define-test-suite "json" (define-test "boolean" (assert-equal #t (json "true"))