|
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.clj: test framework for Clojure
|
|
rlm@10
|
10
|
|
rlm@10
|
11 ;; by Stuart Sierra
|
|
rlm@10
|
12 ;; March 28, 2009
|
|
rlm@10
|
13
|
|
rlm@10
|
14 ;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
|
|
rlm@10
|
15 ;; contributions and suggestions.
|
|
rlm@10
|
16
|
|
rlm@10
|
17 (ns
|
|
rlm@10
|
18 ^{:author "Stuart Sierra, with contributions and suggestions by
|
|
rlm@10
|
19 Chas Emerick, Allen Rohner, and Stuart Halloway",
|
|
rlm@10
|
20 :doc "A unit testing framework.
|
|
rlm@10
|
21
|
|
rlm@10
|
22 ASSERTIONS
|
|
rlm@10
|
23
|
|
rlm@10
|
24 The core of the library is the \"is\" macro, which lets you make
|
|
rlm@10
|
25 assertions of any arbitrary expression:
|
|
rlm@10
|
26
|
|
rlm@10
|
27 (is (= 4 (+ 2 2)))
|
|
rlm@10
|
28 (is (instance? Integer 256))
|
|
rlm@10
|
29 (is (.startsWith \"abcde\" \"ab\"))
|
|
rlm@10
|
30
|
|
rlm@10
|
31 You can type an \"is\" expression directly at the REPL, which will
|
|
rlm@10
|
32 print a message if it fails.
|
|
rlm@10
|
33
|
|
rlm@10
|
34 user> (is (= 5 (+ 2 2)))
|
|
rlm@10
|
35
|
|
rlm@10
|
36 FAIL in (:1)
|
|
rlm@10
|
37 expected: (= 5 (+ 2 2))
|
|
rlm@10
|
38 actual: (not (= 5 4))
|
|
rlm@10
|
39 false
|
|
rlm@10
|
40
|
|
rlm@10
|
41 The \"expected:\" line shows you the original expression, and the
|
|
rlm@10
|
42 \"actual:\" shows you what actually happened. In this case, it
|
|
rlm@10
|
43 shows that (+ 2 2) returned 4, which is not = to 5. Finally, the
|
|
rlm@10
|
44 \"false\" on the last line is the value returned from the
|
|
rlm@10
|
45 expression. The \"is\" macro always returns the result of the
|
|
rlm@10
|
46 inner expression.
|
|
rlm@10
|
47
|
|
rlm@10
|
48 There are two special assertions for testing exceptions. The
|
|
rlm@10
|
49 \"(is (thrown? c ...))\" form tests if an exception of class c is
|
|
rlm@10
|
50 thrown:
|
|
rlm@10
|
51
|
|
rlm@10
|
52 (is (thrown? ArithmeticException (/ 1 0)))
|
|
rlm@10
|
53
|
|
rlm@10
|
54 \"(is (thrown-with-msg? c re ...))\" does the same thing and also
|
|
rlm@10
|
55 tests that the message on the exception matches the regular
|
|
rlm@10
|
56 expression re:
|
|
rlm@10
|
57
|
|
rlm@10
|
58 (is (thrown-with-msg? ArithmeticException #\"Divide by zero\"
|
|
rlm@10
|
59 (/ 1 0)))
|
|
rlm@10
|
60
|
|
rlm@10
|
61 DOCUMENTING TESTS
|
|
rlm@10
|
62
|
|
rlm@10
|
63 \"is\" takes an optional second argument, a string describing the
|
|
rlm@10
|
64 assertion. This message will be included in the error report.
|
|
rlm@10
|
65
|
|
rlm@10
|
66 (is (= 5 (+ 2 2)) \"Crazy arithmetic\")
|
|
rlm@10
|
67
|
|
rlm@10
|
68 In addition, you can document groups of assertions with the
|
|
rlm@10
|
69 \"testing\" macro, which takes a string followed by any number of
|
|
rlm@10
|
70 assertions. The string will be included in failure reports.
|
|
rlm@10
|
71 Calls to \"testing\" may be nested, and all of the strings will be
|
|
rlm@10
|
72 joined together with spaces in the final report, in a style
|
|
rlm@10
|
73 similar to RSpec <http://rspec.info/>
|
|
rlm@10
|
74
|
|
rlm@10
|
75 (testing \"Arithmetic\"
|
|
rlm@10
|
76 (testing \"with positive integers\"
|
|
rlm@10
|
77 (is (= 4 (+ 2 2)))
|
|
rlm@10
|
78 (is (= 7 (+ 3 4))))
|
|
rlm@10
|
79 (testing \"with negative integers\"
|
|
rlm@10
|
80 (is (= -4 (+ -2 -2)))
|
|
rlm@10
|
81 (is (= -1 (+ 3 -4)))))
|
|
rlm@10
|
82
|
|
rlm@10
|
83 Note that, unlike RSpec, the \"testing\" macro may only be used
|
|
rlm@10
|
84 INSIDE a \"deftest\" or \"with-test\" form (see below).
|
|
rlm@10
|
85
|
|
rlm@10
|
86
|
|
rlm@10
|
87 DEFINING TESTS
|
|
rlm@10
|
88
|
|
rlm@10
|
89 There are two ways to define tests. The \"with-test\" macro takes
|
|
rlm@10
|
90 a defn or def form as its first argument, followed by any number
|
|
rlm@10
|
91 of assertions. The tests will be stored as metadata on the
|
|
rlm@10
|
92 definition.
|
|
rlm@10
|
93
|
|
rlm@10
|
94 (with-test
|
|
rlm@10
|
95 (defn my-function [x y]
|
|
rlm@10
|
96 (+ x y))
|
|
rlm@10
|
97 (is (= 4 (my-function 2 2)))
|
|
rlm@10
|
98 (is (= 7 (my-function 3 4))))
|
|
rlm@10
|
99
|
|
rlm@10
|
100 As of Clojure SVN rev. 1221, this does not work with defmacro.
|
|
rlm@10
|
101 See http://code.google.com/p/clojure/issues/detail?id=51
|
|
rlm@10
|
102
|
|
rlm@10
|
103 The other way lets you define tests separately from the rest of
|
|
rlm@10
|
104 your code, even in a different namespace:
|
|
rlm@10
|
105
|
|
rlm@10
|
106 (deftest addition
|
|
rlm@10
|
107 (is (= 4 (+ 2 2)))
|
|
rlm@10
|
108 (is (= 7 (+ 3 4))))
|
|
rlm@10
|
109
|
|
rlm@10
|
110 (deftest subtraction
|
|
rlm@10
|
111 (is (= 1 (- 4 3)))
|
|
rlm@10
|
112 (is (= 3 (- 7 4))))
|
|
rlm@10
|
113
|
|
rlm@10
|
114 This creates functions named \"addition\" and \"subtraction\", which
|
|
rlm@10
|
115 can be called like any other function. Therefore, tests can be
|
|
rlm@10
|
116 grouped and composed, in a style similar to the test framework in
|
|
rlm@10
|
117 Peter Seibel's \"Practical Common Lisp\"
|
|
rlm@10
|
118 <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html>
|
|
rlm@10
|
119
|
|
rlm@10
|
120 (deftest arithmetic
|
|
rlm@10
|
121 (addition)
|
|
rlm@10
|
122 (subtraction))
|
|
rlm@10
|
123
|
|
rlm@10
|
124 The names of the nested tests will be joined in a list, like
|
|
rlm@10
|
125 \"(arithmetic addition)\", in failure reports. You can use nested
|
|
rlm@10
|
126 tests to set up a context shared by several tests.
|
|
rlm@10
|
127
|
|
rlm@10
|
128
|
|
rlm@10
|
129 RUNNING TESTS
|
|
rlm@10
|
130
|
|
rlm@10
|
131 Run tests with the function \"(run-tests namespaces...)\":
|
|
rlm@10
|
132
|
|
rlm@10
|
133 (run-tests 'your.namespace 'some.other.namespace)
|
|
rlm@10
|
134
|
|
rlm@10
|
135 If you don't specify any namespaces, the current namespace is
|
|
rlm@10
|
136 used. To run all tests in all namespaces, use \"(run-all-tests)\".
|
|
rlm@10
|
137
|
|
rlm@10
|
138 By default, these functions will search for all tests defined in
|
|
rlm@10
|
139 a namespace and run them in an undefined order. However, if you
|
|
rlm@10
|
140 are composing tests, as in the \"arithmetic\" example above, you
|
|
rlm@10
|
141 probably do not want the \"addition\" and \"subtraction\" tests run
|
|
rlm@10
|
142 separately. In that case, you must define a special function
|
|
rlm@10
|
143 named \"test-ns-hook\" that runs your tests in the correct order:
|
|
rlm@10
|
144
|
|
rlm@10
|
145 (defn test-ns-hook []
|
|
rlm@10
|
146 (arithmetic))
|
|
rlm@10
|
147
|
|
rlm@10
|
148
|
|
rlm@10
|
149 OMITTING TESTS FROM PRODUCTION CODE
|
|
rlm@10
|
150
|
|
rlm@10
|
151 You can bind the variable \"*load-tests*\" to false when loading or
|
|
rlm@10
|
152 compiling code in production. This will prevent any tests from
|
|
rlm@10
|
153 being created by \"with-test\" or \"deftest\".
|
|
rlm@10
|
154
|
|
rlm@10
|
155
|
|
rlm@10
|
156 FIXTURES (new)
|
|
rlm@10
|
157
|
|
rlm@10
|
158 Fixtures allow you to run code before and after tests, to set up
|
|
rlm@10
|
159 the context in which tests should be run.
|
|
rlm@10
|
160
|
|
rlm@10
|
161 A fixture is just a function that calls another function passed as
|
|
rlm@10
|
162 an argument. It looks like this:
|
|
rlm@10
|
163
|
|
rlm@10
|
164 (defn my-fixture [f]
|
|
rlm@10
|
165 Perform setup, establish bindings, whatever.
|
|
rlm@10
|
166 (f) Then call the function we were passed.
|
|
rlm@10
|
167 Tear-down / clean-up code here.
|
|
rlm@10
|
168 )
|
|
rlm@10
|
169
|
|
rlm@10
|
170 Fixtures are attached to namespaces in one of two ways. \"each\"
|
|
rlm@10
|
171 fixtures are run repeatedly, once for each test function created
|
|
rlm@10
|
172 with \"deftest\" or \"with-test\". \"each\" fixtures are useful for
|
|
rlm@10
|
173 establishing a consistent before/after state for each test, like
|
|
rlm@10
|
174 clearing out database tables.
|
|
rlm@10
|
175
|
|
rlm@10
|
176 \"each\" fixtures can be attached to the current namespace like this:
|
|
rlm@10
|
177 (use-fixtures :each fixture1 fixture2 ...)
|
|
rlm@10
|
178 The fixture1, fixture2 are just functions like the example above.
|
|
rlm@10
|
179 They can also be anonymous functions, like this:
|
|
rlm@10
|
180 (use-fixtures :each (fn [f] setup... (f) cleanup...))
|
|
rlm@10
|
181
|
|
rlm@10
|
182 The other kind of fixture, a \"once\" fixture, is only run once,
|
|
rlm@10
|
183 around ALL the tests in the namespace. \"once\" fixtures are useful
|
|
rlm@10
|
184 for tasks that only need to be performed once, like establishing
|
|
rlm@10
|
185 database connections, or for time-consuming tasks.
|
|
rlm@10
|
186
|
|
rlm@10
|
187 Attach \"once\" fixtures to the current namespace like this:
|
|
rlm@10
|
188 (use-fixtures :once fixture1 fixture2 ...)
|
|
rlm@10
|
189
|
|
rlm@10
|
190
|
|
rlm@10
|
191 SAVING TEST OUTPUT TO A FILE
|
|
rlm@10
|
192
|
|
rlm@10
|
193 All the test reporting functions write to the var *test-out*. By
|
|
rlm@10
|
194 default, this is the same as *out*, but you can rebind it to any
|
|
rlm@10
|
195 PrintWriter. For example, it could be a file opened with
|
|
rlm@10
|
196 clojure.java.io/writer.
|
|
rlm@10
|
197
|
|
rlm@10
|
198
|
|
rlm@10
|
199 EXTENDING TEST-IS (ADVANCED)
|
|
rlm@10
|
200
|
|
rlm@10
|
201 You can extend the behavior of the \"is\" macro by defining new
|
|
rlm@10
|
202 methods for the \"assert-expr\" multimethod. These methods are
|
|
rlm@10
|
203 called during expansion of the \"is\" macro, so they should return
|
|
rlm@10
|
204 quoted forms to be evaluated.
|
|
rlm@10
|
205
|
|
rlm@10
|
206 You can plug in your own test-reporting framework by rebinding
|
|
rlm@10
|
207 the \"report\" function: (report event)
|
|
rlm@10
|
208
|
|
rlm@10
|
209 The 'event' argument is a map. It will always have a :type key,
|
|
rlm@10
|
210 whose value will be a keyword signaling the type of event being
|
|
rlm@10
|
211 reported. Standard events with :type value of :pass, :fail, and
|
|
rlm@10
|
212 :error are called when an assertion passes, fails, and throws an
|
|
rlm@10
|
213 exception, respectively. In that case, the event will also have
|
|
rlm@10
|
214 the following keys:
|
|
rlm@10
|
215
|
|
rlm@10
|
216 :expected The form that was expected to be true
|
|
rlm@10
|
217 :actual A form representing what actually occurred
|
|
rlm@10
|
218 :message The string message given as an argument to 'is'
|
|
rlm@10
|
219
|
|
rlm@10
|
220 The \"testing\" strings will be a list in \"*testing-contexts*\", and
|
|
rlm@10
|
221 the vars being tested will be a list in \"*testing-vars*\".
|
|
rlm@10
|
222
|
|
rlm@10
|
223 Your \"report\" function should wrap any printing calls in the
|
|
rlm@10
|
224 \"with-test-out\" macro, which rebinds *out* to the current value
|
|
rlm@10
|
225 of *test-out*.
|
|
rlm@10
|
226
|
|
rlm@10
|
227 For additional event types, see the examples in the code.
|
|
rlm@10
|
228 "}
|
|
rlm@10
|
229 clojure.test
|
|
rlm@10
|
230 (:require [clojure.template :as temp]
|
|
rlm@10
|
231 [clojure.stacktrace :as stack]))
|
|
rlm@10
|
232
|
|
rlm@10
|
233 ;; Nothing is marked "private" here, so you can rebind things to plug
|
|
rlm@10
|
234 ;; in your own testing or reporting frameworks.
|
|
rlm@10
|
235
|
|
rlm@10
|
236
|
|
rlm@10
|
237 ;;; USER-MODIFIABLE GLOBALS
|
|
rlm@10
|
238
|
|
rlm@10
|
239 (defonce
|
|
rlm@10
|
240 ^{:doc "True by default. If set to false, no test functions will
|
|
rlm@10
|
241 be created by deftest, set-test, or with-test. Use this to omit
|
|
rlm@10
|
242 tests when compiling or loading production code."
|
|
rlm@10
|
243 :added "1.1"}
|
|
rlm@10
|
244 *load-tests* true)
|
|
rlm@10
|
245
|
|
rlm@10
|
246 (def
|
|
rlm@10
|
247 ^{:doc "The maximum depth of stack traces to print when an Exception
|
|
rlm@10
|
248 is thrown during a test. Defaults to nil, which means print the
|
|
rlm@10
|
249 complete stack trace."
|
|
rlm@10
|
250 :added "1.1"}
|
|
rlm@10
|
251 *stack-trace-depth* nil)
|
|
rlm@10
|
252
|
|
rlm@10
|
253
|
|
rlm@10
|
254 ;;; GLOBALS USED BY THE REPORTING FUNCTIONS
|
|
rlm@10
|
255
|
|
rlm@10
|
256 (def *report-counters* nil) ; bound to a ref of a map in test-ns
|
|
rlm@10
|
257
|
|
rlm@10
|
258 (def *initial-report-counters* ; used to initialize *report-counters*
|
|
rlm@10
|
259 {:test 0, :pass 0, :fail 0, :error 0})
|
|
rlm@10
|
260
|
|
rlm@10
|
261 (def *testing-vars* (list)) ; bound to hierarchy of vars being tested
|
|
rlm@10
|
262
|
|
rlm@10
|
263 (def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings
|
|
rlm@10
|
264
|
|
rlm@10
|
265 (def *test-out* *out*) ; PrintWriter for test reporting output
|
|
rlm@10
|
266
|
|
rlm@10
|
267 (defmacro with-test-out
|
|
rlm@10
|
268 "Runs body with *out* bound to the value of *test-out*."
|
|
rlm@10
|
269 {:added "1.1"}
|
|
rlm@10
|
270 [& body]
|
|
rlm@10
|
271 `(binding [*out* *test-out*]
|
|
rlm@10
|
272 ~@body))
|
|
rlm@10
|
273
|
|
rlm@10
|
274 ;;; UTILITIES FOR REPORTING FUNCTIONS
|
|
rlm@10
|
275
|
|
rlm@10
|
276 (defn file-position
|
|
rlm@10
|
277 "Returns a vector [filename line-number] for the nth call up the
|
|
rlm@10
|
278 stack.
|
|
rlm@10
|
279
|
|
rlm@10
|
280 Deprecated in 1.2: The information needed for test reporting is
|
|
rlm@10
|
281 now on :file and :line keys in the result map."
|
|
rlm@10
|
282 {:added "1.1"
|
|
rlm@10
|
283 :deprecated "1.2"}
|
|
rlm@10
|
284 [n]
|
|
rlm@10
|
285 (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)]
|
|
rlm@10
|
286 [(.getFileName s) (.getLineNumber s)]))
|
|
rlm@10
|
287
|
|
rlm@10
|
288 (defn testing-vars-str
|
|
rlm@10
|
289 "Returns a string representation of the current test. Renders names
|
|
rlm@10
|
290 in *testing-vars* as a list, then the source file and line of
|
|
rlm@10
|
291 current assertion."
|
|
rlm@10
|
292 {:added "1.1"}
|
|
rlm@10
|
293 [m]
|
|
rlm@10
|
294 (let [{:keys [file line]} m]
|
|
rlm@10
|
295 (str
|
|
rlm@10
|
296 ;; Uncomment to include namespace in failure report:
|
|
rlm@10
|
297 ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ "
|
|
rlm@10
|
298 (reverse (map #(:name (meta %)) *testing-vars*))
|
|
rlm@10
|
299 " (" file ":" line ")")))
|
|
rlm@10
|
300
|
|
rlm@10
|
301 (defn testing-contexts-str
|
|
rlm@10
|
302 "Returns a string representation of the current test context. Joins
|
|
rlm@10
|
303 strings in *testing-contexts* with spaces."
|
|
rlm@10
|
304 {:added "1.1"}
|
|
rlm@10
|
305 []
|
|
rlm@10
|
306 (apply str (interpose " " (reverse *testing-contexts*))))
|
|
rlm@10
|
307
|
|
rlm@10
|
308 (defn inc-report-counter
|
|
rlm@10
|
309 "Increments the named counter in *report-counters*, a ref to a map.
|
|
rlm@10
|
310 Does nothing if *report-counters* is nil."
|
|
rlm@10
|
311 {:added "1.1"}
|
|
rlm@10
|
312 [name]
|
|
rlm@10
|
313 (when *report-counters*
|
|
rlm@10
|
314 (dosync (commute *report-counters* assoc name
|
|
rlm@10
|
315 (inc (or (*report-counters* name) 0))))))
|
|
rlm@10
|
316
|
|
rlm@10
|
317 ;;; TEST RESULT REPORTING
|
|
rlm@10
|
318
|
|
rlm@10
|
319 (defmulti
|
|
rlm@10
|
320 ^{:doc "Generic reporting function, may be overridden to plug in
|
|
rlm@10
|
321 different report formats (e.g., TAP, JUnit). Assertions such as
|
|
rlm@10
|
322 'is' call 'report' to indicate results. The argument given to
|
|
rlm@10
|
323 'report' will be a map with a :type key. See the documentation at
|
|
rlm@10
|
324 the top of test_is.clj for more information on the types of
|
|
rlm@10
|
325 arguments for 'report'."
|
|
rlm@10
|
326 :dynamic true
|
|
rlm@10
|
327 :added "1.1"}
|
|
rlm@10
|
328 report :type)
|
|
rlm@10
|
329
|
|
rlm@10
|
330 (defn- file-and-line
|
|
rlm@10
|
331 [exception depth]
|
|
rlm@10
|
332 (let [^StackTraceElement s (nth (.getStackTrace exception) depth)]
|
|
rlm@10
|
333 {:file (.getFileName s) :line (.getLineNumber s)}))
|
|
rlm@10
|
334
|
|
rlm@10
|
335 (defn do-report
|
|
rlm@10
|
336 "Add file and line information to a test result and call report.
|
|
rlm@10
|
337 If you are writing a custom assert-expr method, call this function
|
|
rlm@10
|
338 to pass test results to report."
|
|
rlm@10
|
339 {:added "1.2"}
|
|
rlm@10
|
340 [m]
|
|
rlm@10
|
341 (report
|
|
rlm@10
|
342 (case
|
|
rlm@10
|
343 (:type m)
|
|
rlm@10
|
344 :fail (merge (file-and-line (new java.lang.Throwable) 1) m)
|
|
rlm@10
|
345 :error (merge (file-and-line (:actual m) 0) m)
|
|
rlm@10
|
346 m)))
|
|
rlm@10
|
347
|
|
rlm@10
|
348 (defmethod report :default [m]
|
|
rlm@10
|
349 (with-test-out (prn m)))
|
|
rlm@10
|
350
|
|
rlm@10
|
351 (defmethod report :pass [m]
|
|
rlm@10
|
352 (with-test-out (inc-report-counter :pass)))
|
|
rlm@10
|
353
|
|
rlm@10
|
354 (defmethod report :fail [m]
|
|
rlm@10
|
355 (with-test-out
|
|
rlm@10
|
356 (inc-report-counter :fail)
|
|
rlm@10
|
357 (println "\nFAIL in" (testing-vars-str m))
|
|
rlm@10
|
358 (when (seq *testing-contexts*) (println (testing-contexts-str)))
|
|
rlm@10
|
359 (when-let [message (:message m)] (println message))
|
|
rlm@10
|
360 (println "expected:" (pr-str (:expected m)))
|
|
rlm@10
|
361 (println " actual:" (pr-str (:actual m)))))
|
|
rlm@10
|
362
|
|
rlm@10
|
363 (defmethod report :error [m]
|
|
rlm@10
|
364 (with-test-out
|
|
rlm@10
|
365 (inc-report-counter :error)
|
|
rlm@10
|
366 (println "\nERROR in" (testing-vars-str m))
|
|
rlm@10
|
367 (when (seq *testing-contexts*) (println (testing-contexts-str)))
|
|
rlm@10
|
368 (when-let [message (:message m)] (println message))
|
|
rlm@10
|
369 (println "expected:" (pr-str (:expected m)))
|
|
rlm@10
|
370 (print " actual: ")
|
|
rlm@10
|
371 (let [actual (:actual m)]
|
|
rlm@10
|
372 (if (instance? Throwable actual)
|
|
rlm@10
|
373 (stack/print-cause-trace actual *stack-trace-depth*)
|
|
rlm@10
|
374 (prn actual)))))
|
|
rlm@10
|
375
|
|
rlm@10
|
376 (defmethod report :summary [m]
|
|
rlm@10
|
377 (with-test-out
|
|
rlm@10
|
378 (println "\nRan" (:test m) "tests containing"
|
|
rlm@10
|
379 (+ (:pass m) (:fail m) (:error m)) "assertions.")
|
|
rlm@10
|
380 (println (:fail m) "failures," (:error m) "errors.")))
|
|
rlm@10
|
381
|
|
rlm@10
|
382 (defmethod report :begin-test-ns [m]
|
|
rlm@10
|
383 (with-test-out
|
|
rlm@10
|
384 (println "\nTesting" (ns-name (:ns m)))))
|
|
rlm@10
|
385
|
|
rlm@10
|
386 ;; Ignore these message types:
|
|
rlm@10
|
387 (defmethod report :end-test-ns [m])
|
|
rlm@10
|
388 (defmethod report :begin-test-var [m])
|
|
rlm@10
|
389 (defmethod report :end-test-var [m])
|
|
rlm@10
|
390
|
|
rlm@10
|
391
|
|
rlm@10
|
392
|
|
rlm@10
|
393 ;;; UTILITIES FOR ASSERTIONS
|
|
rlm@10
|
394
|
|
rlm@10
|
395 (defn get-possibly-unbound-var
|
|
rlm@10
|
396 "Like var-get but returns nil if the var is unbound."
|
|
rlm@10
|
397 {:added "1.1"}
|
|
rlm@10
|
398 [v]
|
|
rlm@10
|
399 (try (var-get v)
|
|
rlm@10
|
400 (catch IllegalStateException e
|
|
rlm@10
|
401 nil)))
|
|
rlm@10
|
402
|
|
rlm@10
|
403 (defn function?
|
|
rlm@10
|
404 "Returns true if argument is a function or a symbol that resolves to
|
|
rlm@10
|
405 a function (not a macro)."
|
|
rlm@10
|
406 {:added "1.1"}
|
|
rlm@10
|
407 [x]
|
|
rlm@10
|
408 (if (symbol? x)
|
|
rlm@10
|
409 (when-let [v (resolve x)]
|
|
rlm@10
|
410 (when-let [value (get-possibly-unbound-var v)]
|
|
rlm@10
|
411 (and (fn? value)
|
|
rlm@10
|
412 (not (:macro (meta v))))))
|
|
rlm@10
|
413 (fn? x)))
|
|
rlm@10
|
414
|
|
rlm@10
|
415 (defn assert-predicate
|
|
rlm@10
|
416 "Returns generic assertion code for any functional predicate. The
|
|
rlm@10
|
417 'expected' argument to 'report' will contains the original form, the
|
|
rlm@10
|
418 'actual' argument will contain the form with all its sub-forms
|
|
rlm@10
|
419 evaluated. If the predicate returns false, the 'actual' form will
|
|
rlm@10
|
420 be wrapped in (not...)."
|
|
rlm@10
|
421 {:added "1.1"}
|
|
rlm@10
|
422 [msg form]
|
|
rlm@10
|
423 (let [args (rest form)
|
|
rlm@10
|
424 pred (first form)]
|
|
rlm@10
|
425 `(let [values# (list ~@args)
|
|
rlm@10
|
426 result# (apply ~pred values#)]
|
|
rlm@10
|
427 (if result#
|
|
rlm@10
|
428 (do-report {:type :pass, :message ~msg,
|
|
rlm@10
|
429 :expected '~form, :actual (cons ~pred values#)})
|
|
rlm@10
|
430 (do-report {:type :fail, :message ~msg,
|
|
rlm@10
|
431 :expected '~form, :actual (list '~'not (cons '~pred values#))}))
|
|
rlm@10
|
432 result#)))
|
|
rlm@10
|
433
|
|
rlm@10
|
434 (defn assert-any
|
|
rlm@10
|
435 "Returns generic assertion code for any test, including macros, Java
|
|
rlm@10
|
436 method calls, or isolated symbols."
|
|
rlm@10
|
437 {:added "1.1"}
|
|
rlm@10
|
438 [msg form]
|
|
rlm@10
|
439 `(let [value# ~form]
|
|
rlm@10
|
440 (if value#
|
|
rlm@10
|
441 (do-report {:type :pass, :message ~msg,
|
|
rlm@10
|
442 :expected '~form, :actual value#})
|
|
rlm@10
|
443 (do-report {:type :fail, :message ~msg,
|
|
rlm@10
|
444 :expected '~form, :actual value#}))
|
|
rlm@10
|
445 value#))
|
|
rlm@10
|
446
|
|
rlm@10
|
447
|
|
rlm@10
|
448
|
|
rlm@10
|
449 ;;; ASSERTION METHODS
|
|
rlm@10
|
450
|
|
rlm@10
|
451 ;; You don't call these, but you can add methods to extend the 'is'
|
|
rlm@10
|
452 ;; macro. These define different kinds of tests, based on the first
|
|
rlm@10
|
453 ;; symbol in the test expression.
|
|
rlm@10
|
454
|
|
rlm@10
|
455 (defmulti assert-expr
|
|
rlm@10
|
456 (fn [msg form]
|
|
rlm@10
|
457 (cond
|
|
rlm@10
|
458 (nil? form) :always-fail
|
|
rlm@10
|
459 (seq? form) (first form)
|
|
rlm@10
|
460 :else :default)))
|
|
rlm@10
|
461
|
|
rlm@10
|
462 (defmethod assert-expr :always-fail [msg form]
|
|
rlm@10
|
463 ;; nil test: always fail
|
|
rlm@10
|
464 `(do-report {:type :fail, :message ~msg}))
|
|
rlm@10
|
465
|
|
rlm@10
|
466 (defmethod assert-expr :default [msg form]
|
|
rlm@10
|
467 (if (and (sequential? form) (function? (first form)))
|
|
rlm@10
|
468 (assert-predicate msg form)
|
|
rlm@10
|
469 (assert-any msg form)))
|
|
rlm@10
|
470
|
|
rlm@10
|
471 (defmethod assert-expr 'instance? [msg form]
|
|
rlm@10
|
472 ;; Test if x is an instance of y.
|
|
rlm@10
|
473 `(let [klass# ~(nth form 1)
|
|
rlm@10
|
474 object# ~(nth form 2)]
|
|
rlm@10
|
475 (let [result# (instance? klass# object#)]
|
|
rlm@10
|
476 (if result#
|
|
rlm@10
|
477 (do-report {:type :pass, :message ~msg,
|
|
rlm@10
|
478 :expected '~form, :actual (class object#)})
|
|
rlm@10
|
479 (do-report {:type :fail, :message ~msg,
|
|
rlm@10
|
480 :expected '~form, :actual (class object#)}))
|
|
rlm@10
|
481 result#)))
|
|
rlm@10
|
482
|
|
rlm@10
|
483 (defmethod assert-expr 'thrown? [msg form]
|
|
rlm@10
|
484 ;; (is (thrown? c expr))
|
|
rlm@10
|
485 ;; Asserts that evaluating expr throws an exception of class c.
|
|
rlm@10
|
486 ;; Returns the exception thrown.
|
|
rlm@10
|
487 (let [klass (second form)
|
|
rlm@10
|
488 body (nthnext form 2)]
|
|
rlm@10
|
489 `(try ~@body
|
|
rlm@10
|
490 (do-report {:type :fail, :message ~msg,
|
|
rlm@10
|
491 :expected '~form, :actual nil})
|
|
rlm@10
|
492 (catch ~klass e#
|
|
rlm@10
|
493 (do-report {:type :pass, :message ~msg,
|
|
rlm@10
|
494 :expected '~form, :actual e#})
|
|
rlm@10
|
495 e#))))
|
|
rlm@10
|
496
|
|
rlm@10
|
497 (defmethod assert-expr 'thrown-with-msg? [msg form]
|
|
rlm@10
|
498 ;; (is (thrown-with-msg? c re expr))
|
|
rlm@10
|
499 ;; Asserts that evaluating expr throws an exception of class c.
|
|
rlm@10
|
500 ;; Also asserts that the message string of the exception matches
|
|
rlm@10
|
501 ;; (with re-find) the regular expression re.
|
|
rlm@10
|
502 (let [klass (nth form 1)
|
|
rlm@10
|
503 re (nth form 2)
|
|
rlm@10
|
504 body (nthnext form 3)]
|
|
rlm@10
|
505 `(try ~@body
|
|
rlm@10
|
506 (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil})
|
|
rlm@10
|
507 (catch ~klass e#
|
|
rlm@10
|
508 (let [m# (.getMessage e#)]
|
|
rlm@10
|
509 (if (re-find ~re m#)
|
|
rlm@10
|
510 (do-report {:type :pass, :message ~msg,
|
|
rlm@10
|
511 :expected '~form, :actual e#})
|
|
rlm@10
|
512 (do-report {:type :fail, :message ~msg,
|
|
rlm@10
|
513 :expected '~form, :actual e#})))
|
|
rlm@10
|
514 e#))))
|
|
rlm@10
|
515
|
|
rlm@10
|
516
|
|
rlm@10
|
517 (defmacro try-expr
|
|
rlm@10
|
518 "Used by the 'is' macro to catch unexpected exceptions.
|
|
rlm@10
|
519 You don't call this."
|
|
rlm@10
|
520 {:added "1.1"}
|
|
rlm@10
|
521 [msg form]
|
|
rlm@10
|
522 `(try ~(assert-expr msg form)
|
|
rlm@10
|
523 (catch Throwable t#
|
|
rlm@10
|
524 (do-report {:type :error, :message ~msg,
|
|
rlm@10
|
525 :expected '~form, :actual t#}))))
|
|
rlm@10
|
526
|
|
rlm@10
|
527
|
|
rlm@10
|
528
|
|
rlm@10
|
529 ;;; ASSERTION MACROS
|
|
rlm@10
|
530
|
|
rlm@10
|
531 ;; You use these in your tests.
|
|
rlm@10
|
532
|
|
rlm@10
|
533 (defmacro is
|
|
rlm@10
|
534 "Generic assertion macro. 'form' is any predicate test.
|
|
rlm@10
|
535 'msg' is an optional message to attach to the assertion.
|
|
rlm@10
|
536
|
|
rlm@10
|
537 Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\")
|
|
rlm@10
|
538
|
|
rlm@10
|
539 Special forms:
|
|
rlm@10
|
540
|
|
rlm@10
|
541 (is (thrown? c body)) checks that an instance of c is thrown from
|
|
rlm@10
|
542 body, fails if not; then returns the thing thrown.
|
|
rlm@10
|
543
|
|
rlm@10
|
544 (is (thrown-with-msg? c re body)) checks that an instance of c is
|
|
rlm@10
|
545 thrown AND that the message on the exception matches (with
|
|
rlm@10
|
546 re-find) the regular expression re."
|
|
rlm@10
|
547 {:added "1.1"}
|
|
rlm@10
|
548 ([form] `(is ~form nil))
|
|
rlm@10
|
549 ([form msg] `(try-expr ~msg ~form)))
|
|
rlm@10
|
550
|
|
rlm@10
|
551 (defmacro are
|
|
rlm@10
|
552 "Checks multiple assertions with a template expression.
|
|
rlm@10
|
553 See clojure.template/do-template for an explanation of
|
|
rlm@10
|
554 templates.
|
|
rlm@10
|
555
|
|
rlm@10
|
556 Example: (are [x y] (= x y)
|
|
rlm@10
|
557 2 (+ 1 1)
|
|
rlm@10
|
558 4 (* 2 2))
|
|
rlm@10
|
559 Expands to:
|
|
rlm@10
|
560 (do (is (= 2 (+ 1 1)))
|
|
rlm@10
|
561 (is (= 4 (* 2 2))))
|
|
rlm@10
|
562
|
|
rlm@10
|
563 Note: This breaks some reporting features, such as line numbers."
|
|
rlm@10
|
564 {:added "1.1"}
|
|
rlm@10
|
565 [argv expr & args]
|
|
rlm@10
|
566 `(temp/do-template ~argv (is ~expr) ~@args))
|
|
rlm@10
|
567
|
|
rlm@10
|
568 (defmacro testing
|
|
rlm@10
|
569 "Adds a new string to the list of testing contexts. May be nested,
|
|
rlm@10
|
570 but must occur inside a test function (deftest)."
|
|
rlm@10
|
571 {:added "1.1"}
|
|
rlm@10
|
572 [string & body]
|
|
rlm@10
|
573 `(binding [*testing-contexts* (conj *testing-contexts* ~string)]
|
|
rlm@10
|
574 ~@body))
|
|
rlm@10
|
575
|
|
rlm@10
|
576
|
|
rlm@10
|
577
|
|
rlm@10
|
578 ;;; DEFINING TESTS
|
|
rlm@10
|
579
|
|
rlm@10
|
580 (defmacro with-test
|
|
rlm@10
|
581 "Takes any definition form (that returns a Var) as the first argument.
|
|
rlm@10
|
582 Remaining body goes in the :test metadata function for that Var.
|
|
rlm@10
|
583
|
|
rlm@10
|
584 When *load-tests* is false, only evaluates the definition, ignoring
|
|
rlm@10
|
585 the tests."
|
|
rlm@10
|
586 {:added "1.1"}
|
|
rlm@10
|
587 [definition & body]
|
|
rlm@10
|
588 (if *load-tests*
|
|
rlm@10
|
589 `(doto ~definition (alter-meta! assoc :test (fn [] ~@body)))
|
|
rlm@10
|
590 definition))
|
|
rlm@10
|
591
|
|
rlm@10
|
592
|
|
rlm@10
|
593 (defmacro deftest
|
|
rlm@10
|
594 "Defines a test function with no arguments. Test functions may call
|
|
rlm@10
|
595 other tests, so tests may be composed. If you compose tests, you
|
|
rlm@10
|
596 should also define a function named test-ns-hook; run-tests will
|
|
rlm@10
|
597 call test-ns-hook instead of testing all vars.
|
|
rlm@10
|
598
|
|
rlm@10
|
599 Note: Actually, the test body goes in the :test metadata on the var,
|
|
rlm@10
|
600 and the real function (the value of the var) calls test-var on
|
|
rlm@10
|
601 itself.
|
|
rlm@10
|
602
|
|
rlm@10
|
603 When *load-tests* is false, deftest is ignored."
|
|
rlm@10
|
604 {:added "1.1"}
|
|
rlm@10
|
605 [name & body]
|
|
rlm@10
|
606 (when *load-tests*
|
|
rlm@10
|
607 `(def ~(vary-meta name assoc :test `(fn [] ~@body))
|
|
rlm@10
|
608 (fn [] (test-var (var ~name))))))
|
|
rlm@10
|
609
|
|
rlm@10
|
610 (defmacro deftest-
|
|
rlm@10
|
611 "Like deftest but creates a private var."
|
|
rlm@10
|
612 {:added "1.1"}
|
|
rlm@10
|
613 [name & body]
|
|
rlm@10
|
614 (when *load-tests*
|
|
rlm@10
|
615 `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true)
|
|
rlm@10
|
616 (fn [] (test-var (var ~name))))))
|
|
rlm@10
|
617
|
|
rlm@10
|
618
|
|
rlm@10
|
619 (defmacro set-test
|
|
rlm@10
|
620 "Experimental.
|
|
rlm@10
|
621 Sets :test metadata of the named var to a fn with the given body.
|
|
rlm@10
|
622 The var must already exist. Does not modify the value of the var.
|
|
rlm@10
|
623
|
|
rlm@10
|
624 When *load-tests* is false, set-test is ignored."
|
|
rlm@10
|
625 {:added "1.1"}
|
|
rlm@10
|
626 [name & body]
|
|
rlm@10
|
627 (when *load-tests*
|
|
rlm@10
|
628 `(alter-meta! (var ~name) assoc :test (fn [] ~@body))))
|
|
rlm@10
|
629
|
|
rlm@10
|
630
|
|
rlm@10
|
631
|
|
rlm@10
|
632 ;;; DEFINING FIXTURES
|
|
rlm@10
|
633
|
|
rlm@10
|
634 (defn- add-ns-meta
|
|
rlm@10
|
635 "Adds elements in coll to the current namespace metadata as the
|
|
rlm@10
|
636 value of key."
|
|
rlm@10
|
637 {:added "1.1"}
|
|
rlm@10
|
638 [key coll]
|
|
rlm@10
|
639 (alter-meta! *ns* assoc key coll))
|
|
rlm@10
|
640
|
|
rlm@10
|
641 (defmulti use-fixtures
|
|
rlm@10
|
642 "Wrap test runs in a fixture function to perform setup and
|
|
rlm@10
|
643 teardown. Using a fixture-type of :each wraps every test
|
|
rlm@10
|
644 individually, while:once wraps the whole run in a single function."
|
|
rlm@10
|
645 {:added "1.1"}
|
|
rlm@10
|
646 (fn [fixture-type & args] fixture-type))
|
|
rlm@10
|
647
|
|
rlm@10
|
648 (defmethod use-fixtures :each [fixture-type & args]
|
|
rlm@10
|
649 (add-ns-meta ::each-fixtures args))
|
|
rlm@10
|
650
|
|
rlm@10
|
651 (defmethod use-fixtures :once [fixture-type & args]
|
|
rlm@10
|
652 (add-ns-meta ::once-fixtures args))
|
|
rlm@10
|
653
|
|
rlm@10
|
654 (defn- default-fixture
|
|
rlm@10
|
655 "The default, empty, fixture function. Just calls its argument."
|
|
rlm@10
|
656 {:added "1.1"}
|
|
rlm@10
|
657 [f]
|
|
rlm@10
|
658 (f))
|
|
rlm@10
|
659
|
|
rlm@10
|
660 (defn compose-fixtures
|
|
rlm@10
|
661 "Composes two fixture functions, creating a new fixture function
|
|
rlm@10
|
662 that combines their behavior."
|
|
rlm@10
|
663 {:added "1.1"}
|
|
rlm@10
|
664 [f1 f2]
|
|
rlm@10
|
665 (fn [g] (f1 (fn [] (f2 g)))))
|
|
rlm@10
|
666
|
|
rlm@10
|
667 (defn join-fixtures
|
|
rlm@10
|
668 "Composes a collection of fixtures, in order. Always returns a valid
|
|
rlm@10
|
669 fixture function, even if the collection is empty."
|
|
rlm@10
|
670 {:added "1.1"}
|
|
rlm@10
|
671 [fixtures]
|
|
rlm@10
|
672 (reduce compose-fixtures default-fixture fixtures))
|
|
rlm@10
|
673
|
|
rlm@10
|
674
|
|
rlm@10
|
675
|
|
rlm@10
|
676
|
|
rlm@10
|
677 ;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS
|
|
rlm@10
|
678
|
|
rlm@10
|
679 (defn test-var
|
|
rlm@10
|
680 "If v has a function in its :test metadata, calls that function,
|
|
rlm@10
|
681 with *testing-vars* bound to (conj *testing-vars* v)."
|
|
rlm@10
|
682 {:dynamic true, :added "1.1"}
|
|
rlm@10
|
683 [v]
|
|
rlm@10
|
684 (when-let [t (:test (meta v))]
|
|
rlm@10
|
685 (binding [*testing-vars* (conj *testing-vars* v)]
|
|
rlm@10
|
686 (do-report {:type :begin-test-var, :var v})
|
|
rlm@10
|
687 (inc-report-counter :test)
|
|
rlm@10
|
688 (try (t)
|
|
rlm@10
|
689 (catch Throwable e
|
|
rlm@10
|
690 (do-report {:type :error, :message "Uncaught exception, not in assertion."
|
|
rlm@10
|
691 :expected nil, :actual e})))
|
|
rlm@10
|
692 (do-report {:type :end-test-var, :var v}))))
|
|
rlm@10
|
693
|
|
rlm@10
|
694 (defn test-all-vars
|
|
rlm@10
|
695 "Calls test-var on every var interned in the namespace, with fixtures."
|
|
rlm@10
|
696 {:added "1.1"}
|
|
rlm@10
|
697 [ns]
|
|
rlm@10
|
698 (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns)))
|
|
rlm@10
|
699 each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))]
|
|
rlm@10
|
700 (once-fixture-fn
|
|
rlm@10
|
701 (fn []
|
|
rlm@10
|
702 (doseq [v (vals (ns-interns ns))]
|
|
rlm@10
|
703 (when (:test (meta v))
|
|
rlm@10
|
704 (each-fixture-fn (fn [] (test-var v)))))))))
|
|
rlm@10
|
705
|
|
rlm@10
|
706 (defn test-ns
|
|
rlm@10
|
707 "If the namespace defines a function named test-ns-hook, calls that.
|
|
rlm@10
|
708 Otherwise, calls test-all-vars on the namespace. 'ns' is a
|
|
rlm@10
|
709 namespace object or a symbol.
|
|
rlm@10
|
710
|
|
rlm@10
|
711 Internally binds *report-counters* to a ref initialized to
|
|
rlm@10
|
712 *inital-report-counters*. Returns the final, dereferenced state of
|
|
rlm@10
|
713 *report-counters*."
|
|
rlm@10
|
714 {:added "1.1"}
|
|
rlm@10
|
715 [ns]
|
|
rlm@10
|
716 (binding [*report-counters* (ref *initial-report-counters*)]
|
|
rlm@10
|
717 (let [ns-obj (the-ns ns)]
|
|
rlm@10
|
718 (do-report {:type :begin-test-ns, :ns ns-obj})
|
|
rlm@10
|
719 ;; If the namespace has a test-ns-hook function, call that:
|
|
rlm@10
|
720 (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))]
|
|
rlm@10
|
721 ((var-get v))
|
|
rlm@10
|
722 ;; Otherwise, just test every var in the namespace.
|
|
rlm@10
|
723 (test-all-vars ns-obj))
|
|
rlm@10
|
724 (do-report {:type :end-test-ns, :ns ns-obj}))
|
|
rlm@10
|
725 @*report-counters*))
|
|
rlm@10
|
726
|
|
rlm@10
|
727
|
|
rlm@10
|
728
|
|
rlm@10
|
729 ;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS
|
|
rlm@10
|
730
|
|
rlm@10
|
731 (defn run-tests
|
|
rlm@10
|
732 "Runs all tests in the given namespaces; prints results.
|
|
rlm@10
|
733 Defaults to current namespace if none given. Returns a map
|
|
rlm@10
|
734 summarizing test results."
|
|
rlm@10
|
735 {:added "1.1"}
|
|
rlm@10
|
736 ([] (run-tests *ns*))
|
|
rlm@10
|
737 ([& namespaces]
|
|
rlm@10
|
738 (let [summary (assoc (apply merge-with + (map test-ns namespaces))
|
|
rlm@10
|
739 :type :summary)]
|
|
rlm@10
|
740 (do-report summary)
|
|
rlm@10
|
741 summary)))
|
|
rlm@10
|
742
|
|
rlm@10
|
743 (defn run-all-tests
|
|
rlm@10
|
744 "Runs all tests in all namespaces; prints results.
|
|
rlm@10
|
745 Optional argument is a regular expression; only namespaces with
|
|
rlm@10
|
746 names matching the regular expression (with re-matches) will be
|
|
rlm@10
|
747 tested."
|
|
rlm@10
|
748 {:added "1.1"}
|
|
rlm@10
|
749 ([] (apply run-tests (all-ns)))
|
|
rlm@10
|
750 ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns)))))
|
|
rlm@10
|
751
|
|
rlm@10
|
752 (defn successful?
|
|
rlm@10
|
753 "Returns true if the given test summary indicates all tests
|
|
rlm@10
|
754 were successful, false otherwise."
|
|
rlm@10
|
755 {:added "1.1"}
|
|
rlm@10
|
756 [summary]
|
|
rlm@10
|
757 (and (zero? (:fail summary 0))
|
|
rlm@10
|
758 (zero? (:error summary 0))))
|
