0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-01-06 14:50:20 -05:00

Move generative test related code to a separated ns

This commit is contained in:
Andrey Antukh 2024-09-10 13:40:23 +02:00 committed by Alonso Torres
parent b82c6326cf
commit 61446592b3
5 changed files with 142 additions and 121 deletions

View file

@ -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)

View file

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

View file

@ -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?))))

View file

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

View file

@ -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)]