From 61446592b39952faea5173d93f86258f1bc94725 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 10 Sep 2024 13:40:23 +0200 Subject: [PATCH] :sparkles: Move generative test related code to a separated ns --- .../backend_tests/util_objects_map_test.clj | 27 +++--- common/src/app/common/schema/generators.cljc | 83 +--------------- common/src/app/common/schema/test.cljc | 97 +++++++++++++++++++ .../test/common_tests/file_changes_test.cljc | 23 ++--- .../types/shape_decode_encode_test.cljc | 33 ++++--- 5 files changed, 142 insertions(+), 121 deletions(-) create mode 100644 common/src/app/common/schema/test.cljc diff --git a/backend/test/backend_tests/util_objects_map_test.clj b/backend/test/backend_tests/util_objects_map_test.clj index bec6a7b3e..56c589f6b 100644 --- a/backend/test/backend_tests/util_objects_map_test.clj +++ b/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! - (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) - (cg/not-empty))] + (smt/check! + (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) + (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! - (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) - (cg/not-empty) - (cg/fmap omap/wrap) - (cg/fmap (fn [o] {:objects o})))] + (smt/check! + (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) + (cg/not-empty) + (cg/fmap omap/wrap) + (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! - (sg/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) - (cg/not-empty) - (cg/fmap omap/wrap) - (cg/fmap (fn [o] {:objects o})))] + (smt/check! + (smt/for [data (->> (cg/map cg/uuid (sg/generator ::cts/shape)) + (cg/not-empty) + (cg/fmap omap/wrap) + (cg/fmap (fn [o] {:objects o})))] (let [res (-> data transit/encode transit/decode)] ;; (app.common.pprint/pprint data) ;; (app.common.pprint/pprint res) diff --git a/common/src/app/common/schema/generators.cljc b/common/src/app/common/schema/generators.cljc index 978e79407..57bc3703f 100644 --- a/common/src/app/common/schema/generators.cljc +++ b/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 [i] (uuid/custom 100 i))))) + (tg/fmap (fn [_] (uuid/next)) (small-int))) (defn subseq "Given a collection, generates \"subsequences\" which are sequences diff --git a/common/src/app/common/schema/test.cljc b/common/src/app/common/schema/test.cljc new file mode 100644 index 000000000..7fa774dd1 --- /dev/null +++ b/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?)))) diff --git a/common/test/common_tests/file_changes_test.cljc b/common/test/common_tests/file_changes_test.cljc index 50b4509a5..f4f6a30d5 100644 --- a/common/test/common_tests/file_changes_test.cljc +++ b/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! - (sg/for [data (sg/generator schema)] + (smt/check! + (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! - (sg/for [change (sg/generator ch/schema:set-guide-change)] + (smt/check! + (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! - (sg/for [change (->> (sg/generator ch/schema:set-guide-change) - (sg/filter :params))] + (smt/check! + (smt/for [change (->> (sg/generator ch/schema:set-guide-change) + (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! - (sg/for [data (sg/generator schema)] + (smt/check! + (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! - (sg/for [change (sg/generator ch/schema:set-plugin-data-change)] + (smt/check! + (smt/for [change (sg/generator ch/schema:set-plugin-data-change)] (sm/validate ch/schema:set-plugin-data-change change)) {:num 1000}))) diff --git a/common/test/common_tests/types/shape_decode_encode_test.cljc b/common/test/common_tests/types/shape_decode_encode_test.cljc index 0f244cc0d..2434f5fc6 100644 --- a/common/test/common_tests/types/shape_decode_encode_test.cljc +++ b/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! - (sg/for [gradient (sg/generator schema:gradient)] + (smt/check! + (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! - (sg/for [color (sg/generator schema:color)] + (smt/check! + (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! - (sg/for [shadow (sg/generator schema:shadow)] + (smt/check! + (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! - (sg/for [animation (sg/generator schema:animation)] + (smt/check! + (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! - (sg/for [interaction (sg/generator schema:interaction)] + (smt/check! + (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! - (sg/for [path-content (sg/generator schema:path-content)] + (smt/check! + (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! - (sg/for [data (sg/generator schema:plugin-data)] + (smt/check! + (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! - (sg/for [shape (sg/generator ::tsh/shape)] + (smt/check! + (smt/for [shape (sg/generator ::tsh/shape)] (let [shape-1 (encode shape) shape-2 (json-roundtrip shape-1) shape-3 (decode shape-2)]