test_is.clj: Replaced 'report' with a more flexible multimethod.

This should make it easier to write other reporting formats,
such as JUnit.
Also updated test_is/tests.clj and test_is/tap.clj

2 files changed, 52 insertions, 41 deletions

diff --git a/src/clojure/contrib/test_is/tap.clj b/src/clojure/contrib/test_is/tap.clj
index ae43c0d0..47310d15 100644
--- a/src/clojure/contrib/test_is/tap.clj
+++ b/src/clojure/contrib/test_is/tap.clj
@@ -66,45 +66,47 @@
   (println "not ok" msg))
 
 ;; This multimethod will override test-is/report
-(defmulti tap-report (fn [event msg expected actual] event))
-
-(defmethod tap-report :info [event msg expected actual]
-  (print-tap-diagnostic msg))
-
-(defmethod tap-report :pass [event msg expected actual]
-  (t/inc-report-counter :pass)
-  (print-tap-pass (t/testing-vars-str))
-  (when (seq t/*testing-contexts*)
-    (print-tap-diagnostic (t/testing-contexts-str)))
-  (when msg
-    (print-tap-diagnostic msg))
-  (print-tap-diagnostic (str "expected:" (pr-str expected)))
-  (print-tap-diagnostic (str "  actual:" (pr-str actual))))
-
-(defmethod tap-report :error [event msg expected actual]
-  (t/inc-report-counter :error)
-  (print-tap-fail (t/testing-vars-str))
-  (when (seq t/*testing-contexts*)
-    (print-tap-diagnostic (t/testing-contexts-str)))
-  (when msg
-    (print-tap-diagnostic msg))
-  (print-tap-diagnostic "expected:" (pr-str expected))
-  (print-tap-diagnostic "  actual: ")
-  (print-tap-diagnostic
-   (with-out-str
-    (if (instance? Throwable actual)
-      (stack/print-cause-trace actual t/*stack-trace-depth*)
-      (prn actual)))))
-
-;; This function will overriede test-is/print-results
-(defn tap-print-results [r]
-  (print-tap-plan (+ (:pass r) (:fail r) (:error r))))
+(defmulti tap-report (fn [data] (:type data)))
+
+(defmethod tap-report :default [data]
+  (t/with-test-out
+   (print-tap-diagnostic (pr-str data))))
+
+(defmethod tap-report :pass [data]
+  (t/with-test-out
+   (t/inc-report-counter :pass)
+   (print-tap-pass (t/testing-vars-str))
+   (when (seq t/*testing-contexts*)
+     (print-tap-diagnostic (t/testing-contexts-str)))
+   (when (:message data)
+     (print-tap-diagnostic (:message data)))
+   (print-tap-diagnostic (str "expected:" (pr-str (:expected data))))
+   (print-tap-diagnostic (str "  actual:" (pr-str (:actual data))))))
+
+(defmethod tap-report :error [data]
+  (t/with-test-out
+   (t/inc-report-counter :error)
+   (print-tap-fail (t/testing-vars-str))
+   (when (seq t/*testing-contexts*)
+     (print-tap-diagnostic (t/testing-contexts-str)))
+   (when (:message data)
+     (print-tap-diagnostic (:message data)))
+   (print-tap-diagnostic "expected:" (pr-str (:expected data)))
+   (print-tap-diagnostic "  actual: ")
+   (print-tap-diagnostic
+    (with-out-str
+      (if (instance? Throwable (:actual data))
+        (stack/print-cause-trace (:actual data) t/*stack-trace-depth*)
+        (prn (:actual data)))))))
+
+(defmethod tap-report :summary [data]
+  (t/with-test-out
+   (print-tap-plan (+ (:pass data) (:fail data) (:error data)))))
 
 
 (defmacro with-tap-output
   "Execute body with modified test-is reporting functions that produce
   TAP output"
   [& body]
-  `(binding [t/report tap-report
-             t/print-results tap-print-results]
+  `(binding [t/report tap-report]
      ~@body))
diff --git a/src/clojure/contrib/test_is/tests.clj b/src/clojure/contrib/test_is/tests.clj
index 6687ad12..60fee95e 100644
--- a/src/clojure/contrib/test_is/tests.clj
+++ b/src/clojure/contrib/test_is/tests.clj
@@ -89,12 +89,21 @@
 
 (declare original-report)
 
-(defn custom-report [event msg expected actual]
-  (if (or (and (= event :fail) (= msg "Should fail"))
-          (and (= event :pass) (= msg "Should pass"))
-          (and (= event :error) (= msg "Should error")))
-    (original-report :pass msg expected actual)
-    (original-report :fail (str msg " but got " event) expected actual)))
+(defn custom-report [data]
+  (let [event (:type data)
+        msg (:message data)
+        expected (:expected data)
+        actual (:actual data)
+        passed (cond
+                 (= event :fail) (= msg "Should fail")
+                 (= event :pass) (= msg "Should pass")
+                 (= event :error) (= msg "Should error")
+                 :else true)]
+    (if passed
+      (original-report {:type :pass, :message msg,
+                        :expected expected, :actual actual})
+      (original-report {:type :fail, :message (str msg " but got " event)
+                        :expected expected, :actual actual}))))
 
 ;; test-ns-hook will be used by test-is/test-ns to run tests in this
 ;; namespace.