From 3a0f0792be5a5e4e8bfa659e766bca5e54215f49 Mon Sep 17 00:00:00 2001
From: "Thomas M. Hermann" <thomas.m.hermann@odonata-research.com>
Date: Wed, 13 Mar 2013 22:44:49 -0500
Subject: [PATCH] Replace assert-class function with generic function
 record-failure.

Better facilitates extensions.
---
 lisp-unit.lisp | 58 ++++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 42 insertions(+), 16 deletions(-)

diff --git a/lisp-unit.lisp b/lisp-unit.lisp
index cfa7038..ba5a7fb 100644
--- a/lisp-unit.lisp
+++ b/lisp-unit.lisp
@@ -406,6 +406,10 @@ assertion.")
   (:documentation
    "Return the result of the assertion."))
 
+(defgeneric record-failure (type form actual expected extras test)
+  (:documentation
+   "Record the details of the failure."))
+
 (defclass failure-result ()
   ((form
     :initarg :form
@@ -429,6 +433,15 @@ assertion.")
   (:documentation
    "Failure details of the assertion."))
 
+(defmethod record-failure (class form actual expected extras test)
+  "Return an instance of the failure result."
+  (make-instance class
+                 :form form
+                 :actual actual
+                 :expected expected
+                 :extras extras
+                 :test test))
+
 (defclass equal-result (failure-result)
   ()
   (:documentation
@@ -440,6 +453,11 @@ assertion.")
    (<= (length expected) (length actual))
    (every test expected actual)))
 
+(defmethod record-failure ((type (eql :equal))
+                           form actual expected extras test)
+  "Return an instance of an equal failure result."
+  (call-next-method 'equal-result form actual expected extras test))
+
 (defclass error-result (failure-result)
   ()
   (:documentation
@@ -452,6 +470,11 @@ assertion.")
    (eql (car actual) (car expected))
    (typep (car actual) (car expected))))
 
+(defmethod record-failure ((type (eql :error))
+                           form actual expected extras test)
+  "Return an instance of an error failure result."
+  (call-next-method 'error-result form actual expected extras test))
+
 (defclass macro-result (failure-result)
   ()
   (:documentation
@@ -480,6 +503,11 @@ assertion.")
   (declare (ignore test))
   (%expansion-equal (first expected) (first actual)))
 
+(defmethod record-failure ((type (eql :macro))
+                           form actual expected extras test)
+  "Return an instance of a macro failure result."
+  (call-next-method 'macro-result form actual expected extras test))
+
 (defclass boolean-result (failure-result)
   ()
   (:documentation
@@ -490,6 +518,11 @@ assertion.")
   (declare (ignore test))
   (logically-equal (car actual) (car expected)))
 
+(defmethod record-failure ((type (eql :result))
+                           form actual expected extras test)
+  "Return an instance of a boolean failure result."
+  (call-next-method 'boolean-result form actual expected extras test))
+
 (defclass output-result (failure-result)
   ()
   (:documentation
@@ -502,14 +535,10 @@ assertion.")
    (string-trim '(#\newline #\return #\space) (car actual))
    (car expected)))
 
-(defun assert-class (type)
-  "Return the class for the assertion type."
-  (ecase type
-    (:equal 'equal-result)
-    (:error 'error-result)
-    (:macro 'macro-result)
-    (:result 'boolean-result)
-    (:output 'output-result)))
+(defmethod record-failure ((type (eql :output))
+                           form actual expected extras test)
+  "Return an instance of an output failure result."
+  (call-next-method 'output-result form actual expected extras test))
 
 (defun internal-assert
        (type form code-thunk expected-thunk extras test)
@@ -519,14 +548,11 @@ assertion.")
          (result (assert-result type test expected actual)))
     (if result
         (incf *pass*)
-        (push (make-instance
-               (assert-class type)
-               :form form
-               :actual actual
-               :expected expected
-               :extras (when extras (funcall extras))
-               :test test)
-              *fail*))
+        (push
+         (record-failure
+          type form actual expected
+          (when extras (funcall extras)) test)
+         *fail*))
     ;; Return the result
     result))
 
-- 
2.11.4.GIT