WIP: Add test.check

CHANGELOG.md

@@ -3,6 +3,8 @@
 ## Unreleased
 
 - Multiple `:require-macros` clauses with `:refer` now properly accumulate instead of overwriting each other
+- Add `cherry.test` with clojure.test-compatible testing macros and async support
+- Add test.check support
 
 ## 0.5.34 (2025-12-18)
 

bb/integration_tests.clj

@@ -6,7 +6,7 @@
 (deftest macro-test
   (let [out (:out (sh {:err :inherit
                        :dir "test-resources/test_project"}
-                   "npx cherry run macro_test.cljs"))]
+                      "npx cherry run macro_test.cljs"))]
     (is (str/includes? out "22"))
     (is (str/includes? out "1"))))
 
@@ -28,6 +28,26 @@
     (sh "npx" "cherry" "compile" tmp-file)
     (is (.exists (java.io.File. out-file)) "compile should create output file")))
 
+(deftest cross-platform-jvm-test
+  (let [{:keys [exit]} (sh {:err :inherit}
+                           "clojure -M:test -n cherry.cross-platform-test")]
+    (is (zero? exit) "cross-platform test passes on JVM")))
+
+(deftest test-check-jvm-test
+  (let [{:keys [exit]} (sh {:err :inherit}
+                           "clojure -M:test -n cherry.test-check-test")]
+    (is (zero? exit) "test.check tests pass on JVM")))
+
+(deftest cross-platform-cherry-test
+  (let [out (:out (sh {:err :inherit}
+                      "node lib/cli.js run test/cherry/cross_platform_test.cljc"))]
+    (is (str/includes? out "0 failures") "cross-platform test passes on Cherry")))
+
+(deftest cross-platform-test-check-test
+  (let [out (:out (sh {:err :inherit}
+                      "node lib/cli.js run test/cherry/test_check_test.cljc"))]
+    (is (str/includes? out "0 failures") "test.check tests pass on Cherry")))
+
 (defn run-tests []
   (shell {:dir "test-resources/test_project"} "npm install")
   (let [{:keys [fail error]} (t/run-tests 'integration-tests)]

bb/tasks.clj

@@ -26,6 +26,11 @@
         walk-config (edn/read-string (slurp (io/resource "cherry/clojure.walk.edn")))
         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)
@@ -41,7 +46,16 @@
                     :depends-on #{:cljs.core}}
       :cljs.pprint {:exports (->namespace "cljs.pprint" (:vars pprint-config) reserved)
                     :entries '[cljs.pprint]
-                    :depends-on #{:cljs.core :clojure.string}}}}))
+                    :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}}
+      :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}

cherry-overrides/clojure/test/check/clojure_test.cljc

@@ -0,0 +1,18 @@
+(ns clojure.test.check.clojure-test)
+
+(defmacro defspec [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# (~'quick-check ~num-tests ~prop)]
+             (if (:pass? result#)
+               (~'report {:type :pass
+                          :message (str "Passed " ~num-tests " trials")})
+               (~'report {:type :fail
+                          :message (str "Failed after " (:num-tests result#) " trials")
+                          :expected '~prop
+                          :actual (:shrunk result#)}))))
+         {:name '~name}))))

cherry-overrides/clojure/test/check/properties.cljc

@@ -0,0 +1,18 @@
+(ns clojure.test.check.properties)
+
+(defn- binding-vars
+  "Extract variable names from let-style bindings vector."
+  [bindings]
+  (map first (partition 2 bindings)))
+
+(defn- binding-gens
+  "Extract generator expressions from let-style bindings vector."
+  [bindings]
+  (map second (partition 2 bindings)))
+
+(defmacro for-all
+  [bindings & body]
+  (let [for-all-sym 'for-all*]
+    `(~for-all-sym ~(vec (binding-gens bindings))
+                   (fn [~@(binding-vars bindings)]
+                     ~@body))))

deps.edn

@@ -8,12 +8,13 @@
  {: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}}
- }
+   :exec-fn cognitect.test-runner.api/test}}}

package.json

@@ -7,7 +7,8 @@
     "cljs.core.js",
     "lib",
     "node_cli.js",
-    "index.js"
+    "index.js",
+    "cherry-overrides"
   ],
   "bin": {
     "cherry": "node_cli.js"

resources/cherry/cherry.test.edn

@@ -0,0 +1,20 @@
+{:vars #{report
+         successful_QMARK_
+         empty_env
+         get_current_env
+         set_env_BANG_
+         clear_env_BANG_
+         update_current_env_BANG_
+         inc_report_counter_BANG_
+         testing_contexts_str
+         testing_vars_str
+         test_var
+         compose_fixtures
+         join_fixtures
+         get_each_fixtures
+         set_each_fixtures_BANG_
+         get_once_fixtures
+         set_once_fixtures_BANG_
+         run_tests
+         async_QMARK_
+         wrap_async}}

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}}

resources/cherry/clojure.test.check.edn

@@ -0,0 +1 @@
+{:vars #{quick_check}}

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}}

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

@@ -0,0 +1 @@
+{:vars #{for_all_STAR_ ErrorResult}}

src/cherry/compiler.cljc

@@ -222,8 +222,9 @@
                                      (or
                                       ;; used by cherry embed:
                                       (some-> env :macros (get nss) (get nms))
-                                      (let [resolved-ns (get-in current-ns-state [:aliases nss] nss)]
-                                        (get-in ns-state [:macros resolved-ns nms]))))
+                                      (let [resolved-ns (get-in current-ns-state [:aliases nss] nss)
+                                              macro-ns (cc/resolve-macro-ns resolved-ns)]
+                                        (get-in ns-state [:macros macro-ns nms]))))
                                    (let [refers (:refers current-ns-state)]
                                      (when-let [macro-ns (get refers nms)]
                                        (or (some-> env :macros (get (symbol macro-ns)) (get nms))

src/cherry/compiler/node.cljs

@@ -6,6 +6,7 @@
    [clojure.string :as str]
    [edamame.core :as e]
    [shadow.esm :as esm]
+   [squint.compiler-common :as cc]
    [squint.internal.node.utils :as utils]))
 
 (def sci (atom nil))
@@ -35,11 +36,12 @@
                         (.then prev
                                (fn [_]
                                  (let [[macro-ns & {:keys [refer as]}] require-macros
+                                       actual-ns (cc/resolve-macro-ns macro-ns)
                                        macros (js/Promise.resolve
-                                               (do (eval-form (cond-> (list 'require (list 'quote macro-ns))
+                                               (do (eval-form (cond-> (list 'require (list 'quote actual-ns))
                                                                 reload (concat [:reload])))
                                                    (let [publics (eval-form
-                                                                  `(ns-publics '~macro-ns))
+                                                                  `(ns-publics '~actual-ns))
                                                          ks (keys publics)
                                                          vs (vals publics)
                                                          vs (map deref vs)
@@ -48,7 +50,7 @@
                                    (.then macros
                                           (fn [macros]
                                             (swap! ns-state (fn [ns-state]
-                                                              (cond-> (assoc-in ns-state [:macros macro-ns] macros)
+                                                              (cond-> (-> ns-state (assoc-in [:macros macro-ns] macros) (assoc-in [:macros actual-ns] macros))
                                                                 as (assoc-in [the-ns-name :aliases as] macro-ns)
                                                                 refer (update-in [the-ns-name :refers]
                                                                                  merge

src/cherry/compiler/sci.cljs

@@ -2,12 +2,13 @@
   (:require ["fs" :as fs]
             [cherry.compiler.node :as cn :refer [sci]]
             [sci.core :as sci]
-            [squint.internal.node.utils :refer [resolve-file]]))
+            [squint.internal.node.utils :as utils :refer [resolve-file]]))
 
 (defn slurp [f]
   (fs/readFileSync f "utf-8"))
 
 (def ctx (sci/init {:load-fn (fn [{:keys [namespace]}]
+                               (utils/set-cfg! {:paths ["." "src" "cherry-overrides"]})
                                (let [f (resolve-file namespace)
                                      fstr (slurp f)]
                                  {:source fstr}))

src/cherry/test.cljc

@@ -0,0 +1,93 @@
+(ns cherry.test)
+
+(defn assert-expr [msg form]
+  (let [op (when (sequential? form) (first form))
+        loc (meta form)
+        line (:line loc)
+        column (:column loc)
+        report (fn [type expected actual ret]
+                 `(do (clojure.test/report {:type ~type :message ~msg :expected ~expected :actual ~actual
+                                            ~@(when line [:line line])
+                                            ~@(when column [:column column])})
+                      ~ret))
+        default (let [sym (gensym "value")]
+                  `(let [~sym ~form]
+                     (if ~sym
+                       ~(report :pass `'~form sym sym)
+                       ~(report :fail `'~form sym sym))))]
+    (case op
+      = (if (= 2 (count (rest form)))
+          (let [[expected actual] (rest form)
+                expected-sym (gensym "expected")
+                actual-sym (gensym "actual")
+                result-sym (gensym "result")]
+            `(let [~expected-sym ~expected
+                   ~actual-sym ~actual
+                   ~result-sym (= ~expected-sym ~actual-sym)]
+               (if ~result-sym
+                 ~(report :pass expected-sym actual-sym true)
+                 ~(report :fail expected-sym actual-sym false))))
+          default)
+      thrown? (let [klass (second form)
+                    body (nthnext form 2)
+                    e-sym (gensym "e")]
+                `(try
+                   (do ~@body)
+                   ~(report :fail `'~form "No exception thrown" false)
+                   (catch :default ~e-sym
+                     (if (instance? ~klass ~e-sym)
+                       ~(report :pass `'~form e-sym true)
+                       ~(report :fail `'~form e-sym false)))))
+      thrown-with-msg? (let [klass (second form)
+                             re (nth form 2)
+                             body (nthnext form 3)
+                             e-sym (gensym "e")]
+                         `(try
+                            (do ~@body)
+                            ~(report :fail `'~form "No exception thrown" false)
+                            (catch :default ~e-sym
+                              (if (instance? ~klass ~e-sym)
+                                (if (re-find ~re (.-message ~e-sym))
+                                  ~(report :pass `'~form e-sym true)
+                                  ~(report :fail `'~form `(str "Exception message \"" (.-message ~e-sym) "\" did not match " ~re) false))
+                                ~(report :fail `'~form e-sym false)))))
+      default)))
+
+(defmacro deftest [name & body]
+  (let [fn-meta (select-keys (meta name) [:async])]
+    `(def ~(vary-meta name assoc :test true)
+       (with-meta ~(with-meta `(fn [] ~@body) fn-meta) {:name '~name}))))
+
+(defmacro is
+  ([form] `(is ~form nil))
+  ([form msg]
+   (let [loc (meta &form)
+         form-with-meta (if (and loc (or (sequential? form) (symbol? form)))
+                          (with-meta form loc)
+                          form)]
+     (assert-expr msg form-with-meta))))
+
+(defmacro testing [string & body]
+  `(do
+     (clojure.test/update-current-env! [:testing-contexts] conj ~string)
+     (try
+       ~@body
+       (finally
+         (clojure.test/update-current-env! [:testing-contexts] rest)))))
+
+(defmacro deftest- [name & body]
+  `(deftest ~(vary-meta name assoc :private true) ~@body))
+
+(defmacro are [bindings expr & args]
+  (assert (pos? (count bindings)) "are requires at least one binding")
+  (assert (seq args) "are requires at least one test case")
+  (let [binding-count (count bindings)]
+    (assert (zero? (mod (count args) binding-count))
+            (str "are: arg count (" (count args) ") must be divisible by binding count (" binding-count ")"))
+    `(do ~@(for [arg-group (partition binding-count args)]
+             `(clojure.test/is (let [~@(interleave bindings arg-group)] ~expr))))))
+
+(defmacro use-fixtures [type & fns]
+  (case type
+    :once `(clojure.test/set-once-fixtures! [~@fns])
+    :each `(clojure.test/set-each-fixtures! [~@fns])))