Re: [Skwiki-clean] Common Lisp unit testing

[Darius B. <da...@ac...>]

I'm talking to myself here, but I might as well post the changes:

; A simple library for test-driven development -- see the self-tests at
; the bottom for an example of how to use it.
; TODO:
;  quickcheck
;  keep source-location info somehow?
;  record all results by adding to a global variable?
;   (uglier but easier to get started with without understanding)
;  hierarchical test names?
;  better naming?  i'm not very happy about some of the exported names.

(defpackage :qc
  (:export :test :is :isnt :is= :isnt= :tests
           :report
           :*debug* :*loud*
           :test-name :test-failed :test-detail))
(in-package :qc)


; Test constructors

(defmacro test (flag)
  `(run-tester '(test ,flag) (lambda () ,flag)))

(defmacro is (fn &rest operands)
  (is-macro `(is ,fn ,@operands) `#',fn operands))

(defmacro isnt (fn &rest operands)
  (is-macro `(isnt ,fn ,@operands) `(complement #',fn) operands))

(defmacro is= (&rest operands)
  (is-macro `(is= ,@operands) '#'equal operands))

(defmacro isnt= (&rest operands)
  (is-macro `(isnt= ,@operands) '(complement #'equal) operands))

(defun is-macro (form fn operands)
  `(run-is-tester ',form ,fn (lambda () (list ,@operands))))

(defun tests (&rest tests)
  "Return a compound test outcome made out of a list of outcomes."
  tests)


; Performing the tests

(defvar *debug* nil
  "When true, test failures jump us immediately into the debugger.")

(defstruct test 
  name    ; What test was run.
  failed  ; NIL if passed, T if failed, or a condition if an error occurred.
  detail) ; Function of no args to write more info to stdout.

(defmacro capture-stdout (&body body)
  `(with-output-to-string (*standard-output*)
     ,@body))

(defun remember (name failed &optional (detail (lambda () t)))
  "Make a test outcome, with appropriate interactive side effects."
  (when (and failed *debug*)
    (error "Test failed: ~S~a" name (capture-stdout (funcall detail))))
  (show-progress failed)
  (make-test :name name :failed failed :detail detail))

(defun run-tester (name passp-fn)
  "Return a test outcome from calling PASSP-FN."
  (remember name (call-tester passp-fn)))

(defun call-tester (passp-fn)
  "Call PASSP-FN and return whether it failed."
  (multiple-value-bind (passed condition)
                       (intercept-errors passp-fn)
    (or condition (not passed))))

(defun run-is-tester (name passp-fn arguments-fn)
  "Return a test outcome from applying PASSP-FN to the result of ARGUMENTS-FN."
  (multiple-value-bind (arguments condition)
                       (intercept-errors arguments-fn)
    (if condition
        (remember name condition)
        (remember name 
                  (call-tester (lambda () (apply passp-fn arguments)))
                  (lambda ()
                    (format t "~%  with values~{ ~S~}" arguments))))))

(defun intercept-errors (fn)
  (if *debug*
      (prog1 (funcall fn))
      (ignore-errors (prog1 (funcall fn)))))


; Reporting results

(defvar *loud* t
  "When true, we show progress as tests are run with dots to stdout.")

(defun show-progress (failed)
  "Write a single character as a bird's-eye view of a test result."
  (when *loud*
    (write-char (cond ((not failed) #\.)
                      ((eq t failed) #\X)
                      (t #\@)))))

(defun report (test)
  "Print out the interesting test results in longer form."
  (let ((tests (flatten test)))
    (mapc #'print-test (remove-if-not #'test-failed tests))
    (summarize tests)))

(defun flatten (test)
  "Reduce a possibly compound test to a list of test structs."
  (if (listp test)
      (mapcan #'flatten test)
      (list test)))

(defun print-test (test)
  (let ((failed (test-failed test)))
    (format t "~%~a ~S" (classify failed) (test-name test))
    (when (eq 'error (classify failed))
      (format t "~%  ~a" failed))
    (funcall (test-detail test))))

(defun classify (failed)
  (cond ((not failed) 'pass)
        ((eq t failed) 'fail)
        (t 'error)))

(defun summarize (tests)
  (let ((num-failed (count-if #'test-failed tests))
        (total (length tests)))
    (cond ((= 0 total)
           (format t "~%No tests attempted."))
          ((= 0 num-failed)
           (format t "~%All tests passed: ~a total." total))
          (t 
           (format t "~%~a test~p failed out of ~a total."
                   num-failed num-failed total)))))


; Self tests

(defmacro quietly (&body body)
  `(let ((*loud* nil))
     ,@body))

(defun self-test ()
  (tests
   (is= "." (capture-stdout (test t)))
   (is= "X" (capture-stdout (test nil)))
   (is= "@" (capture-stdout (test (/ 1 0))))
   (is= "@" (capture-stdout (is= 3 (/ 1 0))))
   (is= nil (test-failed (quietly (test t))))
   (is= t   (test-failed (quietly (test nil))))
   
   (is= "
No tests attempted."
        (capture-stdout (report (tests))))
   (is= "..
All tests passed: 2 total."
        (capture-stdout (report (tests (test t) (test t)))))
   (is= "X.
FAIL (TEST NIL)
1 test failed out of 2 total."
        (capture-stdout (report (tests (test nil) (test t)))))

   (is= "X
FAIL (IS = (+ 2 3) 4)
  with values 5 4
1 test failed out of 1 total."
        (capture-stdout (report (is = (+ 2 3) 4))))
   ))

(terpri) (report (self-test))