Skip to content

Commit ec9f122

Browse files
willcohenwillcohen
committed
Add test.check support
1 parent 1fe5221 commit ec9f122

10 files changed

Lines changed: 256 additions & 23 deletions

‎bb/tasks.clj‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,10 @@
2727
set-config (edn/read-string (slurp (io/resource "cherry/clojure.set.edn")))
2828
pprint-config (edn/read-string (slurp (io/resource "cherry/clojure.pprint.edn")))
2929
test-config (edn/read-string (slurp (io/resource "cherry/cherry.test.edn")))
30+
check-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.edn")))
31+
gen-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.generators.edn")))
32+
prop-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.properties.edn")))
33+
clojure-test-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.clojure_test.edn")))
3034
reserved (edn/read-string (slurp (io/resource "cherry/js_reserved.edn")))]
3135
{:modules
3236
{:cljs.core {:exports (assoc (->namespace "cljs.core" (:vars core-config) reserved)
@@ -45,7 +49,13 @@
4549
:depends-on #{:cljs.core :clojure.string}}
4650
:clojure.test {:exports (->namespace "cherry.test" (:vars test-config) reserved)
4751
:entries '[cherry.test]
48-
:depends-on #{:cljs.core :clojure.string}}}}))
52+
:depends-on #{:cljs.core :clojure.string}}
53+
:clojure.test.check {:exports (merge (->namespace "clojure.test.check" (:vars check-config) reserved)
54+
(->namespace "clojure.test.check.generators" (:vars gen-config) reserved)
55+
(->namespace "clojure.test.check.properties" (:vars prop-config) reserved)
56+
(->namespace "clojure.test.check.clojure-test" (:vars clojure-test-config) reserved))
57+
:entries '[clojure.test.check clojure.test.check.generators clojure.test.check.properties clojure.test.check.clojure-test]
58+
:depends-on #{:cljs.core :clojure.string :cljs.pprint}}}}))
4959

5060
(def test-config
5161
'{:compiler-options {:load-tests true}

‎deps.edn‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,17 +3,19 @@
33
org.babashka/sci {:mvn/version "0.10.49"}
44
io.github.squint-cljs/squint
55
#_{:local/root "/Users/borkdude/dev/squint"}
6-
{:git/sha "9ad6e7b6106c93fd58cd3c1358d5838cce85db28"}}
6+
{:git/sha "e77924abcf30e96939c51432c91c5202bd0928a4"}}
77
:aliases
88
{:cljs {:extra-paths ["test"]
99
:extra-deps {thheller/shadow-cljs {:mvn/version "3.3.4"}
1010
funcool/promesa {:mvn/version "11.0.678"}
11-
babashka/process {:mvn/version "0.6.23"}}}
11+
babashka/process {:mvn/version "0.6.23"}
12+
org.clojure/test.check {:mvn/version "1.1.3"}}}
1213
:test ;; added by neil
1314
{:extra-paths ["test"]
1415
:extra-deps {io.github.cognitect-labs/test-runner
1516
{:git/tag "v0.5.1" :git/sha "dfb30dd" :git/url "https://github.com/cognitect-labs/test-runner"}
16-
babashka/fs {:mvn/version "0.5.27"}}
17+
babashka/fs {:mvn/version "0.5.27"}
18+
org.clojure/test.check {:mvn/version "1.1.3"}}
1719
:main-opts ["-m" "cognitect.test-runner"]
1820
:exec-fn cognitect.test-runner.api/test}}
1921
}

‎resources/cherry/clojure.test.check.clojure_test.edn‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
{:vars #{default_reporter_fn
2+
_STAR_default_test_count_STAR_
3+
_STAR_default_opts_STAR_
4+
_STAR_report_shrinking_STAR_
5+
_STAR_report_trials_STAR_
6+
_STAR_report_completion_STAR_
7+
_STAR_trial_report_period_STAR_
8+
trial_report_dots
9+
trial_report_periodic
10+
assert_check
11+
process_options}}

