-
Notifications
You must be signed in to change notification settings - Fork 81
/
fdef.clj
95 lines (86 loc) · 3.65 KB
/
fdef.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
(ns kaocha.type.spec.test.fdef
(:require [clojure.spec.alpha :as s]
[clojure.spec.test.alpha :as stest]
[clojure.string :as str]
[clojure.test :as test]
[expound.alpha :as expound]
[kaocha.hierarchy :as hierarchy]
[kaocha.report :as report]
[kaocha.testable :as testable]
[kaocha.type :as type]
[orchestra.spec.test :as orchestra]))
;; This namespace does not actually exist, but is created by
;; requiring clojure.spec.test.alpha
(alias 'stc 'clojure.spec.test.check)
(defn load-testable [stc-config sym]
(let [var (resolve sym)]
(merge {:kaocha.testable/type :kaocha.type/spec.test.fdef
:kaocha.testable/id (keyword sym)
:kaocha.testable/meta (meta var)
:kaocha.testable/desc (str sym)
:kaocha.spec.fdef/sym sym
:kaocha.spec.fdef/var var}
stc-config)))
(defn load-testables [testable syms]
(let [stc-config (select-keys testable [::stc/instrument?
::stc/check-asserts?
::stc/opts])]
(->> syms
(sort-by name)
(map (partial load-testable stc-config)))))
(defn report-success [check-results]
(test/do-report
{:type :pass
:message (str "Generative tests pass for "
(str/join ", " (map :sym check-results)))}))
(defn report-failure [check-results]
(doseq [failed-check (filter :failure check-results)]
(let [r (stest/abbrev-result failed-check)
failure (:failure r)]
(test/do-report
{:type :fail
:message (expound/explain-results-str check-results)
:expected (->> r :spec rest (apply hash-map) :ret)
:actual (if (instance? Throwable failure)
failure
(::stest/val failure))}))))
(defmethod testable/-run :kaocha.type/spec.test.fdef
[{the-var :kaocha.spec.fdef/var
sym :kaocha.spec.fdef/sym
wrap :kaocha.testable/wrap
instrument? ::stc/instrument?
check-asserts? ::stc/check-asserts?
opts ::stc/opts
:as testable}
_test-plan]
(type/with-report-counters
(when instrument? (orchestra/instrument))
(when check-asserts? (s/check-asserts true))
(test/do-report {:type :kaocha.stc/begin-fdef, :var the-var})
(try
(let [location (select-keys (meta the-var) [:file :line])
test (reduce #(%2 %1) (partial stest/check sym {::stc/opts opts}) wrap)
check-results (test)
checks-passed? (->> check-results (map :failure) (every? nil?))]
(binding [testable/*test-location* location]
(if checks-passed?
(report-success check-results)
(report-failure check-results))))
(catch clojure.lang.ExceptionInfo e
(when-not (:kaocha/fail-fast (ex-data e))
(report/report-exception e)))
(catch Throwable e
(report/report-exception e)))
(test/do-report {:type :kaocha.stc/end-fdef, :var the-var})
(when instrument? (orchestra/unstrument))
(when check-asserts? (s/check-asserts false))
(merge testable {:kaocha.result/count 1} (type/report-count))))
(s/def :kaocha.spec.fdef/var var?)
(s/def :kaocha.spec.fdef/sym qualified-symbol?)
(s/def :kaocha.type/spec.test.fdef
(s/keys :req [:kaocha.testable/type
:kaocha.testable/id
:kaocha.spec.fdef/var]))
(hierarchy/derive! :kaocha.type/spec.test.fdef :kaocha.testable.type/leaf)
(hierarchy/derive! :kaocha.stc/begin-fdef :kaocha/begin-test)
(hierarchy/derive! :kaocha.stc/end-fdef :kaocha/end-test)