From ad275930e03d2d23def88907cb567c84abff98ec Mon Sep 17 00:00:00 2001 From: Will Cohen Date: Fri, 17 Apr 2026 15:34:12 -0400 Subject: [PATCH] Add test.check support --- bb/tasks.clj | 12 +- deps.edn | 8 +- .../clojure.test.check.clojure_test.edn | 11 ++ resources/cherry/clojure.test.check.edn | 1 + .../cherry/clojure.test.check.generators.edn | 57 +++++++++ .../cherry/clojure.test.check.properties.edn | 1 + src/cherry/compiler.cljc | 14 ++- src/cherry/internal/cli.cljs | 29 ++--- src/cherry/internal/test_check.cljc | 36 ++++++ test/cherry/cross_platform_test.cljc | 110 +++++++++++++++++- 10 files changed, 256 insertions(+), 23 deletions(-) create mode 100644 resources/cherry/clojure.test.check.clojure_test.edn create mode 100644 resources/cherry/clojure.test.check.edn create mode 100644 resources/cherry/clojure.test.check.generators.edn create mode 100644 resources/cherry/clojure.test.check.properties.edn create mode 100644 src/cherry/internal/test_check.cljc diff --git a/bb/tasks.clj b/bb/tasks.clj index 2c7fc16..48e7caf 100644 --- a/bb/tasks.clj +++ b/bb/tasks.clj @@ -27,6 +27,10 @@ set-config (edn/read-string (slurp (io/resource "cherry/clojure.set.edn"))) pprint-config (edn/read-string (slurp (io/resource "cherry/clojure.pprint.edn"))) test-config (edn/read-string (slurp (io/resource "cherry/cherry.test.edn"))) + check-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.edn"))) + gen-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.generators.edn"))) + prop-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.properties.edn"))) + clojure-test-config (edn/read-string (slurp (io/resource "cherry/clojure.test.check.clojure_test.edn"))) reserved (edn/read-string (slurp (io/resource "cherry/js_reserved.edn")))] {:modules {:cljs.core {:exports (assoc (->namespace "cljs.core" (:vars core-config) reserved) @@ -45,7 +49,13 @@ :depends-on #{:cljs.core :clojure.string}} :clojure.test {:exports (->namespace "cherry.test" (:vars test-config) reserved) :entries '[cherry.test] - :depends-on #{:cljs.core :clojure.string}}}})) + :depends-on #{:cljs.core :clojure.string}} + :clojure.test.check {:exports (merge (->namespace "clojure.test.check" (:vars check-config) reserved) + (->namespace "clojure.test.check.generators" (:vars gen-config) reserved) + (->namespace "clojure.test.check.properties" (:vars prop-config) reserved) + (->namespace "clojure.test.check.clojure-test" (:vars clojure-test-config) reserved)) + :entries '[clojure.test.check clojure.test.check.generators clojure.test.check.properties clojure.test.check.clojure-test] + :depends-on #{:cljs.core :clojure.string :cljs.pprint}}}})) (def test-config '{:compiler-options {:load-tests true} diff --git a/deps.edn b/deps.edn index ebaa7e4..281d09d 100644 --- a/deps.edn +++ b/deps.edn @@ -3,17 +3,19 @@ org.babashka/sci {:mvn/version "0.10.49"} io.github.squint-cljs/squint #_{:local/root "/Users/borkdude/dev/squint"} - {:git/sha "9ad6e7b6106c93fd58cd3c1358d5838cce85db28"}} + {:git/sha "5abc27fcb1c47e97aff39ce539f52d0e54dd30a8"}} :aliases {:cljs {:extra-paths ["test"] :extra-deps {thheller/shadow-cljs {:mvn/version "3.3.4"} funcool/promesa {:mvn/version "11.0.678"} - babashka/process {:mvn/version "0.6.23"}}} + babashka/process {:mvn/version "0.6.23"} + org.clojure/test.check {:mvn/version "1.1.3"}}} :test ;; added by neil {:extra-paths ["test"] :extra-deps {io.github.cognitect-labs/test-runner {:git/tag "v0.5.1" :git/sha "dfb30dd" :git/url "https://github.com/cognitect-labs/test-runner"} - babashka/fs {:mvn/version "0.5.27"}} + babashka/fs {:mvn/version "0.5.27"} + org.clojure/test.check {:mvn/version "1.1.3"}} :main-opts ["-m" "cognitect.test-runner"] :exec-fn cognitect.test-runner.api/test}} } diff --git a/resources/cherry/clojure.test.check.clojure_test.edn b/resources/cherry/clojure.test.check.clojure_test.edn new file mode 100644 index 0000000..cfc1cbb --- /dev/null +++ b/resources/cherry/clojure.test.check.clojure_test.edn @@ -0,0 +1,11 @@ +{:vars #{default_reporter_fn + _STAR_default_test_count_STAR_ + _STAR_default_opts_STAR_ + _STAR_report_shrinking_STAR_ + _STAR_report_trials_STAR_ + _STAR_report_completion_STAR_ + _STAR_trial_report_period_STAR_ + trial_report_dots + trial_report_periodic + assert_check + process_options}} diff --git a/resources/cherry/clojure.test.check.edn b/resources/cherry/clojure.test.check.edn new file mode 100644 index 0000000..93f6174 --- /dev/null +++ b/resources/cherry/clojure.test.check.edn @@ -0,0 +1 @@ +{:vars #{quick_check}} diff --git a/resources/cherry/clojure.test.check.generators.edn b/resources/cherry/clojure.test.check.generators.edn new file mode 100644 index 0000000..7930791 --- /dev/null +++ b/resources/cherry/clojure.test.check.generators.edn @@ -0,0 +1,57 @@ +{:vars #{any + any_printable + any_printable_ascii + bind + boolean + byte + bytes + char + char_alpha + char_alpha_numeric + char_alphanumeric + char_ascii + choose + double + double_STAR_ + elements + fmap + frequency + generate + hash_map + int + keyword + keyword_ns + large_integer + large_integer_STAR_ + let + list + list_distinct + list_distinct_by + map + nat + no_shrink + not_empty + one_of + recursive_gen + resize + return + sample + scale + set + shuffle + simple_type + simple_type_printable + sized + small_integer + string + string_alpha_numeric + string_alphanumeric + string_ascii + such_that + symbol + symbol_ns + tuple + uuid + vector + vector_distinct + vector_distinct_by}} diff --git a/resources/cherry/clojure.test.check.properties.edn b/resources/cherry/clojure.test.check.properties.edn new file mode 100644 index 0000000..ce29841 --- /dev/null +++ b/resources/cherry/clojure.test.check.properties.edn @@ -0,0 +1 @@ +{:vars #{for_all_STAR_ ErrorResult}} diff --git a/src/cherry/compiler.cljc b/src/cherry/compiler.cljc index d0abacc..f0d69a7 100644 --- a/src/cherry/compiler.cljc +++ b/src/cherry/compiler.cljc @@ -18,6 +18,7 @@ [cherry.internal.loop :as loop] [cherry.internal.macros :as macros] [cherry.internal.protocols :as protocols] + [cherry.internal.test-check :as test-check] [squint.internal.test :as test] [squint.internal.macros :as squint-macros] [clojure.string :as str] @@ -112,7 +113,15 @@ cc/common-macros)) (def built-in-macro-nss - {'cherry.test test/core-test-macros}) + {'cherry.test test/core-test-macros + 'clojure.test.check.clojure-test test-check/clojure-test-macros + 'clojure.test.check.properties test-check/properties-macros}) + +(def cherry-extra-ns-mappings + '{clojure.test.check "cherry-cljs/lib/clojure.test.check.js" + clojure.test.check.generators "cherry-cljs/lib/clojure.test.check.js" + clojure.test.check.properties "cherry-cljs/lib/clojure.test.check.js" + clojure.test.check.clojure-test "cherry-cljs/lib/clojure.test.check.js"}) (def core-config (resource/edn-resource "cherry/cljs.core.edn")) @@ -437,7 +446,8 @@ :imports imports :jsx false :need-html-import need-html-import - :pragmas pragmas)) + :pragmas pragmas + :built-in-macro-nss built-in-macro-nss)) jsx *jsx* _ (when (and jsx jsx-runtime) (swap! imports str diff --git a/src/cherry/internal/cli.cljs b/src/cherry/internal/cli.cljs index 9412a12..1f582e1 100644 --- a/src/cherry/internal/cli.cljs +++ b/src/cherry/internal/cli.cljs @@ -20,20 +20,21 @@ file)) (defn resolve-ns [opts in-file x] - (let [output-dir (:output-dir opts) - paths (:paths opts) - in-file-in-output-dir (file-in-output-dir in-file paths output-dir)] - (when-let [resolved - (some-> (utils/resolve-file x) - (file-in-output-dir paths output-dir) - (some->> (path/relative (path/dirname (str in-file-in-output-dir)))))] - (let [ext (:extension opts ".mjs") - ext (if (str/starts-with? ext ".") - ext - (str "." ext)) - ext' (path/extname resolved) - file (str "./" (str/replace resolved (re-pattern (str ext' "$")) ext))] - file)))) + (or (cc/cherry-extra-ns-mappings x) + (let [output-dir (:output-dir opts) + paths (:paths opts) + in-file-in-output-dir (file-in-output-dir in-file paths output-dir)] + (when-let [resolved + (some-> (utils/resolve-file x) + (file-in-output-dir paths output-dir) + (some->> (path/relative (path/dirname (str in-file-in-output-dir)))))] + (let [ext (:extension opts ".mjs") + ext (if (str/starts-with? ext ".") + ext + (str "." ext)) + ext' (path/extname resolved) + file (str "./" (str/replace resolved (re-pattern (str ext' "$")) ext))] + file))))) (defn files-from-path [path] (let [files (fs/readdirSync path)] diff --git a/src/cherry/internal/test_check.cljc b/src/cherry/internal/test_check.cljc new file mode 100644 index 0000000..bd1519a --- /dev/null +++ b/src/cherry/internal/test_check.cljc @@ -0,0 +1,36 @@ +(ns cherry.internal.test-check) + +(defn core-defspec [_&form _&env name num-tests-or-prop & rest] + (let [[num-tests prop] (if (number? num-tests-or-prop) + [num-tests-or-prop (first rest)] + [100 num-tests-or-prop])] + `(def ~(vary-meta name assoc :test true) + (with-meta + (fn [] + (let [result# (clojure.test.check/quick-check ~num-tests ~prop)] + (if (:pass? result#) + (clojure.test/report {:type :pass + :message (str "Passed " ~num-tests " trials")}) + (clojure.test/report {:type :fail + :message (str "Failed after " (:num-tests result#) " trials") + :expected '~prop + :actual (:shrunk result#)})))) + {:name '~name})))) + +(defn- binding-vars [bindings] + (map first (partition 2 bindings))) + +(defn- binding-gens [bindings] + (map second (partition 2 bindings))) + +(defn core-for-all [_&form _&env bindings & body] + `(clojure.test.check.properties/for-all* + ~(vec (binding-gens bindings)) + (fn [~@(binding-vars bindings)] + ~@body))) + +(def clojure-test-macros + {'defspec core-defspec}) + +(def properties-macros + {'for-all core-for-all}) diff --git a/test/cherry/cross_platform_test.cljc b/test/cherry/cross_platform_test.cljc index 3c1608f..49c089b 100644 --- a/test/cherry/cross_platform_test.cljc +++ b/test/cherry/cross_platform_test.cljc @@ -1,7 +1,10 @@ (ns cherry.cross-platform-test - (:require [clojure.test :as t #?@(:clj [:refer [deftest is testing are]])] - [clojure.string :as str]) - #?(:cljs (:require-macros [clojure.test :as t :refer [deftest is testing are async]]))) + (:require [clojure.test :as t :refer [deftest is testing are + #?@(:cljs [async])]] + [clojure.string :as str] + [clojure.test.check.generators :as gen] + [clojure.test.check.clojure-test :as tc-test :refer [defspec]] + [clojure.test.check.properties :as prop])) (defonce test-db (atom nil)) @@ -398,6 +401,91 @@ "run-tests should chain async tests in order") (t/set-once-fixtures! saved-fixtures)))))) +(defspec simple-integer-property 100 + (prop/for-all [x gen/small-integer] + (= x x))) + +(defspec vector-reversal-property 50 + (prop/for-all [v (gen/vector gen/small-integer)] + (= v (reverse (reverse v))))) + +(defspec generator-composition 50 + (prop/for-all [x (gen/fmap inc gen/small-integer)] + (> x (- x 1)))) + +(defspec multiple-generators 50 + (prop/for-all [x gen/small-integer + y gen/small-integer] + (= (+ x y) (+ y x)))) + +(defspec string-concatenation 50 + (prop/for-all [s1 gen/string-ascii + s2 gen/string-ascii] + (= (count (str s1 s2)) + (+ (count s1) (count s2))))) + +(defspec map-property 50 + (prop/for-all [m (gen/map gen/keyword gen/small-integer)] + (= (count m) (count (keys m))))) + +(defspec set-property 50 + (prop/for-all [s (gen/set gen/small-integer)] + (<= (count s) 100))) + +(defspec such-that-property 50 + (prop/for-all [x (gen/such-that pos? gen/small-integer 100)] + (pos? x))) + +(defspec pos-int-property 50 + (prop/for-all [x (gen/large-integer* {:min 1})] + (pos? x))) + +(defspec neg-int-property 50 + (prop/for-all [x (gen/large-integer* {:max -1})] + (neg? x))) + +(defspec nat-property 50 + (prop/for-all [x gen/nat] + (nat-int? x))) + +(defspec list-distinct-property 50 + (prop/for-all [xs (gen/list-distinct gen/small-integer)] + (= (count xs) (count (set xs))))) + +(defspec recursive-gen-property 20 + (prop/for-all [tree (gen/recursive-gen + (fn [inner] (gen/vector inner 0 3)) + gen/small-integer)] + (or (number? tree) (vector? tree)))) + +(defspec resize-property 50 + (prop/for-all [v (gen/resize 5 (gen/vector gen/small-integer))] + (<= (count v) 10))) + +#?(:cljs + (defspec verify-quick-check-catches-failures 20 + (prop/for-all [x gen/small-integer] + (pos? x)))) + +#?(:cljs + (defn verify-failure-detection + "Runs verify-quick-check-catches-failures and asserts it catches the bug." + [] + (let [saved-env (t/get-current-env) + saved-counters (:report-counters saved-env)] + (t/set-env! (assoc (t/empty-env) :testing-vars (:testing-vars saved-env))) + (let [fail-before (get-in (t/get-current-env) [:report-counters :fail] 0)] + (t/test-var verify-quick-check-catches-failures) + (let [fail-after (get-in (t/get-current-env) [:report-counters :fail] 0)] + (t/set-env! (assoc saved-env :report-counters saved-counters)) + (when-not (> fail-after fail-before) + (throw (js/Error. "quick-check should have caught failure but didn't!")))))))) + +#?(:cljs + (defn test-clojure-test-vars [] + (assert (number? tc-test/*default-test-count*) + "*default-test-count* should be a number"))) + #?(:clj (defn -main [] (let [result (t/run-tests 'cherry.cross-platform-test)] @@ -431,6 +519,22 @@ (t/test-var report-only-counts-pass-fail-error-test) (await (t/test-var async-done-form-test)) (t/test-var run-tests-quoted-symbol-test) + (t/test-var simple-integer-property) + (t/test-var vector-reversal-property) + (t/test-var generator-composition) + (t/test-var multiple-generators) + (t/test-var string-concatenation) + (t/test-var map-property) + (t/test-var set-property) + (t/test-var such-that-property) + (t/test-var pos-int-property) + (t/test-var neg-int-property) + (t/test-var nat-property) + (t/test-var list-distinct-property) + (t/test-var recursive-gen-property) + (t/test-var resize-property) + (test-clojure-test-vars) + (verify-failure-detection) (t/report {:type :summary}) (let [results (:report-counters (t/get-current-env))] (when-not (t/successful? results)