‎resources/cherry/clojure.test.check.edn‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{:vars #{quick_check}}

‎resources/cherry/clojure.test.check.generators.edn‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
{:vars #{any
2+
any_printable
3+
any_printable_ascii
4+
bind
5+
boolean
6+
byte
7+
bytes
8+
char
9+
char_alpha
10+
char_alpha_numeric
11+
char_alphanumeric
12+
char_ascii
13+
choose
14+
double
15+
double_STAR_
16+
elements
17+
fmap
18+
frequency
19+
generate
20+
hash_map
21+
int
22+
keyword
23+
keyword_ns
24+
large_integer
25+
large_integer_STAR_
26+
let
27+
list
28+
list_distinct
29+
list_distinct_by
30+
map
31+
nat
32+
no_shrink
33+
not_empty
34+
one_of
35+
recursive_gen
36+
resize
37+
return
38+
sample
39+
scale
40+
set
41+
shuffle
42+
simple_type
43+
simple_type_printable
44+
sized
45+
small_integer
46+
string
47+
string_alpha_numeric
48+
string_alphanumeric
49+
string_ascii
50+
such_that
51+
symbol
52+
symbol_ns
53+
tuple
54+
uuid
55+
vector
56+
vector_distinct
57+
vector_distinct_by}}

‎resources/cherry/clojure.test.check.properties.edn‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{:vars #{for_all_STAR_ ErrorResult}}

‎src/cherry/compiler.cljc‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@
1818
[cherry.internal.loop :as loop]
1919
[cherry.internal.macros :as macros]
2020
[cherry.internal.protocols :as protocols]
21+
[cherry.internal.test-check :as test-check]
2122
[squint.internal.test :as test]
2223
[squint.internal.macros :as squint-macros]
2324
[clojure.string :as str]
@@ -112,7 +113,15 @@
112113
cc/common-macros))
113114

114115
(def built-in-macro-nss
115-
{'cherry.test test/core-test-macros})
116+
{'cherry.test test/core-test-macros
117+
'clojure.test.check.clojure-test test-check/clojure-test-macros
118+
'clojure.test.check.properties test-check/properties-macros})
119+
120+
(def cherry-extra-ns-mappings
121+
'{clojure.test.check "cherry-cljs/lib/clojure.test.check.js"
122+
clojure.test.check.generators "cherry-cljs/lib/clojure.test.check.js"
123+
clojure.test.check.properties "cherry-cljs/lib/clojure.test.check.js"
124+
clojure.test.check.clojure-test "cherry-cljs/lib/clojure.test.check.js"})
116125

117126
(def core-config (resource/edn-resource "cherry/cljs.core.edn"))
118127

@@ -437,7 +446,8 @@
437446
:imports imports
438447
:jsx false
439448
:need-html-import need-html-import
440-
:pragmas pragmas))
449+
:pragmas pragmas
450+
:built-in-macro-nss built-in-macro-nss))
441451
jsx *jsx*
442452
_ (when (and jsx jsx-runtime)
443453
(swap! imports str

‎src/cherry/internal/cli.cljs‎

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -20,20 +20,21 @@
2020
file))
2121

