✨ Move generative test related code to a separated ns

backend/test/backend_tests/util_objects_map_test.clj

@@ -8,6 +8,7 @@
   (:require
    [app.common.fressian :as fres]
    [app.common.schema.generators :as sg]
+   [app.common.schema.test :as smt]
    [app.common.transit :as transit]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
@@ -84,9 +85,9 @@
       (t/is (= (hash obj1) (hash obj2))))))
 
 (t/deftest internal-encode-decode
-  (sg/check!
+  (smt/check!
-   (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
+   (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
-                      (cg/not-empty))]
+                       (cg/not-empty))]
      (let [obj1 (omap/wrap data)
            obj2 (omap/create (deref obj1))
            obj3 (assoc obj2 uuid/zero 1)
@@ -101,11 +102,11 @@
    {:num 50}))
 
 (t/deftest fressian-encode-decode
-  (sg/check!
+  (smt/check!
-   (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
+   (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
-                      (cg/not-empty)
+                       (cg/not-empty)
-                      (cg/fmap omap/wrap)
+                       (cg/fmap omap/wrap)
-                      (cg/fmap (fn [o] {:objects o})))]
+                       (cg/fmap (fn [o] {:objects o})))]
 
      (let [res (-> data fres/encode fres/decode)]
        (and (contains? res :objects)
@@ -117,11 +118,11 @@
    {:num 50}))
 
 (t/deftest transit-encode-decode
-  (sg/check!
+  (smt/check!
-   (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
+   (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape))
-                      (cg/not-empty)
+                       (cg/not-empty)
-                      (cg/fmap omap/wrap)
+                       (cg/fmap omap/wrap)
-                      (cg/fmap (fn [o] {:objects o})))]
+                       (cg/fmap (fn [o] {:objects o})))]
      (let [res (-> data transit/encode transit/decode)]
        ;; (app.common.pprint/pprint data)
        ;; (app.common.pprint/pprint res)

common/src/app/common/schema/generators.cljc

@@ -5,99 +5,21 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema.generators
-  (:refer-clojure :exclude [set subseq uuid for filter map let boolean])
+  (:refer-clojure :exclude [set subseq uuid filter map let boolean])
   #?(:cljs (:require-macros [app.common.schema.generators]))
   (:require
-   [app.common.pprint :as pp]
    [app.common.schema.registry :as sr]
    [app.common.uri :as u]
    [app.common.uuid :as uuid]
    [clojure.core :as c]
-   [clojure.test :as ct]
-   [clojure.test.check :as tc]
    [clojure.test.check.generators :as tg]
-   [clojure.test.check.properties :as tp]
    [cuerdas.core :as str]
    [malli.generator :as mg]))
 
-(defn- get-testing-var
-  []
-  (c/let [testing-vars #?(:clj ct/*testing-vars*
-                          :cljs (:testing-vars ct/*current-env*))]
-    (first testing-vars)))
-
-(defn- get-testing-sym
-  [var]
-  (c/let [tmeta (meta var)]
-    (:name tmeta)))
-
-(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
-    (ct/report {:type ::complete ::params args})
-
-    :trial
-    (ct/report {:type ::trial ::params args})
-
-    :failure
-    (ct/report {:type ::fail ::params args})
-
-    :shrunk
-    (ct/report {:type ::thrunk ::params args})
-
-    nil))
-
-(defmethod ct/report ::complete
-  [{:keys [::params] :as m}]
-  #?(:clj  (ct/inc-report-counter :pass)
-     :cljs (ct/inc-report-counter! :pass))
-  (c/let [tvar (get-testing-var)
-          tsym (get-testing-sym tvar)]
-    (println "Generative test:" (str "'" tsym "'")
-             (str "(pass=TRUE, tests=" (:num-tests params)  ", seed=" (:seed params)  ")"))))
-
-(defmethod ct/report ::thrunk
-  [{:keys [::params] :as m}]
-  (c/let [smallest (-> params :shrunk :smallest vec)]
-    (println)
-    (println "Failed with params:")
-    (pp/pprint smallest)))
-
-(defmethod ct/report ::trial
-  [_]
-  #?(:clj  (ct/inc-report-counter :pass)
-     :cljs (ct/inc-report-counter! :pass)))
-
-(defmethod ct/report ::fail
-  [{:keys [::params] :as m}]
-  #?(:clj  (ct/inc-report-counter :fail)
-     :cljs (ct/inc-report-counter! :fail))
-  (c/let [tvar (get-testing-var)
-          tsym (get-testing-sym tvar)]
-    (println)
-    (println "Generative test:" (str "'" tsym "'")
-             (str "(pass=FALSE, tests=" (:num-tests params)  ", seed=" (:seed params)  ")"))))
-
-(defmacro for
-  [bindings & body]
-  `(tp/for-all ~bindings ~@body))
-
 (defmacro let
   [& params]
   `(tg/let ~@params))
 
-(defn check!
-  [p & {:keys [num] :or {num 20} :as options}]
-  (c/let [result (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50))
-          pass?        (:pass? result)
-          total-tests  (:num-tests result)]
-
-    (ct/is (= num total-tests))
-    (ct/is (true? pass?))))
-
 (defn sample
   ([g]
    (mg/sample g {:registry sr/default-registry}))
@@ -160,8 +82,7 @@
 
 (defn uuid
   []
-  (->> (small-int :min 1 :max 100000000)
+  (tg/fmap (fn [_] (uuid/next)) (small-int)))
-       (tg/fmap (fn [i] (uuid/custom 100 i)))))
 
 (defn subseq
   "Given a collection, generates \"subsequences\" which are sequences

common/src/app/common/schema/test.cljc

@@ -0,0 +1,97 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.common.schema.test
+  (:refer-clojure :exclude [for])
+  #?(:cljs (:require-macros [app.common.schema.test]))
+
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.pprint :as pp]
+   [clojure.test :as ct]
+   [clojure.test.check :as tc]
+   [clojure.test.check.properties :as tp]))
+
+(defn- get-testing-var
+  []
+  (let [testing-vars #?(:clj ct/*testing-vars*
+                        :cljs (:testing-vars ct/*current-env*))]
+    (first testing-vars)))
+
+(defn- get-testing-sym
+  [var]
+  (let [tmeta (meta var)]
+    (:name tmeta)))
+
+(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
+    (ct/report {:type ::complete ::params args})
+
+    :trial
+    (ct/report {:type ::trial ::params args})
+
+    :failure
+    (ct/report {:type ::fail ::params args})
+
+    :shrunk
+    (ct/report {:type ::thrunk ::params args})
+
+    nil))
+
+(defmethod ct/report #?(:clj ::complete :cljs [:cljs.test/default ::complete])
+  [{:keys [::params] :as m}]
+  #?(:clj  (ct/inc-report-counter :pass)
+     :cljs (ct/inc-report-counter! :pass))
+  (let [tvar (get-testing-var)
+        tsym (get-testing-sym tvar)
+        time (:time-elapsed-ms params)]
+    (println "Generative test:" (str "'" tsym "'")
+             (str "(pass=TRUE, tests=" (:num-tests params)  ", seed=" (:seed params) ", elapsed=" time "ms)"))))
+
+(defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
+  [{:keys [::params] :as m}]
+  (let [smallest (-> params :shrunk :smallest vec)]
+    (println)
+    (println "Condition failed with the following params:")
+    (println)
+    (pp/pprint smallest)))
+
+(defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
+  [_]
+  #?(:clj  (ct/inc-report-counter :pass)
+     :cljs (ct/inc-report-counter! :pass)))
+
+(defmethod ct/report #?(:clj ::fail :cljs [:cljs.test/default ::fail])
+  [{:keys [::params] :as m}]
+  #?(:clj  (ct/inc-report-counter :fail)
+     :cljs (ct/inc-report-counter! :fail))
+  (let [tvar (get-testing-var)
+        tsym (get-testing-sym tvar)
+        res  (:result params)]
+    (println)
+    (println "Generative test:" (str "'" tsym "'")
+             (str "(pass=FALSE, tests=" (:num-tests params)  ", seed=" (:seed params)  ")"))
+
+    (when (ex/exception? res)
+      #?(:clj (ex/print-throwable res)
+         :cljs (js/console.error res)))))
+
+(defmacro for
+  [bindings & body]
+  `(tp/for-all ~bindings ~@body))
+
+(defn check!
+  [p & {:keys [num] :or {num 20} :as options}]
+  (let [result (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50))
+        pass?        (:pass? result)
+        total-tests  (:num-tests result)]
+
+    (ct/is (= num total-tests))
+    (ct/is (true? pass?))))

common/test/common_tests/file_changes_test.cljc

@@ -10,6 +10,7 @@
    [app.common.files.changes :as ch]
    [app.common.schema :as sm]
    [app.common.schema.generators :as sg]
+   [app.common.schema.test :as smt]
    [app.common.types.file :as ctf]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
@@ -690,8 +691,8 @@
   (let [schema ch/schema:set-guide-change
         encode (sm/encoder schema (sm/json-transformer))
         decode (sm/decoder schema (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [data (sg/generator schema)]
+     (smt/for [data (sg/generator schema)]
        (let [data-1 (encode data)
              data-2 (json-roundtrip data-1)
              data-3 (decode data-2)]
@@ -705,8 +706,8 @@
         page-id (uuid/custom 1 1)
         data    (make-file-data file-id page-id)]
 
-    (sg/check!
+    (smt/check!
-     (sg/for [change (sg/generator ch/schema:set-guide-change)]
+     (smt/for [change (sg/generator ch/schema:set-guide-change)]
        (let [change (assoc change :page-id page-id)
              result (ch/process-changes data [change])]
          (= (:params change)
@@ -718,9 +719,9 @@
         page-id (uuid/custom 1 1)
         data    (make-file-data file-id page-id)]
 
-    (sg/check!
+    (smt/check!
-     (sg/for [change (->> (sg/generator ch/schema:set-guide-change)
+     (smt/for [change (->> (sg/generator ch/schema:set-guide-change)
-                          (sg/filter :params))]
+                           (sg/filter :params))]
        (let [change1 (assoc change :page-id page-id)
              result1 (ch/process-changes data [change1])
 
@@ -740,8 +741,8 @@
   (let [schema ch/schema:set-plugin-data-change
         encode (sm/encoder schema (sm/json-transformer))
         decode (sm/decoder schema (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [data (sg/generator schema)]
+     (smt/for [data (sg/generator schema)]
        (let [data-1 (encode data)
              data-2 (json-roundtrip data-1)
              data-3 (decode data-2)]
@@ -752,7 +753,7 @@
   (let [file-id (uuid/custom 2 2)
         page-id (uuid/custom 1 1)
         data    (make-file-data file-id page-id)]
-    (sg/check!
+    (smt/check!
-     (sg/for [change (sg/generator ch/schema:set-plugin-data-change)]
+     (smt/for [change (sg/generator ch/schema:set-plugin-data-change)]
        (sm/validate ch/schema:set-plugin-data-change change))
      {:num 1000})))

common/test/common_tests/types/shape_decode_encode_test.cljc

@@ -10,6 +10,7 @@
    [app.common.pprint :as pp]
    [app.common.schema :as sm]
    [app.common.schema.generators :as sg]
+   [app.common.schema.test :as smt]
    [app.common.types.color :refer [schema:color schema:gradient]]
    [app.common.types.plugins :refer [schema:plugin-data]]
    [app.common.types.shape :as tsh]
@@ -49,8 +50,8 @@
 (t/deftest gradient-json-roundtrip
   (let [encode (sm/encoder schema:gradient (sm/json-transformer))
         decode (sm/decoder schema:gradient (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [gradient (sg/generator schema:gradient)]
+     (smt/for [gradient (sg/generator schema:gradient)]
        (let [gradient-1 (encode gradient)
              gradient-2 (json-roundtrip gradient-1)
              gradient-3 (decode gradient-2)]
@@ -62,8 +63,8 @@
 (t/deftest color-json-roundtrip
   (let [encode (sm/encoder schema:color (sm/json-transformer))
         decode (sm/decoder schema:color (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [color (sg/generator schema:color)]
+     (smt/for [color (sg/generator schema:color)]
        (let [color-1 (encode color)
              color-2 (json-roundtrip color-1)
              color-3 (decode color-2)]
@@ -75,8 +76,8 @@
 (t/deftest shape-shadow-json-roundtrip
   (let [encode (sm/encoder schema:shadow (sm/json-transformer))
         decode (sm/decoder schema:shadow (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [shadow (sg/generator schema:shadow)]
+     (smt/for [shadow (sg/generator schema:shadow)]
        (let [shadow-1 (encode shadow)
              shadow-2 (json-roundtrip shadow-1)
              shadow-3 (decode shadow-2)]
@@ -88,8 +89,8 @@
 (t/deftest shape-animation-json-roundtrip
   (let [encode (sm/encoder schema:animation (sm/json-transformer))
         decode (sm/decoder schema:animation (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [animation (sg/generator schema:animation)]
+     (smt/for [animation (sg/generator schema:animation)]
        (let [animation-1 (encode animation)
              animation-2 (json-roundtrip animation-1)
              animation-3 (decode animation-2)]
@@ -101,8 +102,8 @@
 (t/deftest shape-interaction-json-roundtrip
   (let [encode (sm/encoder schema:interaction (sm/json-transformer))
         decode (sm/decoder schema:interaction (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [interaction (sg/generator schema:interaction)]
+     (smt/for [interaction (sg/generator schema:interaction)]
        (let [interaction-1 (encode interaction)
              interaction-2 (json-roundtrip interaction-1)
              interaction-3 (decode interaction-2)]
@@ -115,8 +116,8 @@
 (t/deftest shape-path-content-json-roundtrip
   (let [encode (sm/encoder schema:path-content (sm/json-transformer))
         decode (sm/decoder schema:path-content (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [path-content (sg/generator schema:path-content)]
+     (smt/for [path-content (sg/generator schema:path-content)]
        (let [path-content-1 (encode path-content)
              path-content-2 (json-roundtrip path-content-1)
              path-content-3 (decode path-content-2)]
@@ -128,8 +129,8 @@
 (t/deftest plugin-data-json-roundtrip
   (let [encode (sm/encoder schema:plugin-data (sm/json-transformer))
         decode (sm/decoder schema:plugin-data (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [data (sg/generator schema:plugin-data)]
+     (smt/for [data (sg/generator schema:plugin-data)]
        (let [data-1 (encode data)
              data-2 (json-roundtrip data-1)
              data-3 (decode data-2)]
@@ -139,8 +140,8 @@
 (t/deftest shape-json-roundtrip
   (let [encode (sm/encoder ::tsh/shape (sm/json-transformer))
         decode (sm/decoder ::tsh/shape (sm/json-transformer))]
-    (sg/check!
+    (smt/check!
-     (sg/for [shape (sg/generator ::tsh/shape)]
+     (smt/for [shape (sg/generator ::tsh/shape)]
        (let [shape-1 (encode shape)
              shape-2 (json-roundtrip shape-1)
              shape-3 (decode shape-2)]