Mercurial > lasercutter

annotate src/clojure/test/junit.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ; Copyright (c) Rich Hickey. All rights reserved.
rlm@10 2 ; The use and distribution terms for this software are covered by the
rlm@10 3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10 4 ; which can be found in the file epl-v10.html at the root of this distribution.
rlm@10 5 ; By using this software in any fashion, you are agreeing to be bound by
rlm@10 6 ; the terms of this license.
rlm@10 7 ; You must not remove this notice, or any other, from this software.
rlm@10 8
rlm@10 9 ;; test/junit.clj: Extension to clojure.test for JUnit-compatible XML output
rlm@10 10
rlm@10 11 ;; by Jason Sankey
rlm@10 12 ;; June 2009
rlm@10 13
rlm@10 14 ;; DOCUMENTATION
rlm@10 15 ;;
rlm@10 16
rlm@10 17 (ns ^{:doc "clojure.test extension for JUnit-compatible XML output.
rlm@10 18
rlm@10 19 JUnit (http://junit.org/) is the most popular unit-testing library
rlm@10 20 for Java. As such, tool support for JUnit output formats is
rlm@10 21 common. By producing compatible output from tests, this tool
rlm@10 22 support can be exploited.
rlm@10 23
rlm@10 24 To use, wrap any calls to clojure.test/run-tests in the
rlm@10 25 with-junit-output macro, like this:
rlm@10 26
rlm@10 27 (use 'clojure.test)
rlm@10 28 (use 'clojure.test.junit)
rlm@10 29
rlm@10 30 (with-junit-output
rlm@10 31 (run-tests 'my.cool.library))
rlm@10 32
rlm@10 33 To write the output to a file, rebind clojure.test/*test-out* to
rlm@10 34 your own PrintWriter (perhaps opened using
rlm@10 35 clojure.java.io/writer)."
rlm@10 36 :author "Jason Sankey"}
rlm@10 37 clojure.test.junit
rlm@10 38 (:require [clojure.stacktrace :as stack]
rlm@10 39 [clojure.test :as t]))
rlm@10 40
rlm@10 41 ;; copied from clojure.contrib.lazy-xml
rlm@10 42 (def ^{:private true}
rlm@10 43 escape-xml-map
rlm@10 44 (zipmap "'<>\"&" (map #(str \& % \;) '[apos lt gt quot amp])))
rlm@10 45 (defn- escape-xml [text]
rlm@10 46 (apply str (map #(escape-xml-map % %) text)))
rlm@10 47
rlm@10 48 (def *var-context*)
rlm@10 49 (def *depth*)
rlm@10 50
rlm@10 51 (defn indent
rlm@10 52 []
rlm@10 53 (dotimes [n (* *depth* 4)] (print " ")))
rlm@10 54
rlm@10 55 (defn start-element
rlm@10 56 [tag pretty & [attrs]]
rlm@10 57 (if pretty (indent))
rlm@10 58 (print (str "<" tag))
rlm@10 59 (if (seq attrs)
rlm@10 60 (doseq [[key value] attrs]
rlm@10 61 (print (str " " (name key) "=\"" (escape-xml value) "\""))))
rlm@10 62 (print ">")
rlm@10 63 (if pretty (println))
rlm@10 64 (set! *depth* (inc *depth*)))
rlm@10 65
rlm@10 66 (defn element-content
rlm@10 67 [content]
rlm@10 68 (print (escape-xml content)))
rlm@10 69
rlm@10 70 (defn finish-element
rlm@10 71 [tag pretty]
rlm@10 72 (set! *depth* (dec *depth*))
rlm@10 73 (if pretty (indent))
rlm@10 74 (print (str "</" tag ">"))
rlm@10 75 (if pretty (println)))
rlm@10 76
rlm@10 77 (defn test-name
rlm@10 78 [vars]
rlm@10 79 (apply str (interpose "."
rlm@10 80 (reverse (map #(:name (meta %)) vars)))))
rlm@10 81
rlm@10 82 (defn package-class
rlm@10 83 [name]
rlm@10 84 (let [i (.lastIndexOf name ".")]
rlm@10 85 (if (< i 0)
rlm@10 86 [nil name]
rlm@10 87 [(.substring name 0 i) (.substring name (+ i 1))])))
rlm@10 88
rlm@10 89 (defn start-case
rlm@10 90 [name classname]
rlm@10 91 (start-element 'testcase true {:name name :classname classname}))
rlm@10 92
rlm@10 93 (defn finish-case
rlm@10 94 []
rlm@10 95 (finish-element 'testcase true))
rlm@10 96
rlm@10 97 (defn suite-attrs
rlm@10 98 [package classname]
rlm@10 99 (let [attrs {:name classname}]
rlm@10 100 (if package
rlm@10 101 (assoc attrs :package package)
rlm@10 102 attrs)))
rlm@10 103
rlm@10 104 (defn start-suite
rlm@10 105 [name]
rlm@10 106 (let [[package classname] (package-class name)]
rlm@10 107 (start-element 'testsuite true (suite-attrs package classname))))
rlm@10 108
rlm@10 109 (defn finish-suite
rlm@10 110 []
rlm@10 111 (finish-element 'testsuite true))
rlm@10 112
rlm@10 113 (defn message-el
rlm@10 114 [tag message expected-str actual-str]
rlm@10 115 (indent)
rlm@10 116 (start-element tag false (if message {:message message} {}))
rlm@10 117 (element-content
rlm@10 118 (let [[file line] (t/file-position 5)
rlm@10 119 detail (apply str (interpose
rlm@10 120 "\n"
rlm@10 121 [(str "expected: " expected-str)
rlm@10 122 (str " actual: " actual-str)
rlm@10 123 (str " at: " file ":" line)]))]
rlm@10 124 (if message (str message "\n" detail) detail)))
rlm@10 125 (finish-element tag false)
rlm@10 126 (println))
rlm@10 127
rlm@10 128 (defn failure-el
rlm@10 129 [message expected actual]
rlm@10 130 (message-el 'failure message (pr-str expected) (pr-str actual)))
rlm@10 131
rlm@10 132 (defn error-el
rlm@10 133 [message expected actual]
rlm@10 134 (message-el 'error
rlm@10 135 message
rlm@10 136 (pr-str expected)
rlm@10 137 (if (instance? Throwable actual)
rlm@10 138 (with-out-str (stack/print-cause-trace actual t/*stack-trace-depth*))
rlm@10 139 (prn actual))))
rlm@10 140
rlm@10 141 ;; This multimethod will override test-is/report
rlm@10 142 (defmulti junit-report :type)
rlm@10 143
rlm@10 144 (defmethod junit-report :begin-test-ns [m]
rlm@10 145 (t/with-test-out
rlm@10 146 (start-suite (name (ns-name (:ns m))))))
rlm@10 147
rlm@10 148 (defmethod junit-report :end-test-ns [_]
rlm@10 149 (t/with-test-out
rlm@10 150 (finish-suite)))
rlm@10 151
rlm@10 152 (defmethod junit-report :begin-test-var [m]
rlm@10 153 (t/with-test-out
rlm@10 154 (let [var (:var m)]
rlm@10 155 (binding [*var-context* (conj *var-context* var)]
rlm@10 156 (start-case (test-name *var-context*) (name (ns-name (:ns (meta var)))))))))
rlm@10 157
rlm@10 158 (defmethod junit-report :end-test-var [m]
rlm@10 159 (t/with-test-out
rlm@10 160 (finish-case)))
rlm@10 161
rlm@10 162 (defmethod junit-report :pass [m]
rlm@10 163 (t/with-test-out
rlm@10 164 (t/inc-report-counter :pass)))
rlm@10 165
rlm@10 166 (defmethod junit-report :fail [m]
rlm@10 167 (t/with-test-out
rlm@10 168 (t/inc-report-counter :fail)
rlm@10 169 (failure-el (:message m)
rlm@10 170 (:expected m)
rlm@10 171 (:actual m))))
rlm@10 172
rlm@10 173 (defmethod junit-report :error [m]
rlm@10 174 (t/with-test-out
rlm@10 175 (t/inc-report-counter :error)
rlm@10 176 (error-el (:message m)
rlm@10 177 (:expected m)
rlm@10 178 (:actual m))))
rlm@10 179
rlm@10 180 (defmethod junit-report :default [_])
rlm@10 181
rlm@10 182 (defmacro with-junit-output
rlm@10 183 "Execute body with modified test-is reporting functions that write
rlm@10 184 JUnit-compatible XML output."
rlm@10 185 {:added "1.1"}
rlm@10 186 [& body]
rlm@10 187 `(binding [t/report junit-report
rlm@10 188 *var-context* (list)
rlm@10 189 *depth* 1]
rlm@10 190 (println "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")
rlm@10 191 (println "<testsuites>")
rlm@10 192 (let [result# ~@body]
rlm@10 193 (println "</testsuites>")
rlm@10 194 result#)))