Added Common Lisp Bits & Pieces.

Common-Lisp-Bits-And-Pieces/Chapter-09/testing-framework.lisp

@@ -0,0 +1,38 @@
+(defpackage :BARRA-TESTING-FRAMEWORK
+  (:use :common-lisp))
+
+(in-package "BARRA-TESTING-FRAMEWORK")
+
+(defvar *test-name* nil)
+
+(defmacro with-gensyms ((&rest names) &body body)
+`(let ,(loop for n in names collect `(,n (gensym)))
+   ,@body))
+
+(defmacro deftest (name parameters &body body)
+  "Define a test function. Within a test function we can call
+   other test functions or use 'check' to run individual test
+   cases."
+  `(defun ,name ,parameters
+    (let ((*test-name* (append *test-name* (list ',name))))
+      ,@body)))
+
+(defmacro check (&body forms)
+  "Run each expression in 'forms' as a test case."
+  `(combine-results
+    ,@(loop for f in forms collect `(report-result ,f ',f))))
+
+(defmacro combine-results (&body forms)
+  "Combine the results (as booleans) of evaluating 'forms' in order."
+  (with-gensyms (result)
+    `(let ((,result t))
+      ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
+      ,result)))
+
+(defun report-result (result form)
+  "Report the results of a single test case. Called by 'check'."
+  (format t "~:[FAIL~;PASS~] - ~a: ~a~%" result *test-name* form)
+  result)
+
+(let ((pack (find-package :foo)))
+  (do-all-symbols (sym pack) (when (eql (symbol-package sym) pack) (export sym))))