♻️ Add better reporting for generative tests

backend/test/backend_tests/util_objects_map_test.clj

@@ -92,11 +92,13 @@
            obj3 (assoc obj2 uuid/zero 1)
            obj4 (omap/create (deref obj3))]
        ;; (app.common.pprint/pprint data)
-       (t/is (= (hash obj1) (hash obj2)))
+
-       (t/is (not= (hash obj2) (hash obj3)))
+       (and (= (hash obj1) (hash obj2))
-       (t/is (bytes? (deref obj3)))
+            (not= (hash obj2) (hash obj3))
-       (t/is (pos? (alength (deref obj3))))
+            (bytes? (deref obj3))
-       (t/is (= (hash obj3) (hash obj4)))))))
+            (pos? (alength (deref obj3)))
+            (= (hash obj3) (hash obj4)))))
+   {:num 50}))
 
 (t/deftest fressian-encode-decode
   (sg/check!
@@ -106,12 +108,13 @@
                       (cg/fmap (fn [o] {:objects o})))]
 
      (let [res (-> data fres/encode fres/decode)]
-       (t/is (contains? res :objects))
+       (and (contains? res :objects)
-       (t/is (omap/objects-map? (:objects res)))
+            (omap/objects-map? (:objects res))
-       (t/is (= (count (:objects data))
+            (= (count (:objects data))
-                (count (:objects res))))
+               (count (:objects res)))
-       (t/is (= (hash (:objects data))
+            (= (hash (:objects data))
-                (hash (:objects res))))))))
+               (hash (:objects res))))))
+   {:num 50}))
 
 (t/deftest transit-encode-decode
   (sg/check!
@@ -122,16 +125,15 @@
      (let [res (-> data transit/encode transit/decode)]
        ;; (app.common.pprint/pprint data)
        ;; (app.common.pprint/pprint res)
-       (doseq [[k v] (:objects res)]
+       (and (every? (fn [[k v]]
-         (t/is (= v (get-in data [:objects k]))))
+                      (= v (get-in data [:objects k])))
-
+                    (:objects res))
-       (t/is (contains? res :objects))
+            (contains? res :objects)
-       (t/is (contains? data :objects))
+            (contains? data :objects)
-
+            (omap/objects-map? (:objects data))
-       (t/is (omap/objects-map? (:objects data)))
+            (not (omap/objects-map? (:objects res)))
-       (t/is (not (omap/objects-map? (:objects res))))
+            (= (count (:objects data))
-
+               (count (:objects res))))))
-       (t/is (= (count (:objects data))
+   {:num 50}))
-                (count (:objects res))))))))
 
 

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

@@ -8,34 +8,82 @@
   (:refer-clojure :exclude [set subseq uuid for 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
-  [{:keys [type result] :as args}]
+  "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
-    (prn (select-keys args [:result :num-tests :seed "time-elapsed-ms"]))
+    (ct/report {:type ::complete ::params args})
+
+    :trial
+    (ct/report {:type ::trial ::params args})
 
     :failure
-    (do
+    (ct/report {:type ::fail ::params args})
-      (prn (select-keys args [:num-tests :seed :failed-after-ms]))
+
-      (when #?(:clj (instance? Throwable result)
+    :shrunk
-               :cljs (instance? js/Error result))
+    (ct/report {:type ::thrunk ::params args})
-        (throw result)))
 
     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
-  [& params]
+  [bindings & body]
-  `(tp/for-all ~@params))
+  `(tp/for-all ~bindings ~@body))
 
 (defmacro let
   [& params]
@@ -43,7 +91,12 @@
 
 (defn check!
   [p & {:keys [num] :or {num 20} :as options}]
-  (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50)))
+  (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]
@@ -83,6 +136,11 @@
     (tg/such-that (fn [v] (>= (count v) 4)) $$ 100)
     (tg/fmap str/lower $$)))
 
+(defn word-keyword
+  []
+  (->> (word-string)
+       (tg/fmap keyword)))
+
 (defn email
   []
   (->> (word-string)

common/test/common_tests/file_changes_test.cljc

@@ -697,7 +697,7 @@
              data-3 (decode data-2)]
          ;; (app.common.pprint/pprint data-2)
          ;; (app.common.pprint/pprint data-3)
-         (t/is (= data data-3))))
+         (= data data-3)))
      {:num 1000})))
 
 (t/deftest set-guide-1
@@ -709,8 +709,8 @@
      (sg/for [change (sg/generator ch/schema:set-guide-change)]
        (let [change (assoc change :page-id page-id)
              result (ch/process-changes data [change])]
-         (t/is (= (:params change)
+         (= (:params change)
-                  (get-in result [:pages-index page-id :guides (:id change)])))))
+            (get-in result [:pages-index page-id :guides (:id change)]))))
      {:num 1000})))
 
 (t/deftest set-guide-2
@@ -727,11 +727,11 @@
              change2 (assoc change1 :params nil)
              result2 (ch/process-changes result1 [change2])]
 
