doctest-macros.scm

; Treat these four procedures as black boxes. You don't need to
; understand how they work.
(define (display-test code actual expected)
  (define passed (equal? actual expected))
  (display code) (display " -> ") (display actual)
  (if passed
      (display " PASS")
      (begin
        (display " FAIL - expected ")
        (display expected)))
  (newline)
  passed)
(define (display-results results)
  (display (apply + (map (lambda (x) (if x 1 0)) results)))
  (display " passed, ")
  (display (apply + (map (lambda (x) (if x 0 1)) results)))
  (display " failed") (newline) (newline))
(define (display-header name)
  (display "TESTS FOR ") (display name) (newline)
  (display "--------------------------------------------") (newline))
(define (display-overall-header)
  (display "OVERALL RESULTS") (newline)
  (display "--------------------------------------------") (newline))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Actual Doctest Example

; test macro
(define-macro (test . clauses)
  `(map (lambda (clause)
          (display-test (car clause)
                        (eval (car clause))
                        (car (cdr clause))))
        ',clauses))

;; (test
;;   ((+ 1 1) 2)
;;   ((+ 2 3) 5)
;;   ((* 2 2) 3))

; List of tests that have been defined so far
(define _tests nil)

; define-t works like define, except that the second operand
; should be a test
(define-macro (define-t header tests . body)
  (define name (car header))
  (define new-test (cons name tests))
  (set! _tests (cons new-test _tests))
  `(define ,header . ,body))

; Code that runs all of the doctests that have been added so far
(define (run-tests)
  (define results
    (map (lambda (x)
           (define name (car x))
           (define doctests (cdr x))
           (display-header name)
           (define results (eval doctests))
           (display-results results)
           results)
         _tests))
  (display-overall-header)
  (display-results (apply append results)))

; Examples:
;; (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))

;; (run-tests)