|
49 | 49 | (try-require (symbol (namespace type))))
|
50 | 50 | (try-require (symbol (name type)))))
|
51 | 51 |
|
52 |
| -(defn- retry-assert-spec [type testable n] |
53 |
| - (let [result (try (assert-spec type testable) (catch Exception _e false))] |
54 |
| - (if (or result (<= n 1)) result |
55 |
| - (retry-assert-spec type testable (dec n))) ;otherwise, retry |
56 |
| -)) |
57 |
| - |
58 |
| -(defn deref-recur [testables] |
59 |
| - (cond (future? testables) (deref testables) |
60 |
| - (vector? testables) (doall (mapv deref-recur testables)) |
61 |
| - (seq? testables) (deref-recur (into [] (doall testables))) |
62 |
| - (contains? testables :kaocha.test-plan/tests) |
63 |
| - (update testables :kaocha.test-plan/tests deref-recur) |
64 |
| - (contains? testables :kaocha.result/tests) |
65 |
| - (update testables :kaocha.result/tests deref-recur) |
66 |
| - :else testables)) |
67 |
| - |
68 | 52 | (defn- load-type+validate
|
69 | 53 | "Try to load a testable type, and validate it both to be a valid generic testable, and a valid instance given the type.
|
70 | 54 |
|
|
162 | 146 | result))))
|
163 | 147 |
|
164 | 148 | (spec/fdef run
|
165 |
| - :args (spec/cat :testable :kaocha.test-plan/testable |
166 |
| - :test-plan :kaocha/test-plan) |
167 |
| - :ret :kaocha.result/testable) |
| 149 | + :args (spec/cat :testable :kaocha.test-plan/testable |
| 150 | + :test-plan :kaocha/test-plan) |
| 151 | + :ret :kaocha.result/testable) |
168 | 152 |
|
169 | 153 | (defn load-testables
|
170 | 154 | "Load a collection of testables, returning a test-plan collection"
|
|
240 | 224 |
|
241 | 225 | (defn try-run-testable [test test-plan n]
|
242 | 226 | (let [result (try (run-testable test test-plan) (catch Exception _e false))]
|
243 |
| - (if (or result (> n 1)) result ;success or last try, return |
244 |
| - (try-run-testable test test-plan (dec n))) ;otherwise retry |
245 |
| -)) |
246 |
| - |
| 227 | + (if (or result (> n 1)) |
| 228 | + ;; success or last try, return |
| 229 | + result |
| 230 | + ;; otherwise retry |
| 231 | + (try-run-testable test test-plan (dec n))))) |
247 | 232 |
|
248 | 233 | (defn run-testables-serial
|
249 | 234 | "Run a collection of testables, returning a result collection."
|
250 | 235 | [testables test-plan]
|
251 |
| - (doall testables) |
252 |
| - #_(print "run-testables got a collection of size" (count testables) |
253 |
| - " the first of which is " |
254 |
| - (:kaocha.testable/type (first testables))) |
255 | 236 | (let [load-error? (some ::load-error testables)]
|
256 | 237 | (loop [result []
|
257 | 238 | [test & testables] testables]
|
|
261 | 242 | (assoc ::skip true))
|
262 | 243 | r (run-testable test test-plan)]
|
263 | 244 | (if (or (and *fail-fast?* (result/failed? r)) (::skip-remaining? r))
|
264 |
| - (reduce into result [[r] testables]) |
| 245 | + (into (conj result r) testables) |
265 | 246 | (recur (conj result r) testables)))
|
266 | 247 | result))))
|
267 | 248 |
|
|
272 | 253 | :group-name (.getName (.getThreadGroup thread))}))
|
273 | 254 |
|
274 | 255 | (defn run-testables-parallel
|
275 |
| - "Run a collection of testables, returning a result collection." |
| 256 | + "Run a collection of testables in parallel, returning a result collection." |
276 | 257 | [testables test-plan]
|
277 |
| - (doall testables) |
278 | 258 | (let [load-error? (some ::load-error testables)
|
279 |
| - types (set (:parallel-children-exclude *config*)) |
280 |
| - suites (:parallel-suites-exclude *config*) |
281 |
| - futures (map #(do |
| 259 | + futures (doall |
| 260 | + (map (fn [t] |
282 | 261 | (future
|
283 |
| - (binding [*config* |
284 |
| - (cond-> *config* |
285 |
| - (contains? types (:kaocha.testable/type %)) (dissoc :parallel) |
286 |
| - (and (hierarchy/suite? %) (contains? suites (:kaocha.testable/desc %))) (dissoc :parallel) |
287 |
| - true (update :levels (fn [x] (if (nil? x) 1 (inc x)))))] |
288 |
| - (run-testable (assoc % ::thread (current-thread-info) ) test-plan)))) |
289 |
| - testables)] |
290 |
| - (comment (loop [result [] ;(ArrayBlockingQueue. 1024) |
291 |
| - [test & testables] testables] |
292 |
| - (if test |
293 |
| - (let [test (cond-> test |
294 |
| - (and load-error? (not (::load-error test))) |
295 |
| - (assoc ::skip true)) |
296 |
| - r (run-testable test test-plan)] |
297 |
| - (if (or (and *fail-fast?* (result/failed? r)) (::skip-remaining? r)) |
298 |
| - ;(reduce put-return result [[r] testables]) |
299 |
| - (reduce into result [[r] testables]) |
300 |
| - ;(recur (doto result (.put r)) testables) |
301 |
| - (recur (conj result r) testables))) |
302 |
| - result))) |
303 |
| - (deref-recur futures))) |
| 262 | + (run-testable (assoc t ::thread-info (current-thread-info)) test-plan))) |
| 263 | + testables))] |
| 264 | + (doall (map deref futures)))) |
304 | 265 |
|
305 | 266 | (defn run-testables
|
| 267 | + "Original run-testables, left for backwards compatibility, and still usable for |
| 268 | + test types that don't want to opt-in to parallelization. Generally |
| 269 | + implementations should move to [[run-testables-parent]]." |
306 | 270 | [testables test-plan]
|
307 |
| - (if (:parallel *config*) |
308 |
| - (doall (run-testables-parallel testables test-plan)) |
309 |
| - (run-testables-serial testables test-plan))) |
| 271 | + (run-testables-serial testables test-plan)) |
| 272 | + |
| 273 | +(defn run-testables-parent |
| 274 | + "Test type implementations should call this in their [[-run]] method, rather |
| 275 | + than [[run-testables]], so we can inspect the parent and parent metadata to |
| 276 | + decide if the children should get parallelized." |
| 277 | + [parent test-plan] |
| 278 | + (let [testables (:kaocha.test-plan/tests parent)] |
| 279 | + (if (or (true? (:kaocha/parallelize? (::meta parent))) ; explicit opt-in via metadata |
| 280 | + (and (:kaocha/parallelize? test-plan) ; enable parallelization in top-level config |
| 281 | + (or (::parallelizable? parent) ; test type has opted in, children are considered parallelizable |
| 282 | + (:kaocha/parallelize? parent)) ; or we're at the top level, suites are parallelizable. Can also be used as an explicit override/opt-in |
| 283 | + (not (false? (:kaocha/parallelize? (::meta parent)))))) ; explicit opt-out via metadata |
| 284 | + (run-testables-parallel testables test-plan) |
| 285 | + (run-testables-serial testables test-plan)))) |
310 | 286 |
|
311 | 287 | (defn test-seq [testable]
|
312 | 288 | (cond->> (mapcat test-seq (remove ::skip (or (:kaocha/tests testable)
|
|
319 | 295 |
|
320 | 296 | (defn test-seq-with-skipped
|
321 | 297 | [testable]
|
322 |
| - "Create a seq of all tests, including any skipped tests. |
| 298 | + "Create a seq of all tests, including any skipped tests. |
323 | 299 |
|
324 | 300 | Typically you want to look at `test-seq` instead."
|
325 | 301 | (cond->> (mapcat test-seq (or (:kaocha/tests testable)
|
326 |
| - (:kaocha.test-plan/tests testable) |
327 |
| - (:kaocha.result/tests testable))) |
| 302 | + (:kaocha.test-plan/tests testable) |
| 303 | + (:kaocha.result/tests testable))) |
328 | 304 | ;; When calling test-seq on the top level test-plan/result, don't include
|
329 | 305 | ;; the outer map. When running on an actual testable, do include it.
|
330 | 306 | (:kaocha.testable/id testable)
|
|
0 commit comments