-         (t/is (some? (:params change1)))
+         (and (some? (:params change1))
-         (t/is (= (:params change1)
+              (= (:params change1)
-                  (get-in result1 [:pages-index page-id :guides (:id change1)])))
+                 (get-in result1 [:pages-index page-id :guides (:id change1)]))
 
-         (t/is (nil? (:params change2)))
+              (nil? (:params change2))
-         (t/is (nil? (get-in result2 [:pages-index page-id :guides])))))
+              (nil? (get-in result2 [:pages-index page-id :guides])))))
 
      {:num 1000})))

common/test/common_tests/types/shape_decode_encode_test.cljc

@@ -56,7 +56,7 @@
              gradient-3 (decode gradient-2)]
          ;; (app.common.pprint/pprint gradient)
          ;; (app.common.pprint/pprint gradient-3)
-         (t/is (= gradient gradient-3))))
+         (= gradient gradient-3)))
      {:num 500})))
 
 (t/deftest color-json-roundtrip
@@ -69,7 +69,7 @@
              color-3 (decode color-2)]
          ;; (app.common.pprint/pprint color)
          ;; (app.common.pprint/pprint color-3)
-         (t/is (= color color-3))))
+         (= color color-3)))
      {:num 500})))
 
 (t/deftest shape-shadow-json-roundtrip
@@ -82,7 +82,7 @@
              shadow-3 (decode shadow-2)]
          ;; (app.common.pprint/pprint shadow)
          ;; (app.common.pprint/pprint shadow-3)
-         (t/is (= shadow shadow-3))))
+         (= shadow shadow-3)))
      {:num 500})))
 
 (t/deftest shape-animation-json-roundtrip
@@ -95,7 +95,7 @@
              animation-3 (decode animation-2)]
          ;; (app.common.pprint/pprint animation)
          ;; (app.common.pprint/pprint animation-3)
-         (t/is (= animation animation-3))))
+         (= animation animation-3)))
      {:num 500})))
 
 (t/deftest shape-interaction-json-roundtrip
@@ -108,7 +108,7 @@
              interaction-3 (decode interaction-2)]
          ;; (app.common.pprint/pprint interaction)
          ;; (app.common.pprint/pprint interaction-3)
-         (t/is (= interaction interaction-3))))
+         (= interaction interaction-3)))
      {:num 500})))
 
 
@@ -122,7 +122,7 @@
              path-content-3 (decode path-content-2)]
          ;; (app.common.pprint/pprint path-content)
          ;; (app.common.pprint/pprint path-content-3)
-         (t/is (= path-content path-content-3))))
+         (= path-content path-content-3)))
      {:num 500})))
 
 (t/deftest plugin-data-json-roundtrip
@@ -133,7 +133,7 @@
        (let [data-1 (encode data)
              data-2 (json-roundtrip data-1)
              data-3 (decode data-2)]
-         (t/is (= data data-3))))
+         (= data data-3)))
      {:num 500})))
 
 (t/deftest shape-json-roundtrip
@@ -146,5 +146,5 @@
              shape-3 (decode shape-2)]
          ;; (app.common.pprint/pprint shape)
          ;; (app.common.pprint/pprint shape-3)
-         (t/is (= shape shape-3))))
+         (= shape shape-3)))
      {:num 1000})))

common/test/common_tests/types_test.cljc

@@ -1,33 +0,0 @@
-;; 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 common-tests.types-test
-  (:require
-   [app.common.schema :as sm]
-   [app.common.schema.generators :as sg]
-   [app.common.transit :as transit]
-   [app.common.types.file :as ctf]
-   [app.common.types.page :as ctp]
-   [app.common.types.shape :as cts]
-   [clojure.test :as t]))
-
-(t/deftest transit-encode-decode-with-shape
-  (sg/check!
-   (sg/for [fdata (sg/generator ::cts/shape)]
-     (let [res (-> fdata transit/encode-str transit/decode-str)]
-       (t/is (= res fdata))))
-   {:num 18 :seed 1683548002439}))
-
-(t/deftest types-shape-spec
-  (sg/check!
-   (sg/for [fdata (sg/generator ::cts/shape)]
-     (binding [app.common.data.macros/*assert-context* true]
-       (t/is (sm/validate ::cts/shape fdata))))))
-
-(t/deftest types-page-spec
-  (-> (sg/for [fdata (sg/generator ::ctp/page)]
-        (t/is (sm/validate ::ctp/page fdata)))
-      (sg/check! {:num 30})))

common/test/common_tests/uuid_test.cljc

@@ -14,5 +14,5 @@
   (sg/check!
    (sg/for [uuid1 (sg/generator ::sm/uuid)
             uuid2 (sg/generator ::sm/uuid)]
-     (t/is (not= uuid1 uuid2)))
+     (not= uuid1 uuid2))
-   {:num 100}))
+   {:num 200}))