Source

clojuresque / clojuresque-runtime / src / main / resources / clojuresque / tasks / test_junit.clj

The default branch has multiple heads

Full commit
(ns clojuresque.tasks.test-junit
  (:use
    [clojure.test :only (run-tests report successful? *test-out* *report-counters*) :as t]
    [clojure.test.junit :only (junit-report with-junit-output) :as j]
    [clojuresque.cli :only (deftask)]
    [clojuresque.util :only (namespaces)]))


(def escape-xml-map
  (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp])))

(defn- escape-xml [text]
  (apply str (map #(escape-xml-map % %) text)))

(defn xml-escaping-writer
  [writer]
  (proxy
    [java.io.FilterWriter] [writer]
    (write [text]
      (if (string? text)
        (.write writer (escape-xml text))
        (.write writer text)))))

(defn tee-writer
  "Returns a java.io.Writer which delegates write and flush to <writer> and to System/out.
   close is delegated to <writer> only as we don't want to close System/out." 
  [writer]
  (let [out (java.io.OutputStreamWriter. System/out)]
    (proxy
      [java.io.Writer] []
      (write 
        ([cbuf off len]
          (.write writer cbuf off len)
          (.write out cbuf off len))
        ([text]
          (.write writer text)
          (.write out text)))

      (flush []
        (.flush writer)
        (.flush out))

      (close []
        (.close writer))
      )))

(defn add-counters [results counters]
  (merge-with + results counters))

(defn escape-file-path 
  "Escapes the given file path so that it's safe for inclusion in a Clojure string literal."
  [directory file]
  (-> (java.io.File. directory file)
    (.getPath)
    (.replace "\\" "\\\\")))

(defn test-namespace-with-junit-output
  "Run all tests in the namespace with junit output.
   Writes test output to a file called <namespace>.xml in <output-dir>
   XML escapes *out* so that it's safe for inclusion in the JUnit XML report file." 
  [namespace output-dir]
  (with-open [writer (clojure.java.io/writer (str (escape-file-path output-dir (str namespace ".xml"))))
              escaped-file-writer (xml-escaping-writer writer)
              out (tee-writer escaped-file-writer)]
    (binding [*test-out* writer *out* out]
      (with-junit-output
        (run-tests namespace)))))
  
(deftask test-namespaces
  "Run all tests in the namespaces of the given files by virtue of clojure.test with additional junit output.
   Writes test output to a file called <namespace>.xml in <output-dir>
   XML escapes *out* so that it's safe for inclusion in the JUnit XML report file." 
  [[output-dir o "Directory to wirite JUnit XML result files."]
   files]
  (.mkdir (java.io.File. output-dir))
  (let [namespaces (namespaces files)]
    (apply require namespaces)
    (let [results (atom {:type :summary})
          current-ns (atom nil)
          failed (atom [])
          report-orig report
          junit-report-orig junit-report]
      ; Change junit-report so that it also prints to System/out (using clojure.test/report) and records summaries for each namespace tested 
      (binding [junit-report (fn [x] 
                               (junit-report-orig x)
                               (when (or (= :begin-test-ns (:type x)) (= :summary (:type x))
                                         ; This works for clojure.test but not for Midje which has it's own set of failure types.
                                         ; Midje always prints failures to *out* anyway though.
                                         (= :fail (:type x))(= :error (:type x)))
                                 (binding [*test-out* (java.io.OutputStreamWriter. System/out)
                                           *report-counters* nil]
                                   (report-orig x)
                                   ; Ensure all output is flushed - report :error doesn't flush anything after expected if actual is a Throwable
                                   (.flush *test-out*)))
                               ; Record results for each namespace for later result checking and reporting
                               (when (= :begin-test-ns (:type x))
                                 (reset! current-ns (ns-name (:ns x))))
                               (when (= :summary (:type x))
                                 (when (or (pos? (:fail x)) (pos? (:error x)))
                                   (swap! failed conj [@current-ns x]))
                                 (swap! results add-counters (dissoc x :type))))]
        ; test each namespace individually to allow per ns reporting of failures at the end
        (doseq [namespace namespaces]
          (test-namespace-with-junit-output namespace output-dir))
        ; prevent agent pools from hanging the build
        (if (:test @results)
          (do
            (println "\nTotals:")
            (report @results)
            (println)
            (if (successful? @results)
              (do
                (println "Success!!!")
                true)
              (do
                (println "\n!!! There were test failures:")
                ; Print results for each namespace which was unsuccessful
                (doseq [[ns summary] @failed]
                  (println ns ": " (:fail summary) "failures," (:error summary) "errors."))
                (println)
                false)))
          true)))))