Add message attribute to JUnit failure/error elements

src/mb/hawk/junit/write.clj

@@ -92,6 +92,13 @@
   (.writeCharacters w "\n")
   (.writeEndElement w))
 
+(defn- root-cause-message
+  "Message of the root cause of `e` (the deepest exception in its cause chain). `clojure.test` reports an uncaught
+  exception with the generic message \"Uncaught exception, not in assertion.\", so for `:error` results the
+  exception's own message is far more useful as the `message` attribute."
+  [^Throwable e]
+  (ex-message (last (take-while some? (iterate ex-cause e)))))
+
 (defmulti ^:private write-assertion-result!*
   {:arglists '([^XMLStreamWriter w result])}
   (fn [_ result] (:type result)))
@@ -101,21 +108,28 @@
   nil)
 
 (defmethod write-assertion-result!* :fail
-  [w result]
+  [w {:keys [message], :as result}]
   (write-element!
    w "failure"
-   nil
+   (when message
+     {:message (decolorize-and-escape message)})
    (fn []
      (write-result-output! w result))))
 
 (defmethod write-assertion-result!* :error
-  [w {:keys [actual], :as result}]
-  (write-element!
-   w "error"
-   (when (instance? Throwable actual)
-     {:type (.getCanonicalName (class actual))})
-   (fn []
-     (write-result-output! w result))))
+  [w {:keys [actual message], :as result}]
+  ;; prefer the exception's own (root cause) message over `clojure.test`'s generic "Uncaught exception..." message,
+  ;; falling back to the latter when `actual` is not a Throwable or the exception has no message.
+  (let [message (or (when (instance? Throwable actual)
+                      (root-cause-message actual))
+                    message)]
+    (write-element!
+     w "error"
+     (cond-> nil
+       (instance? Throwable actual) (assoc :type (.getCanonicalName (class actual)))
+       message                      (assoc :message (decolorize-and-escape message)))
+     (fn []
+       (write-result-output! w result)))))
 
 (defn- write-assertion-result! [w result]
   (try

test/mb/hawk/junit/write_test.clj

@@ -0,0 +1,78 @@
+(ns mb.hawk.junit.write-test
+  (:require
+   [clojure.test :refer :all]
+   [clojure.xml :as xml]
+   [mb.hawk.junit.write :as write])
+  (:import
+   (java.io ByteArrayInputStream StringWriter)
+   (javax.xml.stream XMLOutputFactory XMLStreamWriter)))
+
+(set! *warn-on-reflection* true)
+
+(defn- result->element
+  "Run `result` through the (private) assertion writer and parse the single element it produces, returning an XML
+  map of the shape `{:tag ..., :attrs {...}, :content [...]}`."
+  [result]
+  (let [sw                 (StringWriter.)
+        ^XMLStreamWriter w (.createXMLStreamWriter (XMLOutputFactory/newInstance) sw)]
+    (.writeStartDocument w)
+    (#'write/write-assertion-result!* w result)
+    (.writeEndDocument w)
+    (.flush w)
+    (xml/parse (ByteArrayInputStream. (.getBytes (str sw) "UTF-8")))))
+
+(def ^:private base-result
+  {:file             "write_test.clj"
+   :line             42
+   :testing-contexts []
+   :expected         1
+   :actual           2
+   :diffs            nil})
+
+(deftest failure-message-attribute-test
+  (testing "a :fail with a :message gets a `message` attribute on the <failure> element"
+    (let [{:keys [tag attrs]} (result->element (assoc base-result :type :fail :message "should be equal"))]
+      (is (= :failure tag))
+      (is (= "should be equal" (:message attrs)))))
+
+  (testing "a :fail without a :message has no `message` attribute"
+    (let [{:keys [tag attrs]} (result->element (assoc base-result :type :fail :message nil))]
+      (is (= :failure tag))
+      (is (not (contains? attrs :message))))))
+
+(def ^:private uncaught-message
+  "The generic message `clojure.test` attaches to any exception that escapes a test var."
+  "Uncaught exception, not in assertion.")
+
+(deftest error-message-attribute-test
+  (testing "an :error uses the exception's own message (not clojure.test's generic one) alongside `type`"
+    (let [{:keys [tag attrs]} (result->element (assoc base-result
+                                                      :type :error
+                                                      :message uncaught-message
+                                                      :actual (ex-info "kaboom" {})))]
+      (is (= :error tag))
+      (is (= "clojure.lang.ExceptionInfo" (:type attrs)))
+      (is (= "kaboom" (:message attrs)))))
+
+  (testing "an :error uses the *root cause* message when the exception has a cause chain"
+    (let [{:keys [attrs]} (result->element (assoc base-result
+                                                  :type :error
+                                                  :message uncaught-message
+                                                  :actual (ex-info "outer" {} (ex-info "deadlock - the real cause" {}))))]
+      (is (= "deadlock - the real cause" (:message attrs)))))
+
+  (testing "an :error falls back to the clojure.test :message when :actual is not a Throwable"
+    (let [{:keys [attrs]} (result->element (assoc base-result
+                                                  :type :error
+                                                  :message "some non-exception message"
+                                                  :actual :not-a-throwable))]
+      (is (not (contains? attrs :type)))
+      (is (= "some non-exception message" (:message attrs)))))
+
+  (testing "an :error with no exception message and no :message has `type` but no `message`"
+    (let [{:keys [attrs]} (result->element (assoc base-result
+                                                  :type :error
+                                                  :message nil
+                                                  :actual (Throwable.)))]
+      (is (= "java.lang.Throwable" (:type attrs)))
+      (is (not (contains? attrs :message))))))