[#487] Include clojure.test.check as preparation for clojure.spec
This commit is contained in:
Michiel Borkent
GitHub
parent
c4bb42df3e
commit
931fadabb2
15 changed files with 3048 additions and 45 deletions
3
deps.edn
3
deps.edn
|
|
@ -5,6 +5,8 @@
|
||||||
"feature-lanterna"
|
"feature-lanterna"
|
||||||
"feature-core-match"
|
"feature-core-match"
|
||||||
"feature-hiccup"
|
"feature-hiccup"
|
||||||
|
"feature-test-check"
|
||||||
|
"feature-spec-alpha"
|
||||||
"sci/src" "babashka.curl/src" "pods/src"
|
"sci/src" "babashka.curl/src" "pods/src"
|
||||||
"babashka.nrepl/src"
|
"babashka.nrepl/src"
|
||||||
"depstar/src" "process/src"
|
"depstar/src" "process/src"
|
||||||
|
|
@ -21,6 +23,7 @@
|
||||||
org.clojure/data.xml {:mvn/version "0.2.0-alpha6"}
|
org.clojure/data.xml {:mvn/version "0.2.0-alpha6"}
|
||||||
clj-commons/clj-yaml {:mvn/version "0.7.2"}
|
clj-commons/clj-yaml {:mvn/version "0.7.2"}
|
||||||
com.cognitect/transit-clj {:mvn/version "1.0.324"}
|
com.cognitect/transit-clj {:mvn/version "1.0.324"}
|
||||||
|
org.clojure/test.check {:mvn/version "1.1.0"}
|
||||||
nrepl/bencode {:mvn/version "1.1.0"}
|
nrepl/bencode {:mvn/version "1.1.0"}
|
||||||
seancorfield/next.jdbc {:mvn/version "1.1.610"}
|
seancorfield/next.jdbc {:mvn/version "1.1.610"}
|
||||||
org.postgresql/postgresql {:mvn/version "42.2.18"}
|
org.postgresql/postgresql {:mvn/version "42.2.18"}
|
||||||
|
|
|
||||||
61
feature-spec-alpha/babashka/impl/spec.clj
Normal file
61
feature-spec-alpha/babashka/impl/spec.clj
Normal file
|
|
@ -0,0 +1,61 @@
|
||||||
|
(ns babashka.impl.spec
|
||||||
|
{:no-doc true}
|
||||||
|
(:require [babashka.impl.clojure.spec.alpha :as s]
|
||||||
|
[babashka.impl.clojure.spec.gen.alpha :as gen]
|
||||||
|
[babashka.impl.clojure.spec.test.alpha :as test]
|
||||||
|
[clojure.core :as c]
|
||||||
|
[sci.core :as sci :refer [copy-var]]
|
||||||
|
[sci.impl.vars :as vars]))
|
||||||
|
|
||||||
|
(def sns (vars/->SciNamespace 'clojure.spec.alpha nil))
|
||||||
|
(def tns (vars/->SciNamespace 'clojure.spec.test.alpha nil))
|
||||||
|
(def gns (vars/->SciNamespace 'clojure.spec.gen.alpha nil))
|
||||||
|
|
||||||
|
(defn- ns-qualify
|
||||||
|
"Qualify symbol s by resolving it or using the current *ns*."
|
||||||
|
[s]
|
||||||
|
(if-let [ns-sym (some-> s namespace symbol)]
|
||||||
|
(c/or (some-> (get (ns-aliases *ns*) ns-sym) str (symbol (name s)))
|
||||||
|
s)
|
||||||
|
(symbol (str (.name *ns*)) (str s))))
|
||||||
|
|
||||||
|
(c/defn def
|
||||||
|
"Given a namespace-qualified keyword or resolvable symbol k, and a
|
||||||
|
spec, spec-name, predicate or regex-op makes an entry in the
|
||||||
|
registry mapping k to the spec. Use nil to remove an entry in
|
||||||
|
the registry for k."
|
||||||
|
[_ _ k spec-form]
|
||||||
|
(let [k (if (symbol? k) (ns-qualify k) k)]
|
||||||
|
`(clojure.spec.alpha/def-impl '~k '~(s/res spec-form) ~spec-form)))
|
||||||
|
|
||||||
|
;; TODO: fix error in clj-kondo: def is a special form which should always be resolved as the special form
|
||||||
|
#_:clj-kondo/ignore
|
||||||
|
(def spec-namespace
|
||||||
|
{'def (sci/copy-var s/def sns)
|
||||||
|
'def-impl (copy-var s/def-impl sns)
|
||||||
|
'valid? (copy-var s/valid? sns)
|
||||||
|
'gen (copy-var s/gen sns)
|
||||||
|
'cat (copy-var s/cat sns)
|
||||||
|
'cat-impl (copy-var s/cat-impl sns)
|
||||||
|
'fdef (copy-var s/fdef sns)
|
||||||
|
'fspec (copy-var s/fspec sns)
|
||||||
|
'fspec-impl (copy-var s/fspec-impl sns)
|
||||||
|
;; 372
|
||||||
|
'spec (copy-var s/spec sns)
|
||||||
|
'spec-impl (copy-var s/spec-impl sns)
|
||||||
|
#_#_'explain-data (copy-var s/explain-data sns)})
|
||||||
|
|
||||||
|
#_:clj-kondo/ignore
|
||||||
|
(def test-namespace
|
||||||
|
{'instrument (copy-var test/instrument tns)
|
||||||
|
'unstrument (copy-var test/unstrument tns)})
|
||||||
|
|
||||||
|
#_:clj-kondo/ignore
|
||||||
|
(def gen-namespace
|
||||||
|
{'generate (copy-var gen/generate gns)})
|
||||||
|
|
||||||
|
;; def-impl
|
||||||
|
;; -> spec? ;; OK
|
||||||
|
;; regex?
|
||||||
|
;; spec-impl
|
||||||
|
;; with-name
|
||||||
177
feature-test-check/babashka/impl/clojure/test/check.clj
Normal file
177
feature-test-check/babashka/impl/clojure/test/check.clj
Normal file
|
|
@ -0,0 +1,177 @@
|
||||||
|
(ns babashka.impl.clojure.test.check
|
||||||
|
{:no-doc true}
|
||||||
|
(:require [clojure.test.check.random :as random]
|
||||||
|
[sci.core :as sci]))
|
||||||
|
|
||||||
|
(def next-rng
|
||||||
|
"Returns a random-number generator. Successive calls should return
|
||||||
|
independent results."
|
||||||
|
(let [a (atom (delay (random/make-java-util-splittable-random (System/currentTimeMillis))))
|
||||||
|
thread-local
|
||||||
|
(proxy [ThreadLocal] []
|
||||||
|
(initialValue []
|
||||||
|
(first (random/split (swap! a #(second (random/split (force %))))))))]
|
||||||
|
(fn []
|
||||||
|
(let [rng (.get thread-local)
|
||||||
|
[rng1 rng2] (random/split rng)]
|
||||||
|
(.set thread-local rng2)
|
||||||
|
rng1))))
|
||||||
|
|
||||||
|
(defn make-random
|
||||||
|
"Given an optional Long seed, returns an object that satisfies the
|
||||||
|
IRandom protocol."
|
||||||
|
([] (next-rng))
|
||||||
|
([seed] (random/make-java-util-splittable-random seed)))
|
||||||
|
|
||||||
|
(alter-var-root #'random/next-rng (constantly next-rng))
|
||||||
|
(alter-var-root #'random/make-random (constantly make-random))
|
||||||
|
|
||||||
|
(def r-ns (sci/create-ns 'clojure.test.check.random nil))
|
||||||
|
|
||||||
|
#_(doseq [k (sort (keys (ns-publics 'clojure.test.check.random)))]
|
||||||
|
(println (str "'" k) (format "(sci/copy-var random/%s r-ns)" k)))
|
||||||
|
|
||||||
|
(def random-namespace
|
||||||
|
{'make-java-util-splittable-random (sci/copy-var random/make-java-util-splittable-random r-ns)
|
||||||
|
'make-random (sci/copy-var random/make-random r-ns)
|
||||||
|
'rand-double (sci/copy-var random/rand-double r-ns)
|
||||||
|
'rand-long (sci/copy-var random/rand-long r-ns)
|
||||||
|
'split (sci/copy-var random/split r-ns)
|
||||||
|
'split-n (sci/copy-var random/split-n r-ns)})
|
||||||
|
|
||||||
|
(require '[clojure.test.check.generators :as gen])
|
||||||
|
|
||||||
|
(def gen-ns (sci/create-ns 'clojure.test.check.generators nil))
|
||||||
|
|
||||||
|
#_(doseq [k (sort (keys (ns-publics 'clojure.test.check.generators)))]
|
||||||
|
(println (str "'" k) (format "(sci/copy-var gen/%s gen-ns)" k)))
|
||||||
|
|
||||||
|
(def generators-namespace
|
||||||
|
{'->Generator (sci/copy-var gen/->Generator gen-ns)
|
||||||
|
'any (sci/copy-var gen/any gen-ns)
|
||||||
|
'any-equatable (sci/copy-var gen/any-equatable gen-ns)
|
||||||
|
'any-printable (sci/copy-var gen/any-printable gen-ns)
|
||||||
|
'any-printable-equatable (sci/copy-var gen/any-printable-equatable gen-ns)
|
||||||
|
'big-ratio (sci/copy-var gen/big-ratio gen-ns)
|
||||||
|
'bind (sci/copy-var gen/bind gen-ns)
|
||||||
|
'boolean (sci/copy-var gen/boolean gen-ns)
|
||||||
|
'byte (sci/copy-var gen/byte gen-ns)
|
||||||
|
'bytes (sci/copy-var gen/bytes gen-ns)
|
||||||
|
'call-gen (sci/copy-var gen/call-gen gen-ns)
|
||||||
|
'char (sci/copy-var gen/char gen-ns)
|
||||||
|
'char-alpha (sci/copy-var gen/char-alpha gen-ns)
|
||||||
|
'char-alpha-numeric (sci/copy-var gen/char-alpha-numeric gen-ns)
|
||||||
|
'char-alphanumeric (sci/copy-var gen/char-alphanumeric gen-ns)
|
||||||
|
'char-ascii (sci/copy-var gen/char-ascii gen-ns)
|
||||||
|
'choose (sci/copy-var gen/choose gen-ns)
|
||||||
|
'container-type (sci/copy-var gen/container-type gen-ns)
|
||||||
|
'double (sci/copy-var gen/double gen-ns)
|
||||||
|
'double* (sci/copy-var gen/double* gen-ns)
|
||||||
|
'elements (sci/copy-var gen/elements gen-ns)
|
||||||
|
'fmap (sci/copy-var gen/fmap gen-ns)
|
||||||
|
'frequency (sci/copy-var gen/frequency gen-ns)
|
||||||
|
'gen-bind (sci/copy-var gen/gen-bind gen-ns)
|
||||||
|
'gen-fmap (sci/copy-var gen/gen-fmap gen-ns)
|
||||||
|
'gen-pure (sci/copy-var gen/gen-pure gen-ns)
|
||||||
|
'generate (sci/copy-var gen/generate gen-ns)
|
||||||
|
'generator? (sci/copy-var gen/generator? gen-ns)
|
||||||
|
'hash-map (sci/copy-var gen/hash-map gen-ns)
|
||||||
|
'int (sci/copy-var gen/int gen-ns)
|
||||||
|
'keyword (sci/copy-var gen/keyword gen-ns)
|
||||||
|
'keyword-ns (sci/copy-var gen/keyword-ns gen-ns)
|
||||||
|
'large-integer (sci/copy-var gen/large-integer gen-ns)
|
||||||
|
'large-integer* (sci/copy-var gen/large-integer* gen-ns)
|
||||||
|
'lazy-random-states (sci/copy-var gen/lazy-random-states gen-ns)
|
||||||
|
'let (sci/copy-var gen/let gen-ns)
|
||||||
|
'list (sci/copy-var gen/list gen-ns)
|
||||||
|
'list-distinct (sci/copy-var gen/list-distinct gen-ns)
|
||||||
|
'list-distinct-by (sci/copy-var gen/list-distinct-by gen-ns)
|
||||||
|
'make-size-range-seq (sci/copy-var gen/make-size-range-seq gen-ns)
|
||||||
|
'map (sci/copy-var gen/map gen-ns)
|
||||||
|
'map->Generator (sci/copy-var gen/map->Generator gen-ns)
|
||||||
|
'nat (sci/copy-var gen/nat gen-ns)
|
||||||
|
'neg-int (sci/copy-var gen/neg-int gen-ns)
|
||||||
|
'no-shrink (sci/copy-var gen/no-shrink gen-ns)
|
||||||
|
'not-empty (sci/copy-var gen/not-empty gen-ns)
|
||||||
|
'one-of (sci/copy-var gen/one-of gen-ns)
|
||||||
|
'pos-int (sci/copy-var gen/pos-int gen-ns)
|
||||||
|
'ratio (sci/copy-var gen/ratio gen-ns)
|
||||||
|
'recursive-gen (sci/copy-var gen/recursive-gen gen-ns)
|
||||||
|
'resize (sci/copy-var gen/resize gen-ns)
|
||||||
|
'return (sci/copy-var gen/return gen-ns)
|
||||||
|
's-neg-int (sci/copy-var gen/s-neg-int gen-ns)
|
||||||
|
's-pos-int (sci/copy-var gen/s-pos-int gen-ns)
|
||||||
|
'sample (sci/copy-var gen/sample gen-ns)
|
||||||
|
'sample-seq (sci/copy-var gen/sample-seq gen-ns)
|
||||||
|
'scale (sci/copy-var gen/scale gen-ns)
|
||||||
|
'set (sci/copy-var gen/set gen-ns)
|
||||||
|
'shrink-2 (sci/copy-var gen/shrink-2 gen-ns)
|
||||||
|
'shuffle (sci/copy-var gen/shuffle gen-ns)
|
||||||
|
'simple-type (sci/copy-var gen/simple-type gen-ns)
|
||||||
|
'simple-type-equatable (sci/copy-var gen/simple-type-equatable gen-ns)
|
||||||
|
'simple-type-printable (sci/copy-var gen/simple-type-printable gen-ns)
|
||||||
|
'simple-type-printable-equatable (sci/copy-var gen/simple-type-printable-equatable gen-ns)
|
||||||
|
'size-bounded-bigint (sci/copy-var gen/size-bounded-bigint gen-ns)
|
||||||
|
'sized (sci/copy-var gen/sized gen-ns)
|
||||||
|
'small-integer (sci/copy-var gen/small-integer gen-ns)
|
||||||
|
'sorted-set (sci/copy-var gen/sorted-set gen-ns)
|
||||||
|
'string (sci/copy-var gen/string gen-ns)
|
||||||
|
'string-alpha-numeric (sci/copy-var gen/string-alpha-numeric gen-ns)
|
||||||
|
'string-alphanumeric (sci/copy-var gen/string-alphanumeric gen-ns)
|
||||||
|
'string-ascii (sci/copy-var gen/string-ascii gen-ns)
|
||||||
|
'such-that (sci/copy-var gen/such-that gen-ns)
|
||||||
|
'symbol (sci/copy-var gen/symbol gen-ns)
|
||||||
|
'symbol-ns (sci/copy-var gen/symbol-ns gen-ns)
|
||||||
|
'tuple (sci/copy-var gen/tuple gen-ns)
|
||||||
|
'uuid (sci/copy-var gen/uuid gen-ns)
|
||||||
|
'vector (sci/copy-var gen/vector gen-ns)
|
||||||
|
'vector-distinct (sci/copy-var gen/vector-distinct gen-ns)
|
||||||
|
'vector-distinct-by (sci/copy-var gen/vector-distinct-by gen-ns)})
|
||||||
|
|
||||||
|
(require '[clojure.test.check.rose-tree :as rose-tree])
|
||||||
|
|
||||||
|
(def rose-ns (sci/create-ns 'clojure.test.check.rose-tree nil))
|
||||||
|
|
||||||
|
#_(doseq [k (sort (keys (ns-publics 'clojure.test.check.rose-tree)))]
|
||||||
|
(println (str "'" k) (format "(sci/copy-var rose-tree/%s rose-ns)" k)))
|
||||||
|
|
||||||
|
(def rose-tree-namespace
|
||||||
|
{'->RoseTree (sci/copy-var rose-tree/->RoseTree rose-ns)
|
||||||
|
'bind (sci/copy-var rose-tree/bind rose-ns)
|
||||||
|
'children (sci/copy-var rose-tree/children rose-ns)
|
||||||
|
'collapse (sci/copy-var rose-tree/collapse rose-ns)
|
||||||
|
'filter (sci/copy-var rose-tree/filter rose-ns)
|
||||||
|
'fmap (sci/copy-var rose-tree/fmap rose-ns)
|
||||||
|
'join (sci/copy-var rose-tree/join rose-ns)
|
||||||
|
'make-rose (sci/copy-var rose-tree/make-rose rose-ns)
|
||||||
|
'permutations (sci/copy-var rose-tree/permutations rose-ns)
|
||||||
|
'pure (sci/copy-var rose-tree/pure rose-ns)
|
||||||
|
'remove (sci/copy-var rose-tree/remove rose-ns)
|
||||||
|
'root (sci/copy-var rose-tree/root rose-ns)
|
||||||
|
'seq (sci/copy-var rose-tree/seq rose-ns)
|
||||||
|
'shrink (sci/copy-var rose-tree/shrink rose-ns)
|
||||||
|
'shrink-vector (sci/copy-var rose-tree/shrink-vector rose-ns)
|
||||||
|
'zip (sci/copy-var rose-tree/zip rose-ns)})
|
||||||
|
|
||||||
|
(require '[clojure.test.check.properties :as properties])
|
||||||
|
|
||||||
|
(def p-ns (sci/create-ns 'clojure.test.check.properties nil))
|
||||||
|
|
||||||
|
#_(doseq [k (sort (keys (ns-publics 'clojure.test.check.properties)))]
|
||||||
|
(println (str "'" k) (format "(sci/copy-var properties/%s p-ns)" k)))
|
||||||
|
|
||||||
|
(def properties-namespace
|
||||||
|
{'->ErrorResult (sci/copy-var properties/->ErrorResult p-ns)
|
||||||
|
'for-all (sci/copy-var properties/for-all p-ns)
|
||||||
|
'for-all* (sci/copy-var properties/for-all* p-ns)
|
||||||
|
'map->ErrorResult (sci/copy-var properties/map->ErrorResult p-ns)})
|
||||||
|
|
||||||
|
(require '[clojure.test.check :as tc])
|
||||||
|
|
||||||
|
(def tc-ns (sci/create-ns 'clojure.test.check nil))
|
||||||
|
|
||||||
|
#_(doseq [k (sort (keys (ns-publics 'clojure.test.check)))]
|
||||||
|
(println (str "'" k) (format "(sci/copy-var tc/%s p-ns)" k)))
|
||||||
|
|
||||||
|
(def test-check-namespace
|
||||||
|
{'quick-check (sci/copy-var tc/quick-check p-ns)})
|
||||||
|
|
@ -21,6 +21,7 @@
|
||||||
[cheshire "5.10.0"]
|
[cheshire "5.10.0"]
|
||||||
[nrepl/bencode "1.1.0"]
|
[nrepl/bencode "1.1.0"]
|
||||||
[borkdude/sci.impl.reflector "0.0.1-java11"]
|
[borkdude/sci.impl.reflector "0.0.1-java11"]
|
||||||
|
[org.clojure/test.check "1.1.0"]
|
||||||
[org.clojure/math.combinatorics "0.1.6"]]
|
[org.clojure/math.combinatorics "0.1.6"]]
|
||||||
:profiles {:feature/xml {:source-paths ["feature-xml"]
|
:profiles {:feature/xml {:source-paths ["feature-xml"]
|
||||||
:dependencies [[org.clojure/data.xml "0.2.0-alpha6"]]}
|
:dependencies [[org.clojure/data.xml "0.2.0-alpha6"]]}
|
||||||
|
|
@ -50,6 +51,8 @@
|
||||||
:dependencies [[org.clojure/core.match "1.0.0"]]}
|
:dependencies [[org.clojure/core.match "1.0.0"]]}
|
||||||
:feature/hiccup {:source-paths ["feature-hiccup"]
|
:feature/hiccup {:source-paths ["feature-hiccup"]
|
||||||
:dependencies [[hiccup/hiccup "2.0.0-alpha2"]]}
|
:dependencies [[hiccup/hiccup "2.0.0-alpha2"]]}
|
||||||
|
:feature/test-check {:source-paths ["feature-test-check"]}
|
||||||
|
:feature/spec-alpha {:source-paths ["feature-spec-alpha"]}
|
||||||
:test [:feature/xml
|
:test [:feature/xml
|
||||||
:feature/lanterna
|
:feature/lanterna
|
||||||
:feature/yaml
|
:feature/yaml
|
||||||
|
|
@ -63,6 +66,8 @@
|
||||||
:feature/httpkit-server
|
:feature/httpkit-server
|
||||||
:feature/core-match
|
:feature/core-match
|
||||||
:feature/hiccup
|
:feature/hiccup
|
||||||
|
:feature/test-check
|
||||||
|
:feature/spec-alpha
|
||||||
{:dependencies [[clj-commons/conch "0.9.2"]
|
{:dependencies [[clj-commons/conch "0.9.2"]
|
||||||
[com.clojure-goes-fast/clj-async-profiler "0.4.1"]
|
[com.clojure-goes-fast/clj-async-profiler "0.4.1"]
|
||||||
[com.opentable.components/otj-pg-embedded "0.13.3"]]}]
|
[com.opentable.components/otj-pg-embedded "0.13.3"]]}]
|
||||||
|
|
|
||||||
|
|
@ -96,6 +96,8 @@ then
|
||||||
export BABASHKA_FEATURE_HTTPKIT_SERVER="${BABASHKA_FEATURE_HTTPKIT_SERVER:-false}"
|
export BABASHKA_FEATURE_HTTPKIT_SERVER="${BABASHKA_FEATURE_HTTPKIT_SERVER:-false}"
|
||||||
export BABASHKA_FEATURE_CORE_MATCH="${BABASHKA_FEATURE_CORE_MATCH:-false}"
|
export BABASHKA_FEATURE_CORE_MATCH="${BABASHKA_FEATURE_CORE_MATCH:-false}"
|
||||||
export BABASHKA_FEATURE_HICCUP="${BABASHKA_FEATURE_HICCUP:-false}"
|
export BABASHKA_FEATURE_HICCUP="${BABASHKA_FEATURE_HICCUP:-false}"
|
||||||
|
export BABASHKA_FEATURE_TEST_CHECK="${BABASHKA_FEATURE_TEST_CHECK:-false}"
|
||||||
|
export BABASHKA_FEATURE_SPEC_ALPHA="${BABASHKA_FEATURE_SPEC_ALPHA:-false}"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
"$GRAALVM_HOME/bin/native-image" "${args[@]}"
|
"$GRAALVM_HOME/bin/native-image" "${args[@]}"
|
||||||
|
|
|
||||||
|
|
@ -132,6 +132,20 @@ else
|
||||||
BABASHKA_LEIN_PROFILES+=",-feature/hiccup"
|
BABASHKA_LEIN_PROFILES+=",-feature/hiccup"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
if [ "$BABASHKA_FEATURE_TEST_CHECK" != "false" ]
|
||||||
|
then
|
||||||
|
BABASHKA_LEIN_PROFILES+=",+feature/test-check"
|
||||||
|
else
|
||||||
|
BABASHKA_LEIN_PROFILES+=",-feature/test-check"
|
||||||
|
fi
|
||||||
|
|
||||||
|
if [ "$BABASHKA_FEATURE_SPEC_ALPHA" = "true" ]
|
||||||
|
then
|
||||||
|
BABASHKA_LEIN_PROFILES+=",+feature/spec-alpha"
|
||||||
|
else
|
||||||
|
BABASHKA_LEIN_PROFILES+=",-feature/spec-alpha"
|
||||||
|
fi
|
||||||
|
|
||||||
if [ -z "$BABASHKA_JAR" ]; then
|
if [ -z "$BABASHKA_JAR" ]; then
|
||||||
lein with-profiles "$BABASHKA_LEIN_PROFILES,+reflection,-uberjar" do run
|
lein with-profiles "$BABASHKA_LEIN_PROFILES,+reflection,-uberjar" do run
|
||||||
lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar
|
lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar
|
||||||
|
|
|
||||||
|
|
@ -100,6 +100,18 @@ set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/hiccup
|
||||||
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/hiccup
|
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/hiccup
|
||||||
)
|
)
|
||||||
|
|
||||||
|
if not "%BABASHKA_FEATURE_TEST_CHECK%"=="false" (
|
||||||
|
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/test-check
|
||||||
|
) else (
|
||||||
|
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/test-check
|
||||||
|
)
|
||||||
|
|
||||||
|
if "%BABASHKA_FEATURE_SPEC_ALPHA%"=="true" (
|
||||||
|
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/spec-alpha
|
||||||
|
) else (
|
||||||
|
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/spec-alpha
|
||||||
|
)
|
||||||
|
|
||||||
call lein with-profiles %BABASHKA_LEIN_PROFILES% bb "(+ 1 2 3)"
|
call lein with-profiles %BABASHKA_LEIN_PROFILES% bb "(+ 1 2 3)"
|
||||||
|
|
||||||
call lein with-profiles %BABASHKA_LEIN_PROFILES%,+reflection,-uberjar do run
|
call lein with-profiles %BABASHKA_LEIN_PROFILES%,+reflection,-uberjar do run
|
||||||
|
|
|
||||||
2001
src/babashka/impl/clojure/spec/alpha.clj
Normal file
2001
src/babashka/impl/clojure/spec/alpha.clj
Normal file
File diff suppressed because it is too large
Load diff
208
src/babashka/impl/clojure/spec/gen/alpha.clj
Executable file
208
src/babashka/impl/clojure/spec/gen/alpha.clj
Executable file
|
|
@ -0,0 +1,208 @@
|
||||||
|
; Copyright (c) Rich Hickey. All rights reserved.
|
||||||
|
; The use and distribution terms for this software are covered by the
|
||||||
|
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
||||||
|
; which can be found in the file epl-v10.html at the root of this distribution.
|
||||||
|
; By using this software in any fashion, you are agreeing to be bound by
|
||||||
|
; the terms of this license.
|
||||||
|
; You must not remove this notice, or any other, from this software.
|
||||||
|
|
||||||
|
(ns babashka.impl.clojure.spec.gen.alpha
|
||||||
|
(:refer-clojure :exclude [boolean bytes cat hash-map list map not-empty set vector
|
||||||
|
char double int keyword symbol string uuid delay shuffle])
|
||||||
|
(:require [clojure.test.check]
|
||||||
|
[clojure.test.check.generators]
|
||||||
|
[clojure.test.check.properties]))
|
||||||
|
|
||||||
|
(alias 'c 'clojure.core)
|
||||||
|
|
||||||
|
(def ^:private quick-check-ref (c/delay clojure.test.check/quick-check))
|
||||||
|
(defn quick-check
|
||||||
|
[& args]
|
||||||
|
(apply @quick-check-ref args))
|
||||||
|
|
||||||
|
(def ^:private for-all*-ref
|
||||||
|
(c/delay (clojure.test.check.properties/for-all*)))
|
||||||
|
(defn for-all*
|
||||||
|
"Dynamically loaded clojure.test.check.properties/for-all*."
|
||||||
|
[& args]
|
||||||
|
(apply @for-all*-ref args))
|
||||||
|
|
||||||
|
(let [g? clojure.test.check.generators/generator?
|
||||||
|
g clojure.test.check.generators/generate
|
||||||
|
mkg clojure.test.check.generators/->Generator]
|
||||||
|
(defn- generator?
|
||||||
|
[x]
|
||||||
|
(g? x))
|
||||||
|
(defn- generator
|
||||||
|
[gfn]
|
||||||
|
(mkg gfn))
|
||||||
|
(defn generate
|
||||||
|
"Generate a single value using generator."
|
||||||
|
[generator]
|
||||||
|
(g generator)))
|
||||||
|
|
||||||
|
(defn ^:skip-wiki delay-impl
|
||||||
|
[gfnd]
|
||||||
|
;;N.B. depends on test.check impl details
|
||||||
|
(generator (fn [rnd size]
|
||||||
|
((:gen @gfnd) rnd size))))
|
||||||
|
|
||||||
|
(defmacro delay
|
||||||
|
"given body that returns a generator, returns a
|
||||||
|
generator that delegates to that, but delays
|
||||||
|
creation until used."
|
||||||
|
[& body]
|
||||||
|
`(delay-impl (c/delay ~@body)))
|
||||||
|
|
||||||
|
(defmacro ^:skip-wiki lazy-combinator
|
||||||
|
"Implementation macro, do not call directly."
|
||||||
|
[s]
|
||||||
|
(let [fqn (c/symbol "clojure.test.check.generators" (name s))
|
||||||
|
doc (str "Lazy loaded version of " fqn)]
|
||||||
|
`(let [g# (c/delay ~fqn)]
|
||||||
|
(defn ~s
|
||||||
|
~doc
|
||||||
|
[& ~'args]
|
||||||
|
(apply @g# ~'args)))))
|
||||||
|
|
||||||
|
(defmacro ^:skip-wiki lazy-combinators
|
||||||
|
"Implementation macro, do not call directly."
|
||||||
|
[& syms]
|
||||||
|
`(do
|
||||||
|
~@(c/map
|
||||||
|
(fn [s] (c/list 'lazy-combinator s))
|
||||||
|
syms)))
|
||||||
|
|
||||||
|
(lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements
|
||||||
|
bind choose fmap one-of such-that tuple sample return
|
||||||
|
large-integer* double* frequency shuffle)
|
||||||
|
|
||||||
|
(defmacro ^:skip-wiki lazy-prim
|
||||||
|
"Implementation macro, do not call directly."
|
||||||
|
[s]
|
||||||
|
(let [fqn (c/symbol "clojure.test.check.generators" (name s))
|
||||||
|
doc (str "Fn returning " fqn)]
|
||||||
|
`(let [g# (c/delay ~fqn)]
|
||||||
|
(defn ~s
|
||||||
|
~doc
|
||||||
|
[& ~'args]
|
||||||
|
@g#))))
|
||||||
|
|
||||||
|
(defmacro ^:skip-wiki lazy-prims
|
||||||
|
"Implementation macro, do not call directly."
|
||||||
|
[& syms]
|
||||||
|
`(do
|
||||||
|
~@(c/map
|
||||||
|
(fn [s] (c/list 'lazy-prim s))
|
||||||
|
syms)))
|
||||||
|
|
||||||
|
(lazy-prims any any-printable boolean bytes char char-alpha char-alphanumeric char-ascii double
|
||||||
|
int keyword keyword-ns large-integer ratio simple-type simple-type-printable
|
||||||
|
string string-ascii string-alphanumeric symbol symbol-ns uuid)
|
||||||
|
|
||||||
|
(defn cat
|
||||||
|
"Returns a generator of a sequence catenated from results of
|
||||||
|
gens, each of which should generate something sequential."
|
||||||
|
[& gens]
|
||||||
|
(fmap #(apply concat %)
|
||||||
|
(apply tuple gens)))
|
||||||
|
|
||||||
|
(defn- qualified? [ident] (not (nil? (namespace ident))))
|
||||||
|
|
||||||
|
(def ^:private
|
||||||
|
gen-builtins
|
||||||
|
(c/delay
|
||||||
|
(let [simple (simple-type-printable)]
|
||||||
|
{any? (one-of [(return nil) (any-printable)])
|
||||||
|
some? (such-that some? (any-printable))
|
||||||
|
number? (one-of [(large-integer) (double)])
|
||||||
|
integer? (large-integer)
|
||||||
|
int? (large-integer)
|
||||||
|
pos-int? (large-integer* {:min 1})
|
||||||
|
neg-int? (large-integer* {:max -1})
|
||||||
|
nat-int? (large-integer* {:min 0})
|
||||||
|
float? (double)
|
||||||
|
double? (double)
|
||||||
|
boolean? (boolean)
|
||||||
|
string? (string-alphanumeric)
|
||||||
|
ident? (one-of [(keyword-ns) (symbol-ns)])
|
||||||
|
simple-ident? (one-of [(keyword) (symbol)])
|
||||||
|
qualified-ident? (such-that qualified? (one-of [(keyword-ns) (symbol-ns)]))
|
||||||
|
keyword? (keyword-ns)
|
||||||
|
simple-keyword? (keyword)
|
||||||
|
qualified-keyword? (such-that qualified? (keyword-ns))
|
||||||
|
symbol? (symbol-ns)
|
||||||
|
simple-symbol? (symbol)
|
||||||
|
qualified-symbol? (such-that qualified? (symbol-ns))
|
||||||
|
uuid? (uuid)
|
||||||
|
uri? (fmap #(java.net.URI/create (str "http://" % ".com")) (uuid))
|
||||||
|
decimal? (fmap #(BigDecimal/valueOf %)
|
||||||
|
(double* {:infinite? false :NaN? false}))
|
||||||
|
inst? (fmap #(java.util.Date. %)
|
||||||
|
(large-integer))
|
||||||
|
seqable? (one-of [(return nil)
|
||||||
|
(list simple)
|
||||||
|
(vector simple)
|
||||||
|
(map simple simple)
|
||||||
|
(set simple)
|
||||||
|
(string-alphanumeric)])
|
||||||
|
indexed? (vector simple)
|
||||||
|
map? (map simple simple)
|
||||||
|
vector? (vector simple)
|
||||||
|
list? (list simple)
|
||||||
|
seq? (list simple)
|
||||||
|
char? (char)
|
||||||
|
set? (set simple)
|
||||||
|
nil? (return nil)
|
||||||
|
false? (return false)
|
||||||
|
true? (return true)
|
||||||
|
zero? (return 0)
|
||||||
|
rational? (one-of [(large-integer) (ratio)])
|
||||||
|
coll? (one-of [(map simple simple)
|
||||||
|
(list simple)
|
||||||
|
(vector simple)
|
||||||
|
(set simple)])
|
||||||
|
empty? (elements [nil '() [] {} #{}])
|
||||||
|
associative? (one-of [(map simple simple) (vector simple)])
|
||||||
|
sequential? (one-of [(list simple) (vector simple)])
|
||||||
|
ratio? (such-that ratio? (ratio))
|
||||||
|
bytes? (bytes)})))
|
||||||
|
|
||||||
|
(defn gen-for-pred
|
||||||
|
"Given a predicate, returns a built-in generator if one exists."
|
||||||
|
[pred]
|
||||||
|
(if (set? pred)
|
||||||
|
(elements pred)
|
||||||
|
(get @gen-builtins pred)))
|
||||||
|
|
||||||
|
(comment
|
||||||
|
(require :reload 'clojure.spec.gen.alpha)
|
||||||
|
(in-ns 'clojure.spec.gen.alpha)
|
||||||
|
|
||||||
|
;; combinators, see call to lazy-combinators above for complete list
|
||||||
|
(generate (one-of [(gen-for-pred integer?) (gen-for-pred string?)]))
|
||||||
|
(generate (such-that #(< 10000 %) (gen-for-pred integer?)))
|
||||||
|
(let [reqs {:a (gen-for-pred number?)
|
||||||
|
:b (gen-for-pred ratio?)}
|
||||||
|
opts {:c (gen-for-pred string?)}]
|
||||||
|
(generate (bind (choose 0 (count opts))
|
||||||
|
#(let [args (concat (seq reqs) (c/shuffle (seq opts)))]
|
||||||
|
(->> args
|
||||||
|
(take (+ % (count reqs)))
|
||||||
|
(mapcat identity)
|
||||||
|
(apply hash-map))))))
|
||||||
|
(generate (cat (list (gen-for-pred string?))
|
||||||
|
(list (gen-for-pred ratio?))))
|
||||||
|
|
||||||
|
;; load your own generator
|
||||||
|
(gen-for-name 'clojure.test.check.generators/int)
|
||||||
|
|
||||||
|
;; failure modes
|
||||||
|
(gen-for-name 'unqualified)
|
||||||
|
(gen-for-name 'clojure.core/+)
|
||||||
|
(gen-for-name 'clojure.core/name-does-not-exist)
|
||||||
|
(gen-for-name 'ns.does.not.exist/f)
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
471
src/babashka/impl/clojure/spec/test/alpha.clj
Normal file
471
src/babashka/impl/clojure/spec/test/alpha.clj
Normal file
|
|
@ -0,0 +1,471 @@
|
||||||
|
;; Copyright (c) Rich Hickey. All rights reserved.
|
||||||
|
;; The use and distribution terms for this software are covered by the
|
||||||
|
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
||||||
|
;; which can be found in the file epl-v10.html at the root of this distribution.
|
||||||
|
;; By using this software in any fashion, you are agreeing to be bound by
|
||||||
|
;; the terms of this license.
|
||||||
|
;; You must not remove this notice, or any other, from this software.
|
||||||
|
|
||||||
|
(ns babashka.impl.clojure.spec.test.alpha
|
||||||
|
(:refer-clojure :exclude [test])
|
||||||
|
(:require
|
||||||
|
[babashka.impl.clojure.spec.alpha :as s]
|
||||||
|
[babashka.impl.clojure.spec.gen.alpha :as gen]
|
||||||
|
[babashka.impl.pprint :as pp]
|
||||||
|
[clojure.string :as str]))
|
||||||
|
|
||||||
|
(in-ns 'clojure.spec.test.check)
|
||||||
|
(in-ns 'babashka.impl.clojure.spec.test.alpha)
|
||||||
|
(alias 'stc 'clojure.spec.test.check)
|
||||||
|
|
||||||
|
(defn- throwable?
|
||||||
|
[x]
|
||||||
|
(instance? Throwable x))
|
||||||
|
|
||||||
|
(defn ->sym
|
||||||
|
[x]
|
||||||
|
(@#'s/->sym x))
|
||||||
|
|
||||||
|
#_(defn- ->var
|
||||||
|
[s-or-v]
|
||||||
|
(if (var? s-or-v)
|
||||||
|
s-or-v
|
||||||
|
(let [v (and (symbol? s-or-v) (resolve s-or-v))]
|
||||||
|
(if (var? v)
|
||||||
|
v
|
||||||
|
(throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
|
||||||
|
|
||||||
|
(defn- collectionize
|
||||||
|
[x]
|
||||||
|
(if (symbol? x)
|
||||||
|
(list x)
|
||||||
|
x))
|
||||||
|
|
||||||
|
(defn enumerate-namespace
|
||||||
|
"Given a symbol naming an ns, or a collection of such symbols,
|
||||||
|
returns the set of all symbols naming vars in those nses."
|
||||||
|
[ns-sym-or-syms]
|
||||||
|
(into
|
||||||
|
#{}
|
||||||
|
(mapcat (fn [ns-sym]
|
||||||
|
(map
|
||||||
|
(fn [name-sym]
|
||||||
|
(symbol (name ns-sym) (name name-sym)))
|
||||||
|
(keys (ns-interns ns-sym)))))
|
||||||
|
(collectionize ns-sym-or-syms)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(def ^:private ^:dynamic *instrument-enabled*
|
||||||
|
"if false, instrumented fns call straight through"
|
||||||
|
true)
|
||||||
|
|
||||||
|
#_(defn- fn-spec?
|
||||||
|
"Fn-spec must include at least :args or :ret specs."
|
||||||
|
[m]
|
||||||
|
(or (:args m) (:ret m)))
|
||||||
|
|
||||||
|
(defmacro with-instrument-disabled
|
||||||
|
"Disables instrument's checking of calls, within a scope."
|
||||||
|
[& body]
|
||||||
|
`(binding [*instrument-enabled* nil]
|
||||||
|
~@body))
|
||||||
|
|
||||||
|
(defn- interpret-stack-trace-element
|
||||||
|
"Given the vector-of-syms form of a stacktrace element produced
|
||||||
|
by e.g. Throwable->map, returns a map form that adds some keys
|
||||||
|
guessing the original Clojure names. Returns a map with
|
||||||
|
|
||||||
|
:class class name symbol from stack trace
|
||||||
|
:method method symbol from stack trace
|
||||||
|
:file filename from stack trace
|
||||||
|
:line line number from stack trace
|
||||||
|
:var-scope optional Clojure var symbol scoping fn def
|
||||||
|
:local-fn optional local Clojure symbol scoping fn def
|
||||||
|
|
||||||
|
For non-Clojure fns, :scope and :local-fn will be absent."
|
||||||
|
[[cls method file line]]
|
||||||
|
(let [clojure? (contains? '#{invoke invokeStatic} method)
|
||||||
|
demunge #(clojure.lang.Compiler/demunge %)
|
||||||
|
degensym #(str/replace % #"--.*" "")
|
||||||
|
[ns-sym name-sym local] (when clojure?
|
||||||
|
(->> (str/split (str cls) #"\$" 3)
|
||||||
|
(map demunge)))]
|
||||||
|
(merge {:file file
|
||||||
|
:line line
|
||||||
|
:method method
|
||||||
|
:class cls}
|
||||||
|
(when (and ns-sym name-sym)
|
||||||
|
{:var-scope (symbol ns-sym name-sym)})
|
||||||
|
(when local
|
||||||
|
{:local-fn (symbol (degensym local))}))))
|
||||||
|
|
||||||
|
(defn- stacktrace-relevant-to-instrument
|
||||||
|
"Takes a coll of stack trace elements (as returned by
|
||||||
|
StackTraceElement->vec) and returns a coll of maps as per
|
||||||
|
interpret-stack-trace-element that are relevant to a
|
||||||
|
failure in instrument."
|
||||||
|
[elems]
|
||||||
|
(let [plumbing? (fn [{:keys [var-scope]}]
|
||||||
|
(contains? '#{clojure.spec.test.alpha/spec-checking-fn} var-scope))]
|
||||||
|
(sequence (comp (map StackTraceElement->vec)
|
||||||
|
(map interpret-stack-trace-element)
|
||||||
|
(filter :var-scope)
|
||||||
|
(drop-while plumbing?))
|
||||||
|
elems)))
|
||||||
|
|
||||||
|
(defn- spec-checking-fn
|
||||||
|
[v f fn-spec]
|
||||||
|
(let [fn-spec (@#'s/maybe-spec fn-spec)
|
||||||
|
conform! (fn [v role spec data args]
|
||||||
|
(let [conformed (s/conform spec data)]
|
||||||
|
(if (= ::s/invalid conformed)
|
||||||
|
(let [caller (->> (.getStackTrace (Thread/currentThread))
|
||||||
|
stacktrace-relevant-to-instrument
|
||||||
|
first)
|
||||||
|
ed (merge (assoc (s/explain-data* spec [] [] [] data)
|
||||||
|
::s/fn (->sym v)
|
||||||
|
::s/args args
|
||||||
|
::s/failure :instrument)
|
||||||
|
(when caller
|
||||||
|
{::caller (dissoc caller :class :method)}))]
|
||||||
|
(throw (ex-info
|
||||||
|
(str "Call to " v " did not conform to spec.")
|
||||||
|
ed)))
|
||||||
|
conformed)))]
|
||||||
|
(fn
|
||||||
|
[& args]
|
||||||
|
(if *instrument-enabled*
|
||||||
|
(with-instrument-disabled
|
||||||
|
(when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
|
||||||
|
(binding [*instrument-enabled* true]
|
||||||
|
(.applyTo ^clojure.lang.IFn f args)))
|
||||||
|
(.applyTo ^clojure.lang.IFn f args)))))
|
||||||
|
|
||||||
|
(defn- no-fspec
|
||||||
|
[v spec]
|
||||||
|
(ex-info (str "Fn at " v " is not spec'ed.")
|
||||||
|
{:var v :spec spec ::s/failure :no-fspec}))
|
||||||
|
|
||||||
|
(defonce ^:private instrumented-vars (atom {}))
|
||||||
|
|
||||||
|
(defn- instrument-choose-fn
|
||||||
|
"Helper for instrument."
|
||||||
|
[f spec sym {over :gen :keys [stub replace]}]
|
||||||
|
(if (some #{sym} stub)
|
||||||
|
(-> spec (s/gen over) gen/generate)
|
||||||
|
(get replace sym f)))
|
||||||
|
|
||||||
|
(defn- instrument-choose-spec
|
||||||
|
"Helper for instrument"
|
||||||
|
[spec sym {overrides :spec}]
|
||||||
|
(get overrides sym spec))
|
||||||
|
|
||||||
|
(defn- instrument-1
|
||||||
|
[s opts]
|
||||||
|
;; TODO: sci resolve
|
||||||
|
(when-let [v nil #_(resolve s)]
|
||||||
|
(when-not (-> v meta :macro)
|
||||||
|
(let [spec (s/get-spec v)
|
||||||
|
{:keys [raw wrapped]} (get @instrumented-vars v)
|
||||||
|
current @v
|
||||||
|
to-wrap (if (= wrapped current) raw current)
|
||||||
|
ospec (or (instrument-choose-spec spec s opts)
|
||||||
|
(throw (no-fspec v spec)))
|
||||||
|
ofn (instrument-choose-fn to-wrap ospec s opts)
|
||||||
|
checked (spec-checking-fn v ofn ospec)]
|
||||||
|
;; TODO: use sci alter-var-root
|
||||||
|
(alter-var-root v (constantly checked))
|
||||||
|
(swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})
|
||||||
|
(->sym v)))))
|
||||||
|
|
||||||
|
(defn- unstrument-1
|
||||||
|
[s]
|
||||||
|
(when-let [v nil #_(resolve s)]
|
||||||
|
(when-let [{:keys [raw wrapped]} (get @instrumented-vars v)]
|
||||||
|
(swap! instrumented-vars dissoc v)
|
||||||
|
(let [current @v]
|
||||||
|
(when (= wrapped current)
|
||||||
|
;; TODO: use sci-alter-var-root
|
||||||
|
(alter-var-root v (constantly raw))
|
||||||
|
(->sym v))))))
|
||||||
|
|
||||||
|
#_(defn- opt-syms
|
||||||
|
"Returns set of symbols referenced by 'instrument' opts map"
|
||||||
|
[opts]
|
||||||
|
(reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
|
||||||
|
|
||||||
|
(defn- fn-spec-name?
|
||||||
|
[s]
|
||||||
|
(and (symbol? s)
|
||||||
|
;; TODO: sci resolve
|
||||||
|
#_(not (some-> (resolve s) meta :macro))))
|
||||||
|
|
||||||
|
(defn instrumentable-syms
|
||||||
|
"Given an opts map as per instrument, returns the set of syms
|
||||||
|
that can be instrumented."
|
||||||
|
([] (instrumentable-syms nil))
|
||||||
|
([opts]
|
||||||
|
(assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
|
||||||
|
(reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
|
||||||
|
(keys (:spec opts))
|
||||||
|
(:stub opts)
|
||||||
|
(keys (:replace opts))])))
|
||||||
|
|
||||||
|
(defn instrument
|
||||||
|
"Instruments the vars named by sym-or-syms, a symbol or collection
|
||||||
|
of symbols, or all instrumentable vars if sym-or-syms is not
|
||||||
|
specified.
|
||||||
|
|
||||||
|
If a var has an :args fn-spec, sets the var's root binding to a
|
||||||
|
fn that checks arg conformance (throwing an exception on failure)
|
||||||
|
before delegating to the original fn.
|
||||||
|
|
||||||
|
The opts map can be used to override registered specs, and/or to
|
||||||
|
replace fn implementations entirely. Opts for symbols not included
|
||||||
|
in sym-or-syms are ignored. This facilitates sharing a common
|
||||||
|
options map across many different calls to instrument.
|
||||||
|
|
||||||
|
The opts map may have the following keys:
|
||||||
|
|
||||||
|
:spec a map from var-name symbols to override specs
|
||||||
|
:stub a set of var-name symbols to be replaced by stubs
|
||||||
|
:gen a map from spec names to generator overrides
|
||||||
|
:replace a map from var-name symbols to replacement fns
|
||||||
|
|
||||||
|
:spec overrides registered fn-specs with specs your provide. Use
|
||||||
|
:spec overrides to provide specs for libraries that do not have
|
||||||
|
them, or to constrain your own use of a fn to a subset of its
|
||||||
|
spec'ed contract.
|
||||||
|
|
||||||
|
:stub replaces a fn with a stub that checks :args, then uses the
|
||||||
|
:ret spec to generate a return value.
|
||||||
|
|
||||||
|
:gen overrides are used only for :stub generation.
|
||||||
|
|
||||||
|
:replace replaces a fn with a fn that checks args conformance, then
|
||||||
|
invokes the fn you provide, enabling arbitrary stubbing and mocking.
|
||||||
|
|
||||||
|
:spec can be used in combination with :stub or :replace.
|
||||||
|
|
||||||
|
Returns a collection of syms naming the vars instrumented."
|
||||||
|
([] (instrument (instrumentable-syms)))
|
||||||
|
([sym-or-syms] (instrument sym-or-syms nil))
|
||||||
|
([sym-or-syms opts]
|
||||||
|
(locking instrumented-vars
|
||||||
|
(into
|
||||||
|
[]
|
||||||
|
(comp (filter (instrumentable-syms opts))
|
||||||
|
(distinct)
|
||||||
|
(map #(instrument-1 % opts))
|
||||||
|
(remove nil?))
|
||||||
|
(collectionize sym-or-syms)))))
|
||||||
|
|
||||||
|
(defn unstrument
|
||||||
|
"Undoes instrument on the vars named by sym-or-syms, specified
|
||||||
|
as in instrument. With no args, unstruments all instrumented vars.
|
||||||
|
Returns a collection of syms naming the vars unstrumented."
|
||||||
|
([] (unstrument (map ->sym (keys @instrumented-vars))))
|
||||||
|
([sym-or-syms]
|
||||||
|
(locking instrumented-vars
|
||||||
|
(into
|
||||||
|
[]
|
||||||
|
(comp (filter symbol?)
|
||||||
|
(map unstrument-1)
|
||||||
|
(remove nil?))
|
||||||
|
(collectionize sym-or-syms)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defn- explain-check
|
||||||
|
[args spec v role]
|
||||||
|
(ex-info
|
||||||
|
"Specification-based check failed"
|
||||||
|
(when-not (s/valid? spec v nil)
|
||||||
|
(assoc (s/explain-data* spec [role] [] [] v)
|
||||||
|
::args args
|
||||||
|
::val v
|
||||||
|
::s/failure :check-failed))))
|
||||||
|
|
||||||
|
(defn- check-call
|
||||||
|
"Returns true if call passes specs, otherwise *returns* an exception
|
||||||
|
with explain-data + ::s/failure."
|
||||||
|
[f specs args]
|
||||||
|
(let [cargs (when (:args specs) (s/conform (:args specs) args))]
|
||||||
|
(if (= cargs ::s/invalid)
|
||||||
|
(explain-check args (:args specs) args :args)
|
||||||
|
(let [ret (apply f args)
|
||||||
|
cret (when (:ret specs) (s/conform (:ret specs) ret))]
|
||||||
|
(if (= cret ::s/invalid)
|
||||||
|
(explain-check args (:ret specs) ret :ret)
|
||||||
|
(if (and (:args specs) (:ret specs) (:fn specs))
|
||||||
|
(if (s/valid? (:fn specs) {:args cargs :ret cret})
|
||||||
|
true
|
||||||
|
(explain-check args (:fn specs) {:args cargs :ret cret} :fn))
|
||||||
|
true))))))
|
||||||
|
|
||||||
|
(defn- quick-check
|
||||||
|
[f specs {gen :gen opts ::stc/opts}]
|
||||||
|
(let [{:keys [num-tests] :or {num-tests 1000}} opts
|
||||||
|
g (try (s/gen (:args specs) gen) (catch Throwable t t))]
|
||||||
|
(if (throwable? g)
|
||||||
|
{:result g}
|
||||||
|
(let [prop (gen/for-all* [g] #(check-call f specs %))]
|
||||||
|
(apply gen/quick-check num-tests prop (mapcat identity opts))))))
|
||||||
|
|
||||||
|
(defn- make-check-result
|
||||||
|
"Builds spec result map."
|
||||||
|
[check-sym spec test-check-ret]
|
||||||
|
(merge {:spec spec
|
||||||
|
::stc/ret test-check-ret}
|
||||||
|
(when check-sym
|
||||||
|
{:sym check-sym})
|
||||||
|
(when-let [result (-> test-check-ret :result)]
|
||||||
|
(when-not (true? result) {:failure result}))
|
||||||
|
(when-let [shrunk (-> test-check-ret :shrunk)]
|
||||||
|
{:failure (:result shrunk)})))
|
||||||
|
|
||||||
|
(defn- check-1
|
||||||
|
[{:keys [s f v spec]} opts]
|
||||||
|
(let [re-inst? (and v (seq (unstrument s)) true)
|
||||||
|
f (or f (when v @v))
|
||||||
|
specd (s/spec spec)]
|
||||||
|
(try
|
||||||
|
(cond
|
||||||
|
(or (nil? f) (some-> v meta :macro))
|
||||||
|
{:failure (ex-info "No fn to spec" {::s/failure :no-fn})
|
||||||
|
:sym s :spec spec}
|
||||||
|
|
||||||
|
(:args specd)
|
||||||
|
(let [tcret (quick-check f specd opts)]
|
||||||
|
(make-check-result s spec tcret))
|
||||||
|
|
||||||
|
:default
|
||||||
|
{:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
|
||||||
|
:sym s :spec spec})
|
||||||
|
(finally
|
||||||
|
(when re-inst? (instrument s))))))
|
||||||
|
|
||||||
|
(defn- sym->check-map
|
||||||
|
[s]
|
||||||
|
;; TODO: resolve
|
||||||
|
(let [v nil #_(resolve s)]
|
||||||
|
{:s s
|
||||||
|
:v v
|
||||||
|
:spec (when v (s/get-spec v))}))
|
||||||
|
|
||||||
|
(defn- validate-check-opts
|
||||||
|
[opts]
|
||||||
|
(assert (every? ident? (keys (:gen opts))) "check :gen expects ident keys"))
|
||||||
|
|
||||||
|
(defn check-fn
|
||||||
|
"Runs generative tests for fn f using spec and opts. See
|
||||||
|
'check' for options and return."
|
||||||
|
([f spec] (check-fn f spec nil))
|
||||||
|
([f spec opts]
|
||||||
|
(validate-check-opts opts)
|
||||||
|
(check-1 {:f f :spec spec} opts)))
|
||||||
|
|
||||||
|
(defn checkable-syms
|
||||||
|
"Given an opts map as per check, returns the set of syms that
|
||||||
|
can be checked."
|
||||||
|
([] (checkable-syms nil))
|
||||||
|
([opts]
|
||||||
|
(validate-check-opts opts)
|
||||||
|
(reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
|
||||||
|
(keys (:spec opts))])))
|
||||||
|
|
||||||
|
(defn check
|
||||||
|
"Run generative tests for spec conformance on vars named by
|
||||||
|
sym-or-syms, a symbol or collection of symbols. If sym-or-syms
|
||||||
|
is not specified, check all checkable vars.
|
||||||
|
|
||||||
|
The opts map includes the following optional keys, where stc
|
||||||
|
aliases clojure.spec.test.check:
|
||||||
|
|
||||||
|
::stc/opts opts to flow through test.check/quick-check
|
||||||
|
:gen map from spec names to generator overrides
|
||||||
|
|
||||||
|
The ::stc/opts include :num-tests in addition to the keys
|
||||||
|
documented by test.check. Generator overrides are passed to
|
||||||
|
spec/gen when generating function args.
|
||||||
|
|
||||||
|
Returns a lazy sequence of check result maps with the following
|
||||||
|
keys
|
||||||
|
|
||||||
|
:spec the spec tested
|
||||||
|
:sym optional symbol naming the var tested
|
||||||
|
:failure optional test failure
|
||||||
|
::stc/ret optional value returned by test.check/quick-check
|
||||||
|
|
||||||
|
The value for :failure can be any exception. Exceptions thrown by
|
||||||
|
spec itself will have an ::s/failure value in ex-data:
|
||||||
|
|
||||||
|
:check-failed at least one checked return did not conform
|
||||||
|
:no-args-spec no :args spec provided
|
||||||
|
:no-fn no fn provided
|
||||||
|
:no-fspec no fspec provided
|
||||||
|
:no-gen unable to generate :args
|
||||||
|
:instrument invalid args detected by instrument
|
||||||
|
"
|
||||||
|
([] (check (checkable-syms)))
|
||||||
|
([sym-or-syms] (check sym-or-syms nil))
|
||||||
|
([sym-or-syms opts]
|
||||||
|
(->> (collectionize sym-or-syms)
|
||||||
|
(filter (checkable-syms opts))
|
||||||
|
(pmap
|
||||||
|
#(check-1 (sym->check-map %) opts)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting ;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defn- failure-type
|
||||||
|
[x]
|
||||||
|
(::s/failure (ex-data x)))
|
||||||
|
|
||||||
|
(defn- unwrap-failure
|
||||||
|
[x]
|
||||||
|
(if (failure-type x)
|
||||||
|
(ex-data x)
|
||||||
|
x))
|
||||||
|
|
||||||
|
(defn- result-type
|
||||||
|
"Returns the type of the check result. This can be any of the
|
||||||
|
::s/failure keywords documented in 'check', or:
|
||||||
|
|
||||||
|
:check-passed all checked fn returns conformed
|
||||||
|
:check-threw checked fn threw an exception"
|
||||||
|
[ret]
|
||||||
|
(let [failure (:failure ret)]
|
||||||
|
(cond
|
||||||
|
(nil? failure) :check-passed
|
||||||
|
(failure-type failure) (failure-type failure)
|
||||||
|
:default :check-threw)))
|
||||||
|
|
||||||
|
(defn abbrev-result
|
||||||
|
"Given a check result, returns an abbreviated version
|
||||||
|
suitable for summary use."
|
||||||
|
[x]
|
||||||
|
(if (:failure x)
|
||||||
|
(-> (dissoc x ::stc/ret)
|
||||||
|
(update :spec s/describe)
|
||||||
|
(update :failure unwrap-failure))
|
||||||
|
(dissoc x :spec ::stc/ret)))
|
||||||
|
|
||||||
|
(defn summarize-results
|
||||||
|
"Given a collection of check-results, e.g. from 'check', pretty
|
||||||
|
prints the summary-result (default abbrev-result) of each.
|
||||||
|
|
||||||
|
Returns a map with :total, the total number of results, plus a
|
||||||
|
key with a count for each different :type of result."
|
||||||
|
([check-results] (summarize-results check-results abbrev-result))
|
||||||
|
([check-results summary-result]
|
||||||
|
(reduce
|
||||||
|
(fn [summary result]
|
||||||
|
(pp/pprint (summary-result result))
|
||||||
|
(-> summary
|
||||||
|
(update :total inc)
|
||||||
|
(update (result-type result) (fnil inc 0))))
|
||||||
|
{:total 0}
|
||||||
|
check-results)))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -13,6 +13,7 @@
|
||||||
(def httpkit-server? (not= "false" (System/getenv "BABASHKA_FEATURE_HTTPKIT_SERVER")))
|
(def httpkit-server? (not= "false" (System/getenv "BABASHKA_FEATURE_HTTPKIT_SERVER")))
|
||||||
(def core-match? (not= "false" (System/getenv "BABASHKA_FEATURE_CORE_MATCH")))
|
(def core-match? (not= "false" (System/getenv "BABASHKA_FEATURE_CORE_MATCH")))
|
||||||
(def hiccup? (not= "false" (System/getenv "BABASHKA_FEATURE_HICCUP")))
|
(def hiccup? (not= "false" (System/getenv "BABASHKA_FEATURE_HICCUP")))
|
||||||
|
(def test-check? (not= "false" (System/getenv "BABASHKA_FEATURE_TEST_CHECK")))
|
||||||
|
|
||||||
;; excluded by default
|
;; excluded by default
|
||||||
(def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC")))
|
(def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC")))
|
||||||
|
|
@ -21,3 +22,47 @@
|
||||||
(def hsqldb? (= "true" (System/getenv "BABASHKA_FEATURE_HSQLDB")))
|
(def hsqldb? (= "true" (System/getenv "BABASHKA_FEATURE_HSQLDB")))
|
||||||
(def datascript? (= "true" (System/getenv "BABASHKA_FEATURE_DATASCRIPT")))
|
(def datascript? (= "true" (System/getenv "BABASHKA_FEATURE_DATASCRIPT")))
|
||||||
(def lanterna? (= "true" (System/getenv "BABASHKA_FEATURE_LANTERNA")))
|
(def lanterna? (= "true" (System/getenv "BABASHKA_FEATURE_LANTERNA")))
|
||||||
|
(def spec-alpha? (= "true" (System/getenv "BABASHKA_FEATURE_SPEC_ALPHA")))
|
||||||
|
|
||||||
|
(when xml?
|
||||||
|
(require '[babashka.impl.xml]))
|
||||||
|
|
||||||
|
(when yaml?
|
||||||
|
(require '[babashka.impl.yaml]
|
||||||
|
'[babashka.impl.ordered]))
|
||||||
|
|
||||||
|
(when jdbc?
|
||||||
|
(require '[babashka.impl.jdbc]))
|
||||||
|
|
||||||
|
(when core-async?
|
||||||
|
(require '[babashka.impl.async]))
|
||||||
|
|
||||||
|
(when csv?
|
||||||
|
(require '[babashka.impl.csv]))
|
||||||
|
|
||||||
|
(when transit?
|
||||||
|
(require '[babashka.impl.transit]))
|
||||||
|
|
||||||
|
(when datascript?
|
||||||
|
(require '[babashka.impl.datascript]))
|
||||||
|
|
||||||
|
(when httpkit-client?
|
||||||
|
(require '[babashka.impl.httpkit-client]))
|
||||||
|
|
||||||
|
(when httpkit-server?
|
||||||
|
(require '[babashka.impl.httpkit-server]))
|
||||||
|
|
||||||
|
(when lanterna?
|
||||||
|
(require '[babashka.impl.lanterna]))
|
||||||
|
|
||||||
|
(when core-match?
|
||||||
|
(require '[babashka.impl.match]))
|
||||||
|
|
||||||
|
(when hiccup?
|
||||||
|
(require '[babashka.impl.hiccup]))
|
||||||
|
|
||||||
|
(when test-check?
|
||||||
|
(require '[babashka.impl.clojure.test.check]))
|
||||||
|
|
||||||
|
(when spec-alpha?
|
||||||
|
(require '[babashka.impl.spec]))
|
||||||
|
|
|
||||||
|
|
@ -4,10 +4,11 @@
|
||||||
[sci.core :as sci]
|
[sci.core :as sci]
|
||||||
[sci.impl.vars :as vars]))
|
[sci.impl.vars :as vars]))
|
||||||
|
|
||||||
(alter-var-root #'pprint/write-option-table
|
(defonce patch-option-table
|
||||||
(fn [m]
|
(alter-var-root #'pprint/write-option-table
|
||||||
(zipmap (keys m)
|
(fn [m]
|
||||||
(map find-var (vals m)))))
|
(zipmap (keys m)
|
||||||
|
(map find-var (vals m))))))
|
||||||
|
|
||||||
(def new-table-ize
|
(def new-table-ize
|
||||||
(fn [t m]
|
(fn [t m]
|
||||||
|
|
|
||||||
|
|
@ -63,43 +63,6 @@
|
||||||
(def pipe-signal-received? (constantly false))
|
(def pipe-signal-received? (constantly false))
|
||||||
(def handle-sigint! (constantly nil))))
|
(def handle-sigint! (constantly nil))))
|
||||||
|
|
||||||
(when features/xml?
|
|
||||||
(require '[babashka.impl.xml]))
|
|
||||||
|
|
||||||
(when features/yaml?
|
|
||||||
(require '[babashka.impl.yaml]
|
|
||||||
'[babashka.impl.ordered]))
|
|
||||||
|
|
||||||
(when features/jdbc?
|
|
||||||
(require '[babashka.impl.jdbc]))
|
|
||||||
|
|
||||||
(when features/core-async?
|
|
||||||
(require '[babashka.impl.async]))
|
|
||||||
|
|
||||||
(when features/csv?
|
|
||||||
(require '[babashka.impl.csv]))
|
|
||||||
|
|
||||||
(when features/transit?
|
|
||||||
(require '[babashka.impl.transit]))
|
|
||||||
|
|
||||||
(when features/datascript?
|
|
||||||
(require '[babashka.impl.datascript]))
|
|
||||||
|
|
||||||
(when features/httpkit-client?
|
|
||||||
(require '[babashka.impl.httpkit-client]))
|
|
||||||
|
|
||||||
(when features/httpkit-server?
|
|
||||||
(require '[babashka.impl.httpkit-server]))
|
|
||||||
|
|
||||||
(when features/lanterna?
|
|
||||||
(require '[babashka.impl.lanterna]))
|
|
||||||
|
|
||||||
(when features/core-match?
|
|
||||||
(require '[babashka.impl.match]))
|
|
||||||
|
|
||||||
(when features/hiccup?
|
|
||||||
(require '[babashka.impl.hiccup]))
|
|
||||||
|
|
||||||
(sci/alter-var-root sci/in (constantly *in*))
|
(sci/alter-var-root sci/in (constantly *in*))
|
||||||
(sci/alter-var-root sci/out (constantly *out*))
|
(sci/alter-var-root sci/out (constantly *out*))
|
||||||
(sci/alter-var-root sci/err (constantly *err*))
|
(sci/alter-var-root sci/err (constantly *err*))
|
||||||
|
|
@ -307,7 +270,9 @@ Use -- to separate script command line args from bb command line args.
|
||||||
:feature/httpkit-client %s
|
:feature/httpkit-client %s
|
||||||
:feature/lanterna %s
|
:feature/lanterna %s
|
||||||
:feature/core-match %s
|
:feature/core-match %s
|
||||||
:feature/hiccup %s}")
|
:feature/hiccup %s
|
||||||
|
:feature/test-check %s
|
||||||
|
:feature/spec-alpha %s}")
|
||||||
version
|
version
|
||||||
features/core-async?
|
features/core-async?
|
||||||
features/csv?
|
features/csv?
|
||||||
|
|
@ -322,7 +287,9 @@ Use -- to separate script command line args from bb command line args.
|
||||||
features/httpkit-client?
|
features/httpkit-client?
|
||||||
features/lanterna?
|
features/lanterna?
|
||||||
features/core-match?
|
features/core-match?
|
||||||
features/hiccup?)))
|
features/hiccup?
|
||||||
|
features/test-check?
|
||||||
|
features/spec-alpha?)))
|
||||||
|
|
||||||
(defn read-file [file]
|
(defn read-file [file]
|
||||||
(let [f (io/file file)]
|
(let [f (io/file file)]
|
||||||
|
|
@ -413,8 +380,8 @@ Use -- to separate script command line args from bb command line args.
|
||||||
'clojure.java.browse browse-namespace
|
'clojure.java.browse browse-namespace
|
||||||
'clojure.datafy datafy-namespace
|
'clojure.datafy datafy-namespace
|
||||||
'clojure.core.protocols protocols-namespace
|
'clojure.core.protocols protocols-namespace
|
||||||
'clojure.core.server clojure-core-server
|
|
||||||
'babashka.process process-namespace
|
'babashka.process process-namespace
|
||||||
|
'clojure.core.server clojure-core-server
|
||||||
'babashka.deps deps-namespace}
|
'babashka.deps deps-namespace}
|
||||||
features/xml? (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace))
|
features/xml? (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace))
|
||||||
features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
|
features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
|
||||||
|
|
@ -436,7 +403,22 @@ Use -- to separate script command line args from bb command line args.
|
||||||
features/hiccup? (-> (assoc 'hiccup.core @(resolve 'babashka.impl.hiccup/hiccup-namespace))
|
features/hiccup? (-> (assoc 'hiccup.core @(resolve 'babashka.impl.hiccup/hiccup-namespace))
|
||||||
(assoc 'hiccup2.core @(resolve 'babashka.impl.hiccup/hiccup2-namespace))
|
(assoc 'hiccup2.core @(resolve 'babashka.impl.hiccup/hiccup2-namespace))
|
||||||
(assoc 'hiccup.util @(resolve 'babashka.impl.hiccup/hiccup-util-namespace))
|
(assoc 'hiccup.util @(resolve 'babashka.impl.hiccup/hiccup-util-namespace))
|
||||||
(assoc 'hiccup.compiler @(resolve 'babashka.impl.hiccup/hiccup-compiler-namespace)))))
|
(assoc 'hiccup.compiler @(resolve 'babashka.impl.hiccup/hiccup-compiler-namespace)))
|
||||||
|
;; ensure load before babashka.impl.clojure.spec.alpha for random patch!
|
||||||
|
features/test-check? (assoc 'clojure.test.check.random
|
||||||
|
@(resolve 'babashka.impl.clojure.test.check/random-namespace)
|
||||||
|
'clojure.test.check.generators
|
||||||
|
@(resolve 'babashka.impl.clojure.test.check/generators-namespace)
|
||||||
|
'clojure.test.check.rose-tree
|
||||||
|
@(resolve 'babashka.impl.clojure.test.check/rose-tree-namespace)
|
||||||
|
'clojure.test.check.properties
|
||||||
|
@(resolve 'babashka.impl.clojure.test.check/properties-namespace)
|
||||||
|
'clojure.test.check
|
||||||
|
@(resolve 'babashka.impl.clojure.test.check/test-check-namespace))
|
||||||
|
features/spec-alpha? (-> (assoc ;; spec
|
||||||
|
'clojure.spec.alpha @(resolve 'babashka.impl.spec/spec-namespace)
|
||||||
|
'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-namespace)
|
||||||
|
'clojure.spec.test.alpha @(resolve 'babashka.impl.spec/test-namespace)))))
|
||||||
|
|
||||||
(def imports
|
(def imports
|
||||||
'{ArithmeticException java.lang.ArithmeticException
|
'{ArithmeticException java.lang.ArithmeticException
|
||||||
|
|
|
||||||
|
|
@ -174,6 +174,8 @@
|
||||||
(test-namespaces 'hiccup.core-test)
|
(test-namespaces 'hiccup.core-test)
|
||||||
(test-namespaces 'hiccup2.core-test)
|
(test-namespaces 'hiccup2.core-test)
|
||||||
|
|
||||||
|
(test-namespaces 'test-check.smoke-test)
|
||||||
|
|
||||||
;;;; final exit code
|
;;;; final exit code
|
||||||
|
|
||||||
(let [{:keys [:test :fail :error] :as m} @status]
|
(let [{:keys [:test :fail :error] :as m} @status]
|
||||||
|
|
|
||||||
19
test-resources/lib_tests/test_check/smoke_test.clj
Normal file
19
test-resources/lib_tests/test_check/smoke_test.clj
Normal file
|
|
@ -0,0 +1,19 @@
|
||||||
|
(ns test-check.smoke-test)
|
||||||
|
|
||||||
|
(require '[clojure.test :as t]
|
||||||
|
'[clojure.test.check :as tc]
|
||||||
|
'[clojure.test.check.generators :as gen]
|
||||||
|
'[clojure.test.check.properties :as prop])
|
||||||
|
|
||||||
|
(def property
|
||||||
|
(prop/for-all [v (gen/vector gen/small-integer)]
|
||||||
|
(let [s (sort v)]
|
||||||
|
(and (= (count v) (count s))
|
||||||
|
(or (empty? s)
|
||||||
|
(apply <= s))))))
|
||||||
|
|
||||||
|
;; test our property
|
||||||
|
(t/deftest smoke-test
|
||||||
|
(t/is (= {:result true, :pass? true, :num-tests 100}
|
||||||
|
(select-keys (tc/quick-check 100 property)
|
||||||
|
[:result :pass? :num-tests]))))
|
||||||
Loading…
Reference in a new issue