Add (anything) to tests that match... anything

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)