Macros to add doctest-style tests to Scheme

testing.scm

(define-macro (test . tests)
  `(reduce (lambda (a b) (cons (+ (car a) (car b))
                                 (+ (cdr a) (cdr b))))
     (map (lambda (test)
            (define expr (car test))
            (define expect (car (cdr test)))
            (define actual (eval expr))
            (display expr)
            (display " -> ")
            (display actual)
            (if (equal? actual expect)
                (begin
                  (display " PASS")
                  (newline)
                  (cons 1 0))
                (begin
                  (display " FAIL - expected ")
                  (display expect)
                  (newline)
                  (cons 0 1))))
            ',tests)))
   
(define (_tests) (cons 0 0))

(define-macro (define-t header tests . body)
  (define name (car header))
  (define old-tests _tests)
  (set! _tests
    (lambda ()
      (define rest-results (old-tests))
      (display "TESTS FOR ") (display name) (newline)
      (display "--------------------------------------------") (newline)
      (define our-results (eval tests))
      (display (car our-results)) (display " passed, ")
      (display (cdr our-results)) (display " failed")
      (newline) (newline)
      (cons (+ (car our-results) (car rest-results))
            (+ (cdr our-results) (cdr rest-results)))))
  `(define ,header . ,body))

(define (run-tests)
  (define results (_tests))
  (display "Overall Results") (newline)
  (display "--------------------------------------------") (newline)
  (display (car results)) (display " passed, ")
  (display (cdr results)) (display " failed")
  (newline))

(define-t (square x)
  (test
    ((square 0) 0)
    ((square 5) 25)
    ((square -3) 9))
  (* x x))


(define-t (fact n)
  (test
    ((fact 0) 1)
    ((fact 3) 6)
    ((fact 5) 120))
  (define (fact-helper n t)
    (if (= n 0)
        t
        (fact-helper (- n 1)
                    (* n t))))
  (fact-helper n 1))