-
Notifications
You must be signed in to change notification settings - Fork 1.6k
/
test.clj
221 lines (202 loc) · 10.1 KB
/
test.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
(ns leiningen.test
"Run the project's tests."
(:refer-clojure :exclude [test])
(:require [clojure.java.io :as io]
[bultitude.core :as b]
[leiningen.core.eval :as eval]
[leiningen.core.main :as main]
[leiningen.core.project :as project])
(:import (java.io File PushbackReader)))
(def ^:dynamic *exit-after-tests* true)
(def form-for-suppressing-unselected-tests
"A function that figures out which vars need to be suppressed based on the
given selectors, moves their :test metadata to :leiningen/skipped-test (so
that clojure.test won't think they are tests), runs the given function, and
then sets the metadata back."
`(fn [namespaces# selectors# func#]
(let [copy-meta# (fn [var# from-key# to-key#]
(if-let [x# (get (meta var#) from-key#)]
(alter-meta! var# #(-> % (assoc to-key# x#) (dissoc from-key#)))))
vars# (if (seq selectors#)
(->> namespaces#
(mapcat (comp vals ns-interns))
(remove (fn [var#]
(some (fn [[selector# args#]]
(let [sfn# (if (vector? selector#)
(second selector#)
selector#)]
(apply sfn#
(merge (-> var# meta :ns meta)
(assoc (meta var#) ::var var#))
args#)))
selectors#)))))
copy# #(doseq [v# vars#] (copy-meta# v# %1 %2))]
(copy# :test :leiningen/skipped-test)
(try (func#)
(finally
(copy# :leiningen/skipped-test :test))))))
(defn- form-for-select-namespaces [namespaces selectors]
`(reduce (fn [acc# [f# args#]]
(if (vector? f#)
(filter #(apply (first f#) % args#) acc#)
acc#))
'~namespaces ~selectors))
(defn- form-for-nses-selectors-match [selectors ns-sym]
`(distinct
(for [ns# ~ns-sym
[_# var#] (ns-publics ns#)
:when (some (fn [[selector# args#]]
(apply (if (vector? selector#)
(second selector#)
selector#)
(merge (-> var# meta :ns meta)
(assoc (meta var#) ::var var#))
args#))
~selectors)]
ns#)))
;; TODO: make this an arg to form-for-testing-namespaces in 3.0.
(def ^:private ^:dynamic *monkeypatch?* true)
(defn form-for-testing-namespaces
"Return a form that when eval'd in the context of the project will test each
namespace and print an overall summary."
([namespaces _ & [selectors]]
(let [ns-sym (gensym "namespaces")]
`(let [~ns-sym ~(form-for-select-namespaces namespaces selectors)]
(when (seq ~ns-sym)
(apply require :reload ~ns-sym))
(let [failures# (atom {})
selected-namespaces# ~(form-for-nses-selectors-match selectors ns-sym)
_# (when ~*monkeypatch?*
(leiningen.core.injected/add-hook
#'clojure.test/test-ns
(fn [test-ns# ns#]
(try
(test-ns# ns#)
(catch Throwable t#
(binding [clojure.test/*report-counters*
(ref clojure.test/*initial-report-counters*)
clojure.test/*testing-vars*
(list (with-meta 'test
{:name ns#
:ns ns#}))]
(clojure.test/do-report {:type :error
:message "Uncaught exception in test fixture"
:expected nil
:actual t#})
(clojure.test/do-report {:type :end-test-ns
:ns (the-ns ns#)})
@clojure.test/*report-counters*)))))
(leiningen.core.injected/add-hook
#'clojure.test/report
(fn [report# m# & args#]
(when (#{:error :fail} (:type m#))
(when-let [first-var# (-> clojure.test/*testing-vars* first meta)]
(let [ns-name# (-> first-var# :ns ns-name name)
test-name# (-> first-var# :name name)]
(swap! failures#
(fn [_#]
(update-in @failures# [ns-name#] (fnil conj []) test-name#)))
(newline)
(println "lein test :only" (str ns-name# "/" test-name#)))))
(if (= :begin-test-ns (:type m#))
(clojure.test/with-test-out
(newline)
(println "lein test" (ns-name (:ns m#))))
(apply report# m# args#)))))
summary# (binding [clojure.test/*test-out* *out*]
(~form-for-suppressing-unselected-tests
selected-namespaces# ~selectors
#(apply ~'clojure.test/run-tests selected-namespaces#)))]
(spit ".lein-failures" (if ~*monkeypatch?*
(pr-str @failures#)
"#<disabled :monkeypatch-clojure-test>"))
(if ~*exit-after-tests*
(System/exit (+ (:error summary#) (:fail summary#)))
(+ (:error summary#) (:fail summary#))))))))
(defn- split-selectors [args]
(let [[nses selectors] (split-with (complement keyword?) args)]
[nses
(loop [acc {} [selector & selectors] selectors]
(if (seq selectors)
(let [[args next] (split-with (complement keyword?) selectors)]
(recur (assoc acc selector (list 'quote args))
next))
(if selector
(assoc acc selector ())
acc)))]))
(defn- partial-selectors [project-selectors selectors]
(for [[k v] selectors
:let [selector-form (k project-selectors)]
:when selector-form]
[selector-form v]))
(def ^:private only-form
['(fn [ns & vars]
((set (for [v vars]
(-> (str v)
(.split "/")
(first)
(symbol))))
ns))
'(fn [m & vars]
(some #(let [var (str "#'" %)]
(if (some #{\/} var)
(= var (-> m ::var str))
(= % (ns-name (:ns m)))))
vars))])
(defn- convert-to-ns [possible-file]
(if (and (re-matches #".*\.cljc?" possible-file) (.exists (io/file possible-file)))
(str (second (b/ns-form-for-file possible-file)))
possible-file))
(defn ^:internal read-args [args project]
(let [args (->> args (map convert-to-ns) (map read-string))
[nses given-selectors] (split-selectors args)
nses (or (seq nses)
(sort (b/namespaces-on-classpath
:classpath (map io/file (distinct (:test-paths project)))
:ignore-unreadable? false)))
selectors (partial-selectors (merge {:all '(constantly true)}
{:only only-form}
(:test-selectors project))
given-selectors)
selectors (if (and (empty? selectors)
(:default (:test-selectors project)))
[[(:default (:test-selectors project)) ()]]
selectors)]
(when (and (empty? selectors)
(seq given-selectors))
(main/abort "Please specify :test-selectors in project.clj"))
[nses selectors]))
(defn test
"Run the project's tests.
Marking deftest or ns forms with metadata allows you to pick selectors to
specify a subset of your test suite to run:
(deftest ^:integration network-heavy-test
(is (= [1 2 3] (:numbers (network-operation)))))
Write the selectors in project.clj:
:test-selectors {:default (complement :integration)
:integration :integration}
Arguments to this task will be considered test selectors if they are keywords,
otherwise arguments must be test namespaces or files to run. With no
arguments the :default test selector is used if present, otherwise all
tests are run. Test selector arguments must come after the list of namespaces.
A default :only test-selector is available to run select tests. For example,
`lein test :only leiningen.test.test/test-default-selector` only runs the
specified test. A default :all test-selector is available to run all tests."
[project & tests]
(binding [main/*exit-process?* (if (= :leiningen (:eval-in project))
false
main/*exit-process?*)
*exit-after-tests* (if (= :leiningen (:eval-in project))
false
*exit-after-tests*)
*monkeypatch?* (:monkeypatch-clojure-test project true)]
(let [project (project/merge-profiles project [:leiningen/test :test])
[nses selectors] (read-args tests project)
_ (eval/prep project)
form (form-for-testing-namespaces nses nil (vec selectors))]
(try (when-let [n (eval/eval-in-project project form
'(require 'clojure.test))]
(when (and (number? n) (pos? n))
(throw (ex-info "Tests Failed" {:exit-code n}))))
(catch clojure.lang.ExceptionInfo e
(main/abort "Tests failed."))))))