-
Notifications
You must be signed in to change notification settings - Fork 109
/
clojure_test.cljc
203 lines (175 loc) · 8.81 KB
/
clojure_test.cljc
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
; Copyright (c) Rich Hickey, Reid Draper, and contributors.
; All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
(ns clojure.test.check.clojure-test
(:require #?(:clj [clojure.test :as ct]
:cljs [cljs.test :as ct :include-macros true])
[clojure.test.check :as tc]
[clojure.test.check.clojure-test.assertions]
[clojure.test.check.impl :refer [get-current-time-millis]])
#?(:cljs (:require-macros [clojure.test.check.clojure-test :refer [defspec]])))
(defn assert-check
[{:keys [result result-data] :as m}]
(if-let [error (:clojure.test.check.properties/error result-data)]
(throw error)
(ct/is (clojure.test.check.clojure-test/check? m))))
(def ^:dynamic *default-test-count* 100)
(defn default-reporter-fn
"Default function passed as the :reporter-fn to clojure.test.check/quick-check.
Delegates to clojure.test/report."
[{:keys [type] :as args}]
(case type
:complete
(let [testing-vars #?(:clj ct/*testing-vars*
:cljs (:testing-vars ct/*current-env*))
params (merge (select-keys args [:result :num-tests :seed
:time-elapsed-ms])
(when (seq testing-vars)
{:test-var (-> testing-vars first meta :name name)}))]
(ct/report {:type :clojure.test.check.clojure-test/complete
:clojure.test.check.clojure-test/property (:property args)
:clojure.test.check.clojure-test/complete params}))
:trial
(ct/report {:type :clojure.test.check.clojure-test/trial
:clojure.test.check.clojure-test/property (:property args)
:clojure.test.check.clojure-test/trial [(:num-tests args)
(:num-tests-total args)]})
:failure
(ct/report {:type :clojure.test.check.clojure-test/shrinking
:clojure.test.check.clojure-test/property (:property args)
:clojure.test.check.clojure-test/params (vec (:fail args))})
:shrunk
(ct/report {:type :clojure.test.check.clojure-test/shrunk
:clojure.test.check.clojure-test/property (:property args)
:clojure.test.check.clojure-test/params (-> args :shrunk :smallest vec)})
nil))
(def ^:dynamic *default-opts*
"The default options passed to clojure.test.check/quick-check
by defspec."
{:reporter-fn default-reporter-fn})
(defn process-options
{:no-doc true}
[options]
(cond (nil? options) (merge {:num-tests *default-test-count*} *default-opts*)
(number? options) (assoc *default-opts* :num-tests options)
(map? options) (merge {:num-tests *default-test-count*}
*default-opts*
options)
:else (throw (ex-info (str "Invalid defspec options: " (pr-str options))
{:bad-options options}))))
(defmacro defspec
"Defines a new clojure.test test var that uses `quick-check` to verify the
property, running num-times trials by default. You can call the function defined as `name`
with no arguments to trigger this test directly (i.e., without starting a
wider clojure.test run). If called with arguments, the first argument is the number of
trials, optionally followed by keyword arguments as defined for `quick-check`."
{:arglists '([name property] [name num-tests? property] [name options? property])}
([name property] `(defspec ~name nil ~property))
([name options property]
`(defn ~(vary-meta name assoc
::defspec true
:test `(fn []
(clojure.test.check.clojure-test/assert-check
(assoc (~name) :test-var (str '~name)))))
{:arglists '([] ~'[num-tests & {:keys [seed max-size reporter-fn]}])}
([] (let [options# (process-options ~options)]
(apply ~name (:num-tests options#) (apply concat options#))))
([times# & {:as quick-check-opts#}]
(let [options# (merge (process-options ~options) quick-check-opts#)]
(apply
tc/quick-check
times#
(vary-meta ~property assoc :name '~name)
(apply concat options#)))))))
(def ^:dynamic *report-trials*
"Controls whether property trials should be reported via clojure.test/report.
Valid values include:
* false - no reporting of trials (default)
* a function - will be passed a clojure.test/report-style map containing
:clojure.test.check/property and :clojure.test.check/trial slots
* true - provides quickcheck-style trial reporting (dots) via
`trial-report-dots`
(Note that all reporting requires running `quick-check` within the scope of a
clojure.test run (via `test-ns`, `test-all-vars`, etc.))
Reporting functions offered by clojure.test.check include `trial-report-dots` and
`trial-report-periodic` (which prints more verbose trial progress information
every `*trial-report-period*` milliseconds)."
false)
(def ^:dynamic *report-shrinking*
"If true, a verbose report of the property being tested, the
failing return value, and the arguments provoking that failure is emitted
prior to the start of the shrinking search."
false)
(def ^:dynamic *trial-report-period*
"Milliseconds between reports emitted by `trial-report-periodic`."
10000)
(def ^:private last-trial-report (atom 0))
(defn- get-property-name
[{property-fun ::property :as report-map}]
(or (-> property-fun meta :name) (ct/testing-vars-str report-map)))
(defn with-test-out* [f]
#?(:clj (ct/with-test-out (f))
:cljs (f)))
(defn trial-report-periodic
"Intended to be bound as the value of `*report-trials*`; will emit a verbose
status every `*trial-report-period*` milliseconds, like this one:
Passing trial 3286 / 5000 for (your-test-var-name-here) (:)"
[m]
(let [t (get-current-time-millis)]
(when (> (- t *trial-report-period*) @last-trial-report)
(with-test-out*
(fn []
(println "Passing trial"
(-> m ::trial first) "/" (-> m ::trial second)
"for" (get-property-name m))))
(reset! last-trial-report t))))
(defn trial-report-dots
"Intended to be bound as the value of `*report-trials*`; will emit a single
dot every 1000 trials reported."
[{[so-far total] ::trial}]
(when (pos? so-far)
(when (zero? (mod so-far 1000))
(print ".")
(flush))
(when (== so-far total) (println))))
(def ^:dynamic *report-completion*
"If true, completed tests report test-var, num-tests and seed. Failed tests
report shrunk results. Defaults to true."
true)
(when #?(:clj true :cljs (not (and *ns* (re-matches #".*\$macros" (name (ns-name *ns*))))))
;; This check accomodates a number of tools that rebind ct/report
;; to be a regular function instead of a multimethod, and may do
;; so before this code is loaded (see TCHECK-125)
(if-not (instance? #?(:clj clojure.lang.MultiFn :cljs MultiFn) ct/report)
(binding [*out* #?(:clj *err* :cljs *out*)]
(println "clojure.test/report is not a multimethod, some reporting functions have been disabled."))
(let [begin-test-var-method (get-method ct/report #?(:clj :begin-test-var
:cljs [::ct/default :begin-test-var]))]
(defmethod ct/report #?(:clj :begin-test-var
:cljs [::ct/default :begin-test-var]) [m]
(reset! last-trial-report (get-current-time-millis))
(when begin-test-var-method (begin-test-var-method m)))
(defmethod ct/report #?(:clj ::trial :cljs [::ct/default ::trial]) [m]
(when-let [trial-report-fn (and *report-trials*
(if (true? *report-trials*)
trial-report-dots
*report-trials*))]
(trial-report-fn m)))
(defmethod ct/report #?(:clj ::shrinking :cljs [::ct/default ::shrinking]) [m]
(when *report-shrinking*
(with-test-out*
(fn []
(println "Shrinking" (get-property-name m)
"starting with parameters" (pr-str (::params m)))))))
(defmethod ct/report #?(:clj ::complete :cljs [::ct/default ::complete]) [m]
(when *report-completion*
(prn (::complete m))))
(defmethod ct/report #?(:clj ::shrunk :cljs [::ct/default ::shrunk]) [m]
(when *report-completion*
(with-test-out*
(fn [] (prn m))))))))