2222
(defn resolve-ns [opts in-file x]
23-
(let [output-dir (:output-dir opts)
24-
paths (:paths opts)
25-
in-file-in-output-dir (file-in-output-dir in-file paths output-dir)]
26-
(when-let [resolved
27-
(some-> (utils/resolve-file x)
28-
(file-in-output-dir paths output-dir)
29-
(some->> (path/relative (path/dirname (str in-file-in-output-dir)))))]
30-
(let [ext (:extension opts ".mjs")
31-
ext (if (str/starts-with? ext ".")
32-
ext
33-
(str "." ext))
34-
ext' (path/extname resolved)
35-
file (str "./" (str/replace resolved (re-pattern (str ext' "$")) ext))]
36-
file))))
23+
(or (cc/cherry-extra-ns-mappings x)
24+
(let [output-dir (:output-dir opts)
25+
paths (:paths opts)
26+
in-file-in-output-dir (file-in-output-dir in-file paths output-dir)]
27+
(when-let [resolved
28+
(some-> (utils/resolve-file x)
29+
(file-in-output-dir paths output-dir)
30+
(some->> (path/relative (path/dirname (str in-file-in-output-dir)))))]
31+
(let [ext (:extension opts ".mjs")
32+
ext (if (str/starts-with? ext ".")
33+
ext
34+
(str "." ext))
35+
ext' (path/extname resolved)
36+
file (str "./" (str/replace resolved (re-pattern (str ext' "$")) ext))]
37+
file)))))
3738

3839
(defn files-from-path [path]
3940
(let [files (fs/readdirSync path)]

‎src/cherry/internal/test_check.cljc‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
(ns cherry.internal.test-check)
2+
3+
(defn core-defspec [_&form _&env name num-tests-or-prop & rest]
4+
(let [[num-tests prop] (if (number? num-tests-or-prop)
5+
[num-tests-or-prop (first rest)]
6+
[100 num-tests-or-prop])]
7+
`(def ~(vary-meta name assoc :test true)
8+
(with-meta
9+
(fn []
10+
(let [result# (clojure.test.check/quick-check ~num-tests ~prop)]
11+
(if (:pass? result#)
12+
(clojure.test/report {:type :pass
13+
:message (str "Passed " ~num-tests " trials")})
14+
(clojure.test/report {:type :fail
15+
:message (str "Failed after " (:num-tests result#) " trials")
16+
:expected '~prop
17+
:actual (:shrunk result#)}))))
18+
{:name '~name}))))
19+
20+
(defn- binding-vars [bindings]
21+
(map first (partition 2 bindings)))
22+
23+
(defn- binding-gens [bindings]
24+
(map second (partition 2 bindings)))
25+
26+
(defn core-for-all [_&form _&env bindings & body]
27+
`(clojure.test.check.properties/for-all*
28+
~(vec (binding-gens bindings))
29+
(fn [~@(binding-vars bindings)]
30+
~@body)))
31+
32+
(def clojure-test-macros
33+
{'defspec core-defspec})
34+
35+
(def properties-macros
36+
{'for-all core-for-all})

‎test/cherry/cross_platform_test.cljc‎

Lines changed: 107 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,10 @@
11
(ns cherry.cross-platform-test
2-
(:require [clojure.test :as t #?@(:clj [:refer [deftest is testing are]])]
3-
[clojure.string :as str])
4-
#?(:cljs (:require-macros [clojure.test :as t :refer [deftest is testing are async]])))
2+
(:require [clojure.test :as t :refer [deftest is testing are
3+
#?@(:cljs [async])]]
4+
[clojure.string :as str]
5+
[clojure.test.check.generators :as gen]
6+
[clojure.test.check.clojure-test :as tc-test :refer [defspec]]
7+
[clojure.test.check.properties :as prop]))
58

69
(defonce test-db (atom nil))
710

@@ -398,6 +401,91 @@
398401
"run-tests should chain async tests in order")
399402
(t/set-once-fixtures! saved-fixtures))))))
400403

404+
(defspec simple-integer-property 100
405+
(prop/for-all [x gen/small-integer]
406+
(= x x)))
407+
408+
(defspec vector-reversal-property 50
409+
(prop/for-all [v (gen/vector gen/small-integer)]
410+
(= v (reverse (reverse v)))))
411+
412+
(defspec generator-composition 50
413+
(prop/for-all [x (gen/fmap inc gen/small-integer)]
414+
(> x (- x 1))))
415+
416+
(defspec multiple-generators 50
417+
(prop/for-all [x gen/small-integer
418+
y gen/small-integer]
419+
(= (+ x y) (+ y x))))
420+
421+
(defspec string-concatenation 50
422+
(prop/for-all [s1 gen/string-ascii
423+
s2 gen/string-ascii]
424+
(= (count (str s1 s2))
425+
(+ (count s1) (count s2)))))
426+
427+
(defspec map-property 50
428+
(prop/for-all [m (gen/map gen/keyword gen/small-integer)]
429+
(= (count m) (count (keys m)))))
430+
431+
(defspec set-property 50
432+
(prop/for-all [s (gen/set gen/small-integer)]
433+
(<= (count s) 100)))
434+
435+
(defspec such-that-property 50
436+
(prop/for-all [x (gen/such-that pos? gen/small-integer 100)]
437+
(pos? x)))
438+
439+
(defspec pos-int-property 50
440+
(prop/for-all [x (gen/large-integer* {:min 1})]
441+
(pos? x)))
442+
443+
(defspec neg-int-property 50
444+
(prop/for-all [x (gen/large-integer* {:max -1})]
445+
(neg? x)))
446+
447+
(defspec nat-property 50
448+
(prop/for-all [x gen/nat]
449+
(nat-int? x)))
450+
451+
(defspec list-distinct-property 50
452+
(prop/for-all [xs (gen/list-distinct gen/small-integer)]
453+
(= (count xs) (count (set xs)))))
454+
455+
(defspec recursive-gen-property 20
456+
(prop/for-all [tree (gen/recursive-gen
457+
(fn [inner] (gen/vector inner 0 3))
458+
gen/small-integer)]
459+
(or (number? tree) (vector? tree))))
460+
461+
(defspec resize-property 50
462+
(prop/for-all [v (gen/resize 5 (gen/vector gen/small-integer))]
463+
(<= (count v) 10)))
464+
465+
#?(:cljs
466+
(defspec verify-quick-check-catches-failures 20
467+
(prop/for-all [x gen/small-integer]
468+
(pos? x))))
469+
470+
#?(:cljs
471+
(defn verify-failure-detection
472+
"Runs verify-quick-check-catches-failures and asserts it catches the bug."
473+
[]
474+
(let [saved-env (t/get-current-env)
475+
saved-counters (:report-counters saved-env)]
476+
(t/set-env! (assoc (t/empty-env) :testing-vars (:testing-vars saved-env)))
477+
(let [fail-before (get-in (t/get-current-env) [:report-counters :fail] 0)]
478+
(t/test-var verify-quick-check-catches-failures)
479+
(let [fail-after (get-in (t/get-current-env) [:report-counters :fail] 0)]
480+
(t/set-env! (assoc saved-env :report-counters saved-counters))
481+
(when-not (> fail-after fail-before)
482+
(throw (js/Error. "quick-check should have caught failure but didn't!"))))))))
483+
484+
#?(:cljs
485+
(defn test-clojure-test-vars []
486+
(assert (number? tc-test/*default-test-count*)
487+
"*default-test-count* should be a number")))
488+
401489
#?(:clj
402490
(defn -main []
403491
(let [result (t/run-tests 'cherry.cross-platform-test)]
@@ -431,6 +519,22 @@
431519
(t/test-var report-only-counts-pass-fail-error-test)
432520
(await (t/test-var async-done-form-test))
433521
(t/test-var run-tests-quoted-symbol-test)
522+
(t/test-var simple-integer-property)
523+
(t/test-var vector-reversal-property)
524+
(t/test-var generator-composition)
525+
(t/test-var multiple-generators)
526+
(t/test-var string-concatenation)
527+
(t/test-var map-property)
528+
(t/test-var set-property)
529+
(t/test-var such-that-property)
530+
(t/test-var pos-int-property)
531+
(t/test-var neg-int-property)
532+
(t/test-var nat-property)
533+
(t/test-var list-distinct-property)
534+
(t/test-var recursive-gen-property)
535+
(t/test-var resize-property)
536+
(test-clojure-test-vars)
537+
(verify-failure-detection)
434538
(t/report {:type :summary})
435539
(let [results (:report-counters (t/get-current-env))]
436540
(when-not (t/successful? results)

0 commit comments

Comments
 (0)