diff --git a/deps.edn b/deps.edn index e29102b3..25faf037 100644 --- a/deps.edn +++ b/deps.edn @@ -104,7 +104,17 @@ table/table {:git/url "https://github.com/cldwalker/table", :sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7"} markdown-clj/markdown-clj {:mvn/version "1.10.8"} org.clojure/tools.namespace {:git/url "https://github.com/babashka/tools.namespace", :sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b"} - medley/medley {:mvn/version "1.3.0"}} + medley/medley {:mvn/version "1.3.0"} + io.github.cognitect-labs/test-runner {:git/tag "v0.5.0", :git/sha "b3fd0d2"} + borkdude/missing.test.assertions {:git/url "https://github.com/borkdude/missing.test.assertions", :sha "603cb01bee72fb17addacc53c34c85612684ad70"} + dev.nubank/docopt {:mvn/version "0.6.1-fix7"} + testdoc/testdoc {:mvn/version "1.4.1"} + org.clojars.lispyclouds/contajners {:mvn/version "0.0.4"} + borkdude/rewrite-edn {:mvn/version "0.1.0"} + clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"} + io.aviso/pretty {:mvn/version "1.1.1"} + progrock/progrock {:mvn/version "0.1.2"} + djblue/portal {:mvn/version "0.19.0"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/doc/dev.md b/doc/dev.md index c059a9a8..c3e2876d 100644 --- a/doc/dev.md +++ b/doc/dev.md @@ -85,15 +85,15 @@ Babashka runs tests of libraries that are compatible with it through and run them, use the script `add-libtest.clj` e.g. `script/add-libtest.clj '{listora/again {:mvn/version "1.0.0"}}' https://github.com/liwp/again --test`. -If the library you want to add doesn't work with the script, you can manually do the following: +If the library you want to add doesn't work automatically, you can manually do the following: * Add an entry for the library in `deps.edn` under the `:lib-tests` alias. * Create a directory for the library in `test-resources/lib_tests/` and copy its tests to there. -* Add an entry in `run_all_libtests.clj` to run the added test namespaces. +* Add a manual lib entry using `add-libtest.clj` e.g. `script/add-libtest.clj http-kit/http-kit -m '{:test-namespaces [httpkit.client-test]}'`. * Run the tests `script/lib_tests/run_all_libtests NS1 NS2` -Note: If you have to modify a test to have it work with bb, add an inline -comment with prefix "BB-TEST-PATCH:" explaining what you did. +Note: If you have to modify any test file or configuration to have it work with +bb, add an inline comment with prefix `BB-TEST-PATCH:` explaining what you did. ## Build diff --git a/doc/libraries.csv b/doc/libraries.csv index 18991fc7..2665caa7 100644 --- a/doc/libraries.csv +++ b/doc/libraries.csv @@ -4,11 +4,14 @@ amperity/vault-clj,https://github.com/amperity/vault-clj babashka/babashka.curl,https://github.com/babashka/babashka.curl better-cond/better-cond,https://github.com/Engelberg/better-cond borkdude/deps,https://github.com/borkdude/deps.clj +borkdude/missing.test.assertions,https://github.com/borkdude/missing.test.assertions +borkdude/rewrite-edn,https://github.com/borkdude/rewrite-edn camel-snake-kebab/camel-snake-kebab,https://github.com/clj-commons/camel-snake-kebab circleci/bond,https://github.com/circleci/bond clj-commons/clj-yaml,https://github.com/clj-commons/clj-yaml clj-commons/multigrep,https://github.com/clj-commons/multigrep clojure-csv/clojure-csv,https://github.com/davidsantiago/clojure-csv +clojure-term-colors/clojure-term-colors,https://github.com/trhura/clojure-term-colors com.github.seancorfield/honeysql,https://github.com/seancorfield/honeysql com.grammarly/omniconf,https://github.com/grammarly/omniconf com.stuartsierra/component,https://github.com/stuartsierra/component @@ -16,16 +19,24 @@ com.stuartsierra/dependency,https://github.com/stuartsierra/dependency comb/comb,https://github.com/weavejester/comb cprop/cprop,https://github.com/tolitius/cprop crispin/crispin,https://github.com/dunaj-project/crispin +dev.nubank/docopt,https://github.com/nubank/docopt.clj +djblue/portal,https://github.com/djblue/portal doric/doric,https://github.com/joegallo/doric +douglass/clj-psql,https://github.com/DarinDouglass/clj-psql environ/environ,https://github.com/weavejester/environ exoscale/coax,https://github.com/exoscale/coax +expound/expound,https://github.com/bhb/expound failjure/failjure,https://github.com/adambard/failjure +ffclj/ffclj,https://github.com/luissantos/ffclj gaka/gaka,https://github.com/cdaddr/gaka hato/hato,https://github.com/gnarroway/hato henryw374/cljc.java-time,https://github.com/henryw374/cljc.java-time hiccup/hiccup,http://github.com/weavejester/hiccup honeysql/honeysql,https://github.com/seancorfield/honeysql http-kit/http-kit,https://github.com/http-kit/http-kit +io.aviso/pretty,https://github.com/AvisoNovate/pretty +io.github.cognitect-labs/test-runner,https://github.com/cognitect-labs/test-runner +io.github.technomancy/limit-break,https://github.com/technomancy/limit-break io.helins/binf,https://github.com/helins/binf.cljc io.replikativ/hasch,https://github.com/replikativ/hasch java-http-clj/java-http-clj,http://www.github.com/schmee/java-http-clj @@ -40,6 +51,7 @@ org.babashka/spec.alpha,https://github.com/babashka/spec.alpha org.clj-commons/clj-http-lite,https://github.com/clj-commons/clj-http-lite org.clj-commons/digest,https://github.com/clj-commons/clj-digest org.clojars.askonomm/ruuter,https://github.com/askonomm/ruuter +org.clojars.lispyclouds/contajners,https://github.com/lispyclouds/contajners org.clojure/core.match,https://github.com/clojure/core.match org.clojure/data.csv,https://github.com/clojure/data.csv org.clojure/data.generators,https://github.com/clojure/data.generators @@ -49,10 +61,12 @@ org.clojure/math.combinatorics,https://github.com/clojure/math.combinatorics org.clojure/test.check,https://github.com/clojure/test.check org.clojure/tools.gitlibs,https://github.com/clojure/tools.gitlibs org.clojure/tools.namespace,https://github.com/babashka/tools.namespace +progrock/progrock,https://github.com/weavejester/progrock reifyhealth/specmonstah,https://github.com/reifyhealth/specmonstah rewrite-clj/rewrite-clj,https://github.com/clj-commons/rewrite-clj rm-hull/jasentaa,https://github.com/rm-hull/jasentaa selmer/selmer,https://github.com/yogthos/Selmer slingshot/slingshot,https://github.com/scgilardi/slingshot table/table,https://github.com/cldwalker/table +testdoc/testdoc,https://github.com/liquidz/testdoc version-clj/version-clj,https://github.com/xsc/version-clj diff --git a/doc/projects.md b/doc/projects.md index 2fc9b06e..b3cc625c 100644 --- a/doc/projects.md +++ b/doc/projects.md @@ -83,13 +83,14 @@ The following libraries and projects are known to work with babashka. - [Babashka + scittle guestbook](#babashka--scittle-guestbook) - [bb htmx todo app](#bb-htmx-todo-app) -For more supported libraries, see [this test -file](../test-resources/lib_tests/babashka/run_all_libtests.clj ). Also keep an eye -on the [news](news.md) page for new projects, gists and other developments -around babashka. +Also keep an eye on the [news](news.md) page for new projects, gists and other +developments around babashka. ## Libraries +For a full list of libraries, see [libraries.csv](./libraries.csv). To add a +library, see [these instructions](./dev.md#tests-for-libraries). + ### [tools.namespace](https://github.com/babashka/tools.namespace) A fork of `tools.namespace`. This is used by other libraries and enables them to @@ -111,12 +112,12 @@ instrumentation! Its readme also contains instructions on how to use A fork of `tools.build`. -### [clj-http-lite](https://github.com/babashka/clj-http-lite) +### [clj-http-lite](https://github.com/clj-commons/clj-http-lite) -A fork of a fork of `clj-http-lite`. Example: +Example: ``` shell -$ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {clj-http-lite {:git/url "https://github.com/babashka/clj-http-lite" :sha "f44ebe45446f0f44f2b73761d102af3da6d0a13e"}}}' -Spath)" +$ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"}}}' -Spath)" $ bb "(require '[clj-http.lite.client :as client]) (:status (client/get \"https://www.clojure.org\"))" 200 @@ -146,16 +147,10 @@ Ran 1 tests containing 0 assertions. ### [medley](https://github.com/weavejester/medley/) -Requires `bb` >= v0.0.71. Latest coordinates checked with with bb: - -``` clojure -{:git/url "https://github.com/weavejester/medley" :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} -``` - Example: ``` shell -$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {medley {:git/url "https://github.com/weavejester/medley" :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"}}}') +$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {medley/medley {:mvn/version "1.3.0"}}}') $ bb -e "(require '[medley.core :as m]) (m/index-by :id [{:id 1} {:id 2}])" {1 {:id 1}, 2 {:id 2}} @@ -202,16 +197,10 @@ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {clojure-csv {:mvn/version " ### [regal](https://github.com/lambdaisland/regal) -Requires `bb` >= v0.0.71. Latest coordinates checked with with bb: - -``` clojure -{:git/url "https://github.com/lambdaisland/regal" :sha "d4e25e186f7b9705ebb3df6b21c90714d278efb7"} -``` - Example: ``` shell -$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {regal {:git/url "https://github.com/lambdaisland/regal" :sha "d4e25e186f7b9705ebb3df6b21c90714d278efb7"}}}') +$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {lambdaisland/regal {:mvn/version "0.0.143"}}}') $ bb -e "(require '[lambdaisland.regal :as regal]) (regal/regex [:* \"ab\"])" #"(?:\Qab\E)*" diff --git a/script/add-libtest.clj b/script/add-libtest.clj index 1d71e780..98215340 100755 --- a/script/add-libtest.clj +++ b/script/add-libtest.clj @@ -1,6 +1,11 @@ #!/usr/bin/env bb -;; Adds a library to bb-tested-libs.edn to be tested given a library version and -;; git repository. Optionally takes a --test to then test the added library. +;; Adds a library to bb-tested-libs.edn and libraries.csv and optionally run its +;; tests. There are two modes to this script - automatic (default) and manual. +;; The script defaults to automatically copying tests as this normally works. +;; There are several options to specify where the library is including +;; --git-url, --dir and --test-directories. See --help for more. In manual mode, +;; tests are manually added outside of the script and the script is run to add +;; the library to library lists. (ns add-libtest (:require [babashka.deps :as deps] @@ -74,6 +79,7 @@ (gl/procure git-url lib-name branch) (or (gl/procure git-url lib-name "master") (gl/procure git-url lib-name "main"))) + _ (println "Git clone is at" lib-dir) lib-root-dir (if directory (fs/file lib-dir directory) lib-dir) test-dirs (if test-directories (map #(when (fs/exists? (fs/file lib-root-dir %)) @@ -123,6 +129,9 @@ namespaces)) (defn- fetch-artifact + "Using the clojars api to get a library's git url doesn't always work. A + possibly more reliable data source could be the scm urls in this POM feed - + https://github.com/clojars/clojars-web/wiki/Data#useful-extracts-from-the-poms" [artifact] (let [url (str "https://clojars.org/api/artifacts/" artifact) _ (println "GET" url "...") @@ -131,15 +140,6 @@ (-> resp :body slurp edn/read-string) (error (str "Response failed and returned " (pr-str resp)))))) -(defn- deps-to-lib-name-and-coordinate - [deps-string] - (let [deps-map (edn/read-string deps-string) - _ (when (not= 1 (count deps-map)) - (error "Deps map must have one key")) - lib-name (ffirst deps-map) - lib-coordinate (deps-map lib-name)] - [lib-name lib-coordinate])) - (defn- get-lib-map [deps-string options] ;; if deps-string is artifact name @@ -148,12 +148,13 @@ {:lib-name (symbol deps-string) :lib-coordinate {:mvn/version (:latest_version artifact-edn)} :git-url (or (:git-url options) (:homepage artifact-edn))}) - (let [deps-map (edn/read-string deps-string)] - (when (not= 1 (count deps-map)) - (error "Deps map must have one key")) + (let [deps-map (edn/read-string deps-string) + _ (when (or (not (map? deps-map)) (not= 1 (count deps-map))) + (error "Deps map must have one key")) + lib-coordinate (-> deps-map vals first)] {:lib-name (ffirst deps-map) - :lib-coordinate (-> deps-map vals first) - :git-url (:git-url options)}))) + :lib-coordinate lib-coordinate + :git-url (or (:git/url lib-coordinate) (:git-url options))}))) (defn- write-lib-to-csv "Updates libraries.csv with latest bb-tested-libs.edn" diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index 9717f243..a3a4ef1b 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -34,7 +34,7 @@ aero/aero {:git-sha "743e9bc495425b4a4a7c780f5e4b09f6680b4e7a", :git-url "http://github.com/juxt/aero", :test-namespaces (aero.core-test)} org.clojure/data.generators {:git-sha "bf65f99aa9dcabed7de7c09b74d71db208cf61ee", :git-url "https://github.com/clojure/data.generators", :test-namespaces (clojure.data.generators-test)} camel-snake-kebab/camel-snake-kebab {:git-sha "d072c7fd242ab0becd4bb265622ded415f2a4b68", :git-url "https://github.com/clj-commons/camel-snake-kebab", :test-namespaces (camel-snake-kebab.internals.string-separator-test camel-snake-kebab.extras-test camel-snake-kebab.core-test)} - ;; BB-TEST-PATCH: Removed cljs-test-opts.edn + ;; BB-TEST-PATCH: Deleted cljs-test-opts.edn henryw374/cljc.java-time {:git-sha "b9da12ea25e80a0e284a5bffd88ebcbf18fc3bf7", :git-url "https://github.com/henryw374/cljc.java-time", :test-namespaces (cljc.java-time-test)} org.babashka/spec.alpha {:git-sha "6c4aed643daaf55c6f898d4915275704db683aa2", :git-url "https://github.com/babashka/spec.alpha", :test-namespaces (clojure.test-clojure.instr clojure.test-clojure.spec)} ;; BB-TEST-PATCH: Don't have 4 tests namespaces because they depend on @@ -66,8 +66,31 @@ ;; TODO: failing tests in the following namespaces: vault.client.mock-test, vault.secrets.kvv1-test vault.secrets.kvv2-test amperity/vault-clj {:git-url "https://github.com/amperity/vault-clj", :test-namespaces [vault.lease-test vault.client.http-test], :manually-added true} orchestra/orchestra {:git-url "https://github.com/jeaye/orchestra", :test-namespaces (orchestra.make-fns orchestra.many-fns orchestra.expound-test orchestra.core-test orchestra.reload-test), :test-directories ("test/cljc" "test/clj"), :git-sha "81e5181f7b42e5e2763a2b37db17954f3be0314e"} - ;; BB-TEST-PATCH: Manually removed tasks.clj + ;; BB-TEST-PATCH: Deleted tasks.clj org.clj-commons/clj-http-lite {:git-url "https://github.com/clj-commons/clj-http-lite", :test-namespaces (clj-http.lite.test-runner clj-http.lite.client-test), :test-directories ("bb"), :git-sha "6b53000df55ac05c4ff8e5047a5323fc08a52e8b"} cprop/cprop {:git-url "https://github.com/tolitius/cprop", :test-namespaces [cprop.smoke-test], :manually-added true} org.clojure/data.zip {:git-url "https://github.com/clojure/data.zip", :test-namespaces [clojure.data.zip-test], :manually-added true} - borkdude/deps {:git-url "https://github.com/borkdude/deps.clj", :test-namespaces [borkdude.deps.smoke-test], :manually-added true}} + borkdude/deps {:git-url "https://github.com/borkdude/deps.clj", :test-namespaces [borkdude.deps.smoke-test], :manually-added true} + io.github.cognitect-labs/test-runner {:git-url "https://github.com/cognitect-labs/test-runner", :test-namespaces (cognitect.test-runner.samples-test cognitect.test-runner.sample-property-test cognitect.test-runner-test), :git-sha "cc75980b43011773162b485f46f939dc5fba91e4"} + borkdude/missing.test.assertions {:git-url "https://github.com/borkdude/missing.test.assertions", :test-namespaces (missing.test.assertions-test missing.test.old-methods), :git-sha "603cb01bee72fb17addacc53c34c85612684ad70"} + ;; No tests to run + io.github.technomancy/limit-break {:git-url "https://github.com/technomancy/limit-break", :test-namespaces [], :manually-added true} + dev.nubank/docopt {:git-url "https://github.com/nubank/docopt.clj", :test-namespaces (docopt.core-test), :git-sha "2794195a7288002e8d8a44f7bc37180c9cca8971"} + ;; BB-TEST-PATCH: Deleted unused resources/ + testdoc/testdoc {:git-url "https://github.com/liquidz/testdoc", :test-namespaces (testdoc.style.repl-test testdoc.style.code-first-test testdoc.core-test), :git-sha "6b995ef25f3cc6450a1ce30f72baed371476f6eb"} + org.clojars.lispyclouds/contajners {:git-url "https://github.com/lispyclouds/contajners", :test-namespaces (contajners.core-test contajners.impl-test), :git-sha "d163637ff36d79995516d6705da1e9afc7b44764"} + ;; Don't run tests b/c they depend on `psql` + douglass/clj-psql {:git-url "https://github.com/DarinDouglass/clj-psql", :test-namespaces [], :manually-added true} + ;; Don't run tests b/c they depend on `ffmpeg` + ffclj/ffclj {:git-url "https://github.com/luissantos/ffclj", :test-namespaces [], :manually-added true} + ;; BB-TEST-PATCH: Can't load deps for tests - expound.alpha-test, expound.spell-spec-test, expound.paths-test. Skip expound.printer-test as most tests fail + ;; BB-TEST-PATCH: Deleted cljs_test.cljs and *.txt + expound/expound {:git-url "https://github.com/bhb/expound", :test-namespaces (expound.specs-test expound.print-length-test expound.test-utils expound.spec-gen expound.problems-test), :git-sha "589a7f69323dc0423197b346c75808e48e771427"} + ;; BB-TEST-PATCH: Removed borkdude.rewrite-edn-test because it fails + borkdude/rewrite-edn {:git-url "https://github.com/borkdude/rewrite-edn", :test-namespaces [], :branch "63f09048a3ebbd48f86fa9626076e7e540cfb7ee", :git-sha "63f09048a3ebbd48f86fa9626076e7e540cfb7ee"} + clojure-term-colors/clojure-term-colors {:git-url "https://github.com/trhura/clojure-term-colors", :test-namespaces (clojure.term.colors-test), :git-sha "71620a5e121d51afe28c50c0aa14ceb4cbff7981"} + ;; BB-TEST-PATCH: Removed io.aviso.exception-test because it can't load ns with clojure.lang.Compiler. + ;; BB-TEST-PATCH: Deleted demo*.clj + io.aviso/pretty {:git-url "https://github.com/AvisoNovate/pretty", :test-namespaces (io.aviso.binary-test), :git-sha "155926f991f94addaf6f5c8621748924ab144988"} + progrock/progrock {:git-url "https://github.com/weavejester/progrock", :test-namespaces (progrock.core-test), :git-sha "9c277a3244c52bfde19c21add327d6e20b94fdf5"} + djblue/portal {:git-url "https://github.com/djblue/portal", :test-namespaces (portal.jvm-test portal.test-runner portal.runtime.cson-test portal.runtime.fs-test portal.e2e portal.bench), :git-sha "64e4624bcf3bee2dd47e3d8e47982c709738eb11"}} diff --git a/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc b/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc new file mode 100644 index 00000000..b5eb4074 --- /dev/null +++ b/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc @@ -0,0 +1,133 @@ +(ns borkdude.rewrite-edn-test + (:require [borkdude.rewrite-edn :as r] + [clojure.test :as t :refer [deftest testing is]])) + +(deftest assoc-test + (testing "Base case" + (is (= "{:a 1}" + (str (r/assoc + (r/parse-string "{}") + :a 1))))) + (testing "When there's only one existing, keys are added on a new line" + (is (= " +{:a 1 + :b 1}" + (str (r/assoc + (r/parse-string " +{:a 1}") + :b 1))))) + (testing "Unless there are already keys on the same line" + (is (= "{:a 1 :b 2 :c 3}" + (str (r/assoc + (r/parse-string "{:a 1 :b 2}") + :c 3))))) + (testing "when map is already multi-line, new keys are added on new line" + (is (= " +{:a 1 + :b 2} +;; this is a cool map" + (str (r/assoc + (r/parse-string " +{:a 1} +;; this is a cool map") + :b 2))))) + (testing "Updating existing val" + (is (= "{:a 2}" + (str (r/assoc + (r/parse-string "{:a 1}") + :a 2))))) + (testing "Something between key and val" + (is (= "{:a #_:something 2}" + (str (r/assoc + (r/parse-string "{:a #_:something 1}") + :a 2))))) + (testing "Comment at the end" + (is (= "{:a 2} ;; this is a cool map" + (str (r/assoc + (r/parse-string "{:a 1} ;; this is a cool map") + :a 2))))) + (testing "Vector index assoc" + (is (= "[9 8 99 7] ;; this is a cool vector" + (str (r/assoc + (r/parse-string "[9 8 3 7] ;; this is a cool vector") + 2 99))))) + (testing "Vector last index assoc" + (is (= "[9 8 3 99] ;; this is a cool vector" + (str (r/assoc + (r/parse-string "[9 8 3 7] ;; this is a cool vector") + 3 99))))) + (testing "Vector assoc out of bounds" + (is (try + (r/assoc (r/parse-string "[9 8 3 7] ;; this is a cool vector") 9 99) + false + (catch java.lang.IndexOutOfBoundsException _ true)))) + (testing "Vector assoc out of bounds with ignored" + (is (try + (r/assoc (r/parse-string "[9 8 3 #_99 #_213 7] ;; this is a cool vector") 4 99) + false + (catch java.lang.IndexOutOfBoundsException _ true))))) + +(deftest update-test + (is (= "{:a #_:foo 2}" + (str (r/update + (r/parse-string "{:a #_:foo 1}") + :a (fn [node] + (inc (r/sexpr node)))))))) + +(defn qualify-sym-node [sym-node] + (let [sym (r/sexpr sym-node)] + (if (or (not (symbol? sym)) + (qualified-symbol? sym)) + sym-node + (symbol (str sym) (str sym))))) + +(deftest map-keys-test + (is (= " +{foo/foo 1 + bar/bar 2}" + (str (r/map-keys qualify-sym-node + (r/parse-string " +{foo 1 + bar 2}")))))) + +(deftest update-deps-test + (is (= "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}" + (str (r/update (r/parse-string "{:deps {foo {:mvn/version \"0.1.0\"}}}") + :deps + (fn [deps-map-node] + (r/map-keys qualify-sym-node deps-map-node))))))) + +(deftest assoc-in-test + (is (= "{:a {:b {:c 2}}}" + (str (r/assoc-in (r/parse-string "{}") + [:a :b :c] 2)))) + (is (= "{:a {:b {:c 2}}}" + (str (r/assoc-in (r/parse-string "nil") + [:a :b :c] 2)))) + (is (= "{:deps {foo/foo {:mvn/version \"0.2.0\"}}}" + (str (r/assoc-in (r/parse-string "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}") + [:deps 'foo/foo :mvn/version] + "0.2.0")))) + (is (= "{:a 1 :b {:c 1}}" + (str (r/assoc-in (r/parse-string "{:a 1}") [:b :c] 1))))) + +(deftest update-in-test + (is (= "{:deps {foo/foo {:mvn/version \"0.2.0\"}}}" + (str (r/update-in (r/parse-string "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}") + [:deps 'foo/foo] + #(r/assoc % :mvn/version "0.2.0"))))) + (is (= "{:a {:b {:c 1}}}" + (str (r/update-in (r/parse-string "{}") + [:a :b :c] + (comp (fnil inc 0) r/sexpr))))) + (is (= "{:a {:b {:c 1}}}" + (str (r/update-in (r/parse-string "nil") + [:a :b :c] + (comp (fnil inc 0) r/sexpr)))))) + +(deftest dissoc-test + (is (= "{}" (str (r/dissoc (r/parse-string "{:a 1}") :a)))) + (is (= "{:a 1}" (str (r/dissoc (r/parse-string "{:a 1 \n\n:b 2}") :b)))) + (is (= "{:a 1\n:c 3}" (str (r/dissoc (r/parse-string "{:a 1\n:b 2\n:c 3}") :b)))) + (is (= "{:deps {foo/bar {}}}" (str (r/update (r/parse-string "{:deps {foo/bar {} foo/baz {}}}") + :deps #(r/dissoc % 'foo/baz)))))) diff --git a/test-resources/lib_tests/clojure/term/colors_test.clj b/test-resources/lib_tests/clojure/term/colors_test.clj new file mode 100644 index 00000000..863f3f15 --- /dev/null +++ b/test-resources/lib_tests/clojure/term/colors_test.clj @@ -0,0 +1,29 @@ +(ns clojure.term.colors-test + (:require [clojure.test :refer :all] + [clojure.term.colors :refer :all])) + +(defn get-fn + "get function from symbol in clojure.term.colors package" + [fname] + (ns-resolve (the-ns 'clojure.term.colors) + (-> fname name symbol))) + +(defn test-colors-from-map + "test print colors from a color map" + [colormap & more] + (eval + `(do ~@(map (fn [[color _]] + `(println ((get-fn ~color) + (name ~color) (str ~@more)))) + colormap)))) + +(deftest color-test + (testing "Testing colors." + (test-colors-from-map *colors* " foreground.") + (test-colors-from-map *highlights* " background.") + (test-colors-from-map *attributes* " attributes.")) + + (testing "Testing disable colors." + (binding [*disable-colors* true] + (println \newline "When disabled-colors is set ...") + (test-colors-from-map *colors* " foreground.")))) diff --git a/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj b/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj new file mode 100644 index 00000000..1792beae --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj @@ -0,0 +1,10 @@ +(ns cognitect.test-runner.sample-property-test + (:require [clojure.test.check :as tc] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [clojure.test.check.clojure-test :refer [defspec]])) + +(defspec first-element-is-min-after-sorting 100 + (prop/for-all [v (gen/not-empty (gen/vector gen/int))] + (= (apply min v) + (first (sort v))))) diff --git a/test-resources/lib_tests/cognitect/test_runner/samples_test.clj b/test-resources/lib_tests/cognitect/test_runner/samples_test.clj new file mode 100644 index 00000000..e4ec385c --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner/samples_test.clj @@ -0,0 +1,14 @@ +(ns cognitect.test-runner.samples-test + (:require [clojure.test :as t :refer [deftest is testing]])) + +(deftest math-works + (testing "basic addition and subtraction" + (is (= 42 (+ 40 2))) + (is (= 42 (- 44 2))))) + +(deftest ^:integration test-i + (is (= 1 1))) + + + + diff --git a/test-resources/lib_tests/cognitect/test_runner_test.clj b/test-resources/lib_tests/cognitect/test_runner_test.clj new file mode 100644 index 00000000..e1ea8deb --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner_test.clj @@ -0,0 +1,23 @@ +(ns cognitect.test-runner-test + (:require + [clojure.test :refer :all] + [cognitect.test-runner :as tr])) + +(deftest ns-filters + (are [ns-names ns-regexes available selected] + (= selected (filter (#'tr/ns-filter {:namespace ns-names :namespace-regex ns-regexes}) available)) + + ;; default settings (no -n / -r, use default for -r) + nil nil nil [] + nil nil '[ns1-test ns2-test] '[ns1-test ns2-test] + nil nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns1-test ns2-test] + + ;; specific namespaces + '#{ns3} nil '[ns1-test ns2-test] '[] + '#{ns3 ns4} nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns3 ns4] + + ;; regexes + nil #{#"ns1.*" #"ns3"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3] + + ;; both + '#{ns3} '#{#"ns1.*"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3])) \ No newline at end of file diff --git a/test-resources/lib_tests/contajners/core_test.clj b/test-resources/lib_tests/contajners/core_test.clj new file mode 100644 index 00000000..fb3aa8de --- /dev/null +++ b/test-resources/lib_tests/contajners/core_test.clj @@ -0,0 +1,22 @@ +(ns contajners.core-test + (:require [clojure.test :as t] + [contajners.core :as c])) + +(t/deftest docker-tests + (let [image "busybox:musl" + client (c/client {:engine :docker + :version "v1.41" + :category :images + :conn {:uri "unix:///var/run/docker.sock"}})] + (t/testing "pull an image" + (c/invoke client + {:op :ImageCreate + :params {:fromImage image}}) + (let [images (c/invoke client {:op :ImageList})] + (t/is (contains? (->> images + (mapcat :RepoTags) + (into #{})) + image))) + (c/invoke client + {:op :ImageDelete + :params {:name image}})))) diff --git a/test-resources/lib_tests/contajners/impl_test.clj b/test-resources/lib_tests/contajners/impl_test.clj new file mode 100644 index 00000000..58808220 --- /dev/null +++ b/test-resources/lib_tests/contajners/impl_test.clj @@ -0,0 +1,45 @@ +(ns contajners.impl-test + (:require + [clojure.test :as t] + [contajners.impl :as impl])) + +(t/deftest meta-cleanup + (t/testing "remove internal namespace" + (t/is (= [:foo] + (impl/remove-internal-meta [:contajners/foo :foo]))))) + +(t/deftest param-gathering + (t/testing "gathering params as header query and path" + (t/is (= {:header {:a 1 :b 2} + :query {:c 3 :d 4} + :path {:e 5 :f 6}} + (reduce (partial impl/gather-params {:a 1 :b 2 :c 3 :d 4 :e 5 :f 6}) + {} + [{:name "a" :in :header} + {:name "b" :in :header} + {:name "c" :in :query} + {:name "d" :in :query} + {:name "e" :in :path} + {:name "f" :in :path}]))))) + +(t/deftest body-serialization + (t/testing "body serialization when a map" + (t/is (= {:headers {"content-type" "application/json"} + :body "{\"a\":42}"} + (impl/maybe-serialize-body {:body {:a 42}})))) + (t/testing "body serialization when not a map" + (t/is (= {:body "yes"} + (impl/maybe-serialize-body {:body "yes"}))))) + +(t/deftest path-interpolation + (t/testing "path interpolation" + (t/is (= "/a/{w}/b/41/42" + (impl/interpolate-path "/a/{w}/b/{x}/{y}" {:x 41 :y 42 :z 43}))))) + +(t/deftest json-parsing + (t/testing "successful json parsing" + (t/is (= {:a 42} + (impl/try-json-parse "{\"a\":42}")))) + (t/testing "failed json parsing" + (t/is (= "yes" + (impl/try-json-parse "yes"))))) diff --git a/test-resources/lib_tests/docopt/core_test.clj b/test-resources/lib_tests/docopt/core_test.clj new file mode 100644 index 00000000..a881b9b4 --- /dev/null +++ b/test-resources/lib_tests/docopt/core_test.clj @@ -0,0 +1,88 @@ +(ns docopt.core-test + (:require [cheshire.core :as json] + [clojure.string :as s] + [clojure.test :refer :all] + [docopt.core :as d] + [docopt.match :as m])) + +(def doc-block-regex + (let [doc-begin "r\\\"{3}" + doc-body "((?:\\\"{0,2}[^\\\"]+)*)" + separator "\\\"{3}\n+" + tests "((?:[^r]|r(?!\\\"{3}))*)"] + (re-pattern (str doc-begin doc-body separator tests)))) + +(def test-block-regex + (let [input-begin "(?:\\A|\\n+)\\s*\\$\\s*prog" + input-body "(.*)" + separator "\\n" + tests "((?:.+\\n)*)"] + (re-pattern (str input-begin input-body separator tests)))) + +(defn load-test-cases + "Loads language-agnostic docopt tests from file (such as testcases.docopt)." + [path] + (into [] (mapcat (fn [[_ doc tests]] + (map (fn [[_ args result]] + [doc (into [] (filter seq (s/split (or args "") #"\s+"))) (json/parse-string result)]) + (re-seq test-block-regex tests))) + (re-seq doc-block-regex (s/replace (slurp path) #"#.*" ""))))) + +(defn test-case-error-report + "Returns a report of all failed test cases" + [doc in out] + (let [docinfo (try (d/parse doc) + (catch Exception e (.getMessage e)))] + (if (string? docinfo) + (str "\n" (s/trim-newline doc) "\n" docinfo) + (let [result (or (m/match-argv docinfo in) "user-error")] + (when (not= result out) + (str "\n" (s/trim-newline doc) + "\n$ prog " (s/join " " in) + "\nexpected: " (json/generate-string out) + "\nobtained: " (json/generate-string result) "\n\n")))))) + +(defn valid? + "Validates all test cases found in the file named 'test-cases-file-name'." + [test-cases-file-name] + (let [test-cases (load-test-cases test-cases-file-name)] + (when-let [eseq (seq (remove nil? (map (partial apply test-case-error-report) test-cases)))] + (println "Failed" (count eseq) "/" (count test-cases) "tests loaded from '" test-cases-file-name "'.\n") + (throw (Exception. (apply str eseq)))) + (println "Successfully passed" (count test-cases) "tests loaded from '" test-cases-file-name "'.\n") + true)) + +(deftest docopt-test + (testing "2-arity version" + (is (= {"" "a"} + (d/docopt "usage: prog " ["a"])))) + + (testing "3-arity version" + (is (= "a" + (d/docopt "usage: prog " ["a"] #(get % ""))))) + + (testing "4-arity version" + (is (= "usage: prog " + (d/docopt "usage: prog " [] identity identity)))) + + ;; Adding this test here since it seems testcases file doesn't support quoted args + (testing "should parse quoted args correctly" + (is (= {"-f" "a b"} + (d/docopt "usage: prog [options]\noptions: -f " ["-f" "a b"]))) + (is (= {"--foo" "a\nb"} + (d/docopt "usage: prog [options]\noptions: --foo " ["--foo" "a\nb"]))) + (is (= {"" "a b c "} + (d/docopt "usage: prog " ["a b c "]))) + (is (= {"" "a\tb\nc"} + (d/docopt "usage: prog " ["a\tb\nc"]))) + (binding [docopt.match/*sep-table* {\ "FOO" + \newline "BAR" + \tab "QUX" + \backspace "QUZ"}] + (is (= {"" "a b\nc\td\b"} + (d/docopt "usage: prog " ["aFOObBARcQUXdQUZ"])))))) + +(deftest language-agnostic-test + (is (valid? "https://raw.github.com/docopt/docopt/511d1c57b59cd2ed663a9f9e181b5160ce97e728/testcases.docopt")) + ;; BB-TEST-PATCH: Modified test path + (is (valid? "test-resources/lib_tests/docopt/extra_testcases.docopt"))) diff --git a/test-resources/lib_tests/docopt/extra_testcases.docopt b/test-resources/lib_tests/docopt/extra_testcases.docopt new file mode 100644 index 00000000..c73eac15 --- /dev/null +++ b/test-resources/lib_tests/docopt/extra_testcases.docopt @@ -0,0 +1,57 @@ +# Should output the same things as docopt/docopt for language agnostic tests + +# Testing `--` + +r"""Usage: prog foo -- ... + +""" + +$ prog foo +"user-error" + +$ prog foo -- --bar +{"--":true, "": ["--bar"], "foo":true} + +r"""Usage: prog foo [--] ... + +""" + +$ prog foo +"user-error" +# Wrong, should be +# {"foo": true, "--": false, "": []} + +$ prog foo -- --bar +{"foo": true, "--": true, "": ["--bar"]} + +r"""Complex command + +Usage: + prog [options] -- ... + prog [options] -- ... + prog [options] + prog [options] + +Options: + -f --foo Foo + --bar Bar + +""" + +$ prog x y --foo +{"--":false,"--bar":null,"--foo":true,"":[],"":null,"":null,"":null,"":null,"":"x","":"y"} + +$ prog a b c d +{"--":false,"--bar":null,"--foo":false,"":[],"":"a","":"b","":"c","":"d","":null,"":null} + +$ prog a b c d --foo --bar bar +{"--":false,"--bar":"bar","--foo":true,"":[],"":"a","":"b","":"c","":"d","":null,"":null} + +$ prog x y --bar bar -- extra +{"--bar": "bar", "--foo": false, "": "x", "": "y", "--": true, "": ["extra"], "": null, "": null, "": null, "": null} + +$ prog a b c d --foo --bar bar -- extra +{"--foo": true, "--bar": "bar", "": null, "": null, "--": true, "": ["extra"], "": "a", "": "b", "": "c", "": "d"} + +$ prog x y -- e1 e2 e3 e4 +{"--bar": null, "--foo": false, "": "x", "": "y", "--": true, "": ["e1", "e2", "e3", "e4"], "": null, "": null, "": null, "": null} diff --git a/test-resources/lib_tests/expound/alpha_test.cljc b/test-resources/lib_tests/expound/alpha_test.cljc new file mode 100644 index 00000000..5e663419 --- /dev/null +++ b/test-resources/lib_tests/expound/alpha_test.cljc @@ -0,0 +1,4350 @@ +(ns expound.alpha-test + (:require #?@(:clj + ;; just to include the specs + [[clojure.core.specs.alpha] + [ring.core.spec] + [onyx.spec]]) + + ;; Deps for specs that generate specs, which are currently disabled + #_[clojure.test.check.random :as random] + #_[clojure.test.check.rose-tree :as rose] + + [clojure.set :as set] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st] + [clojure.string :as string] + [clojure.test :as ct :refer [is testing deftest use-fixtures]] + [clojure.test.check.generators :as gen] + + [clojure.walk :as walk] + [com.gfredericks.test.chuck :as chuck] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.alpha :as expound] + [expound.ansi :as ansi] + [expound.printer :as printer] + [expound.problems :as problems] + [expound.spec-gen :as sg] + [expound.test-utils :as test-utils] + [spec-tools.data-spec :as ds] + #?(:clj [orchestra.spec.test :as orch.st] + :cljs [orchestra-cljs.spec.test :as orch.st]))) + +;;;; override specs and add generators +;;;; this allows us to load expound with babaska and spartan.spec +(s/def :expound.printer/value-str-fn (s/with-gen ifn? + #(gen/return (fn [_ _ _ _] "NOT IMPLEMENTED")))) + +(s/def :expound.spec/spec (s/or + :set set? + :pred (s/with-gen ifn? + #(gen/elements [boolean? string? int? keyword? symbol?])) + :kw qualified-keyword? + :spec (s/with-gen s/spec? + #(gen/elements + (for [pr [boolean? string? int? keyword? symbol?]] + (s/spec pr)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def num-tests 5) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +;; Missing onyx specs +(s/def :trigger/materialize any?) +(s/def :flow/short-circuit any?) + +(defn pf + "Fixes platform-specific namespaces and also formats using printf syntax" + [s & args] + (apply printer/format + #?(:cljs (string/replace s "pf." "cljs.") + :clj (string/replace s "pf." "clojure.")) + args)) + +(defn take-lines [n s] + (string/join "\n" (take n (string/split-lines s)))) + +(defn formatted-exception [printer-options f] + (let [printer (expound/custom-printer printer-options) + exception-data (binding [s/*explain-out* printer] + (try + (f) + (catch #?(:cljs :default :clj Exception) + e + #?(:cljs {:message (.-message e) + :data (.-data e)} + + :clj (Throwable->map e))))) + ed #?(:cljs (-> exception-data :data) + :clj (-> exception-data :via last :data)) + cause# (-> #?(:cljs (:message exception-data) + :clj (:cause exception-data)) + (clojure.string/replace #"Call to (.*) did not conform to spec:" + "Call to #'$1 did not conform to spec."))] + + (str cause# + (if (re-find #"Detected \d+ error" cause#) + "" + (str "\n" + (with-out-str (printer ed))))))) + +(defn orch-unstrument-test-fns [f] + (orch.st/unstrument [`results-str-fn1 + `results-str-fn2 + `results-str-fn4 + `results-str-fn7]) + (f)) + +(def inverted-ansi-codes + (reduce + (fn [m [k v]] + (assoc m (str v) k)) + {} + ansi/sgr-code)) + +(defn readable-ansi [s] + (string/replace + s + #"\x1b\[([0-9]*)m" + #(str "<" (string/upper-case (name (get inverted-ansi-codes (second %)))) ">"))) + +;; https://github.com/bhb/expound/issues/8 +(deftest expound-output-ends-in-newline + (is (= "\n" (str (last (expound/expound-str string? 1))))) + (is (= "\n" (str (last (expound/expound-str string? "")))))) + +(deftest expound-prints-expound-str + (is (= + (expound/expound-str string? 1) + (with-out-str (expound/expound string? 1))))) + +(deftest predicate-spec + (is (= (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + string? + +------------------------- +Detected 1 error\n") + (expound/expound-str string? 1)))) + +(s/def :simple-type-based-spec/str string?) + +(deftest simple-type-based-spec + (testing "valid value" + (is (= "Success!\n" + (expound/expound-str :simple-type-based-spec/str "")))) + + (testing "invalid value" + (is (= + (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + string? + +-- Relevant specs ------- + +:simple-type-based-spec/str: + pf.core/string? + +------------------------- +Detected 1 error\n") + (expound/expound-str :simple-type-based-spec/str 1))))) + +(s/def :set-based-spec/tag #{:foo :bar}) +(s/def :set-based-spec/nilable-tag (s/nilable :set-based-spec/tag)) +(s/def :set-based-spec/set-of-one #{:foobar}) + +(s/def :set-based-spec/one-or-two (s/or + :one (s/cat :a #{:one}) + :two (s/cat :b #{:two}))) + +(deftest set-based-spec + (testing "prints valid options" + (is (= "-- Spec failed -------------------- + + :baz + +should be one of: :bar, :foo + +-- Relevant specs ------- + +:set-based-spec/tag: + #{:bar :foo} + +------------------------- +Detected 1 error\n" + (expound/expound-str :set-based-spec/tag :baz)))) + + (testing "prints combined options for various specs" + (is (= (pf "-- Spec failed -------------------- + + [:three] + ^^^^^^ + +should be one of: :one, :two + +-- Relevant specs ------- + +:set-based-spec/one-or-two: + (pf.spec.alpha/or + :one + (pf.spec.alpha/cat :a #{:one}) + :two + (pf.spec.alpha/cat :b #{:two})) + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/one-or-two [:three])))) + + (testing "nilable version" + (is (= (pf "-- Spec failed -------------------- + + :baz + +should be one of: :bar, :foo + +or + +should satisfy + + nil? + +-- Relevant specs ------- + +:set-based-spec/tag: + #{:bar :foo} +:set-based-spec/nilable-tag: + (pf.spec.alpha/nilable :set-based-spec/tag) + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/nilable-tag :baz)))) + (testing "single element spec" + (is (= (pf "-- Spec failed -------------------- + + :baz + +should be: :foobar + +-- Relevant specs ------- + +:set-based-spec/set-of-one: + #{:foobar} + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/set-of-one :baz))))) + +(s/def :nested-type-based-spec/str string?) +(s/def :nested-type-based-spec/strs (s/coll-of :nested-type-based-spec/str)) + +(deftest nested-type-based-spec + (is (= + (pf "-- Spec failed -------------------- + + [... ... 33] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:nested-type-based-spec/str: + pf.core/string? +:nested-type-based-spec/strs: + (pf.spec.alpha/coll-of :nested-type-based-spec/str) + +------------------------- +Detected 1 error\n") + (expound/expound-str :nested-type-based-spec/strs ["one" "two" 33])))) + +(s/def :nested-type-based-spec-special-summary-string/int int?) +(s/def :nested-type-based-spec-special-summary-string/ints (s/coll-of :nested-type-based-spec-special-summary-string/int)) + +(deftest nested-type-based-spec-special-summary-string + (is (= + (pf "-- Spec failed -------------------- + + [... ... \"...\"] + ^^^^^ + +should satisfy + + int? + +-- Relevant specs ------- + +:nested-type-based-spec-special-summary-string/int: + pf.core/int? +:nested-type-based-spec-special-summary-string/ints: + (pf.spec.alpha/coll-of + :nested-type-based-spec-special-summary-string/int) + +------------------------- +Detected 1 error\n") + (expound/expound-str :nested-type-based-spec-special-summary-string/ints [1 2 "..."])))) + +(s/def :or-spec/str-or-int (s/or :int int? :str string?)) +(s/def :or-spec/vals (s/coll-of :or-spec/str-or-int)) + +(s/def :or-spec/str string?) +(s/def :or-spec/int int?) +(s/def :or-spec/m-with-str (s/keys :req [:or-spec/str])) +(s/def :or-spec/m-with-int (s/keys :req [:or-spec/int])) +(s/def :or-spec/m-with-str-or-int (s/or :m-with-str :or-spec/m-with-str + :m-with-int :or-spec/m-with-int)) + +(deftest or-spec + (testing "simple value" + (is (= (pf "-- Spec failed -------------------- + + :kw + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:or-spec/str-or-int: + (pf.spec.alpha/or :int pf.core/int? :str pf.core/string?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :or-spec/str-or-int :kw)))) + (testing "collection of values" + (is (= (pf "-- Spec failed -------------------- + + [... ... :kw ...] + ^^^ + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:or-spec/str-or-int: + (pf.spec.alpha/or :int pf.core/int? :str pf.core/string?) +:or-spec/vals: + (pf.spec.alpha/coll-of :or-spec/str-or-int) + +------------------------- +Detected 1 error\n") + (expound/expound-str :or-spec/vals [0 "hi" :kw "bye"])))) + (is (= "-- Spec failed -------------------- + + 50 + +should satisfy + + coll? + +------------------------- +Detected 1 error +" + (expound/expound-str (s/or + :strs (s/coll-of string?) + :ints (s/coll-of int?)) + 50))) + (is (= "-- Spec failed -------------------- + + 50 + +should be one of: \"a\", \"b\", 1, 2 + +------------------------- +Detected 1 error +" + (expound/expound-str + (s/or + :letters #{"a" "b"} + :ints #{1 2}) + 50))) + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :or-spec/int, :or-spec/str + +| key | spec | +|==============+=========| +| :or-spec/int | int? | +|--------------+---------| +| :or-spec/str | string? | + +-- Relevant specs ------- + +:or-spec/m-with-int: + (pf.spec.alpha/keys :req [:or-spec/int]) +:or-spec/m-with-str: + (pf.spec.alpha/keys :req [:or-spec/str]) +:or-spec/m-with-str-or-int: + (pf.spec.alpha/or + :m-with-str + :or-spec/m-with-str + :m-with-int + :or-spec/m-with-int) + +------------------------- +Detected 1 error +") + (expound/expound-str :or-spec/m-with-str-or-int {}))) + (testing "de-dupes keys" + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :or-spec/str + +| key | spec | +|==============+=========| +| :or-spec/str | string? | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/or :m-with-str1 (s/keys :req [:or-spec/str]) + :m-with-int2 (s/keys :req [:or-spec/str])) {}))))) + +(s/def :and-spec/name (s/and string? #(pos? (count %)))) +(s/def :and-spec/names (s/coll-of :and-spec/name)) +(deftest and-spec + (testing "simple value" + (is (= (pf "-- Spec failed -------------------- + + \"\" + +should satisfy + + (fn [%%] (pos? (count %%))) + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) + +------------------------- +Detected 1 error\n") + (expound/expound-str :and-spec/name "")))) + + (testing "shows both failures in order" + (is (= + (pf "-- Spec failed -------------------- + + [... ... \"\" ...] + ^^ + +should satisfy + + %s + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) +:and-spec/names: + (pf.spec.alpha/coll-of :and-spec/name) + +-- Spec failed -------------------- + + [... ... ... 1] + ^ + +should satisfy + + string? + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) +:and-spec/names: + (pf.spec.alpha/coll-of :and-spec/name) + +------------------------- +Detected 2 errors\n" + #?(:cljs "(fn [%] (pos? (count %)))" + :clj "(fn [%] (pos? (count %)))")) + (expound/expound-str :and-spec/names ["bob" "sally" "" 1]))))) + +(s/def :coll-of-spec/big-int-coll (s/coll-of int? :min-count 10)) + +(deftest coll-of-spec + (testing "min count" + (is (= + (pf "-- Spec failed -------------------- + + [] + +should satisfy + + (<= 10 (count %%) %s) + +-- Relevant specs ------- + +:coll-of-spec/big-int-coll: + (pf.spec.alpha/coll-of pf.core/int? :min-count 10) + +------------------------- +Detected 1 error\n" + #?(:cljs "9007199254740991" + :clj "Integer/MAX_VALUE")) + (expound/expound-str :coll-of-spec/big-int-coll []))))) + +(s/def :cat-spec/kw (s/cat :k keyword? :v any?)) +(s/def :cat-spec/set (s/cat :type #{:foo :bar} :str string?)) +(s/def :cat-spec/alt* (s/alt :s string? :i int?)) +(s/def :cat-spec/alt (s/+ :cat-spec/alt*)) +(s/def :cat-spec/alt-inline (s/+ (s/alt :s string? :i int?))) +(s/def :cat-spec/any (s/cat :x (s/+ any?))) ;; Not a useful spec, but worth testing +(deftest cat-spec + (testing "too few elements" + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":k\" should satisfy + + keyword? + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":type\" should be one of: :bar, :foo + +-- Relevant specs ------- + +:cat-spec/set: + (pf.spec.alpha/cat :type #{:bar :foo} :str pf.core/string?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/set []))) + (is (= (pf "-- Syntax error ------------------- + + [:foo] + +should have additional elements. The next element \":v\" should satisfy + + any? + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw [:foo]))) + ;; This isn't ideal, but requires a fix from clojure + ;; https://clojure.atlassian.net/browse/CLJ-2364 + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element should satisfy + + (pf.spec.alpha/alt :s string? :i int?) + +-- Relevant specs ------- + +:cat-spec/alt*: + (pf.spec.alpha/alt :s pf.core/string? :i pf.core/int?) +:cat-spec/alt: + (pf.spec.alpha/+ :cat-spec/alt*) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/alt []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element should satisfy + + (pf.spec.alpha/alt :s string? :i int?) + +-- Relevant specs ------- + +:cat-spec/alt-inline: + (pf.spec.alpha/+ + (pf.spec.alpha/alt :s pf.core/string? :i pf.core/int?)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/alt-inline []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":x\" should satisfy + + any? + +-- Relevant specs ------- + +:cat-spec/any: + (pf.spec.alpha/cat :x (pf.spec.alpha/+ pf.core/any?)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/any [])))) + (testing "too many elements" + (is (= (pf "-- Syntax error ------------------- + + [... ... :bar ...] + ^^^^ + +has extra input + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw [:foo 1 :bar :baz]))))) + +(s/def :keys-spec/name string?) +(s/def :keys-spec/age int?) +(s/def :keys-spec/user (s/keys :req [:keys-spec/name] + :req-un [:keys-spec/age])) + +(s/def :key-spec/state string?) +(s/def :key-spec/city string?) +(s/def :key-spec/zip pos-int?) + +(s/def :keys-spec/user2 (s/keys :req [(and :keys-spec/name + :keys-spec/age)] + :req-un [(or + :key-spec/zip + (and + :key-spec/state + :key-spec/city))])) + +(s/def :keys-spec/user3 (s/keys :req-un [(or + :key-spec/zip + (and + :key-spec/state + :key-spec/city))])) + +(s/def :keys-spec/user4 (s/keys :req [])) + +(defmulti key-spec-mspec :tag) +(defmethod key-spec-mspec :int [_] (s/keys :req-un [::tag ::i])) +(defmethod key-spec-mspec :string [_] (s/keys :req-un [::tag ::s])) +(deftest keys-spec + (testing "missing keys" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :age, :keys-spec/name + +| key | spec | +|=================+=========| +| :age | int? | +|-----------------+---------| +| :keys-spec/name | string? | + +-- Relevant specs ------- + +:keys-spec/user: + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str :keys-spec/user {})))) + (testing "missing compound keys" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: + +(and (and :keys-spec/name :keys-spec/age) (or :zip (and :state :city))) + +| key | spec | +|=================+==========| +| :city | string? | +|-----------------+----------| +| :state | string? | +|-----------------+----------| +| :zip | pos-int? | +|-----------------+----------| +| :keys-spec/age | int? | +|-----------------+----------| +| :keys-spec/name | string? | + +-- Relevant specs ------- + +:keys-spec/user2: + (pf.spec.alpha/keys + :req + [(and :keys-spec/name :keys-spec/age)] + :req-un + [(or :key-spec/zip (and :key-spec/state :key-spec/city))]) + +------------------------- +Detected 1 error\n") + (expound/expound-str :keys-spec/user2 {}))) + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: + +(or :zip (and :state :city)) + +| key | spec | +|========+==========| +| :city | string? | +|--------+----------| +| :state | string? | +|--------+----------| +| :zip | pos-int? | + +-- Relevant specs ------- + +:keys-spec/user3: + (pf.spec.alpha/keys + :req-un + [(or :key-spec/zip (and :key-spec/state :key-spec/city))]) + +------------------------- +Detected 1 error\n") + (expound/expound-str :keys-spec/user3 {})))) + + (testing "inline spec with req-un" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :age, :name + +| key | spec | +|=======+=========| +| :age | int? | +|-------+---------| +| :name | string? | + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str (s/keys :req-un [:keys-spec/name :keys-spec/age]) {}))) + (s/def :key-spec/mspec (s/multi-spec key-spec-mspec :tag)) + (s/def :key-spec/i int?) + (s/def :key-spec/s string?) + ;; We can't inspect the contents of a multi-spec (to figure out + ;; which spec we mean by :i), so this is the best we can do. + (is (= "-- Spec failed -------------------- + + {:tag :int} + +should contain key: :i + +| key | spec | +|=====+===================================================| +| :i | | + +------------------------- +Detected 1 error\n" + (expound/expound-str + :key-spec/mspec + {:tag :int} + {:print-specs? false})))) + + (testing "invalid key" + (is (= (pf "-- Spec failed -------------------- + + {:age ..., :keys-spec/name :bob} + ^^^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:keys-spec/name: + pf.core/string? +:keys-spec/user: + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str :keys-spec/user {:age 1 :keys-spec/name :bob})))) + (testing "contains compound specs" + (s/def :keys-spec/states (s/coll-of :key-spec/state :kind vector?)) + (s/def :keys-spec/address (s/keys :req [:key-spec/city :key-space/state])) + (s/def :keys-spec/cities (s/coll-of :key-spec/city :kind set?)) + (s/def :keys-spec/locations (s/keys :req-un [:keys-spec/states + :keys-spec/address + :keys-spec/locations])) + (is (= + "-- Spec failed -------------------- + + {} + +should contain keys: :address, :locations, :states + +| key | spec | +|============+===============================================================| +| :address | (keys :req [:key-spec/city :key-space/state]) | +|------------+---------------------------------------------------------------| +| :locations | (keys | +| | :req-un | +| | [:keys-spec/states :keys-spec/address :keys-spec/locations]) | +|------------+---------------------------------------------------------------| +| :states | (coll-of :key-spec/state :kind vector?) | + +------------------------- +Detected 1 error +" + (expound/expound-str :keys-spec/locations {} {:print-specs? false}))))) + +(s/def :keys-spec/foo string?) +(s/def :keys-spec/bar string?) +(s/def :keys-spec/baz string?) +(s/def :keys-spec/qux (s/or :string string? + :int int?)) +(s/def :keys-spec/child-1 (s/keys :req-un [:keys-spec/baz :keys-spec/qux])) +(s/def :keys-spec/child-2 (s/keys :req-un [:keys-spec/bar :keys-spec/child-1])) + +(s/def :keys-spec/map-spec-1 (s/keys :req-un [:keys-spec/foo + :keys-spec/bar + :keys-spec/baz])) +(s/def :keys-spec/map-spec-2 (s/keys :req-un [:keys-spec/foo + :keys-spec/bar + :keys-spec/qux])) +(s/def :keys-spec/map-spec-3 (s/keys :req-un [:keys-spec/foo + :keys-spec/child-2])) + +(deftest grouping-and-key-specs + (is (= (pf + "-- Spec failed -------------------- + + {:foo 1.2, :bar ..., :baz ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar 123, :baz ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar ..., :baz true} + ^^^^ + +should satisfy + + string? + +------------------------- +Detected 3 errors\n") + (expound/expound-str :keys-spec/map-spec-1 {:foo 1.2 + :bar 123 + :baz true} + {:print-specs? false}))) + (is (= (pf + "-- Spec failed -------------------- + + {:foo 1.2, :bar ..., :qux ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar 123, :qux ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar ..., :qux false} + ^^^^^ + +should satisfy + + string? + +or + + int? + +------------------------- +Detected 3 errors\n") + (expound/expound-str :keys-spec/map-spec-2 {:foo 1.2 + :bar 123 + :qux false} + {:print-specs? false}))) + + (is (= + "-- Spec failed -------------------- + + {:foo 1.2, :child-2 ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :child-2 {:bar 123, :child-1 ...}} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., + :child-2 + {:bar ..., :child-1 {:baz true, :qux ...}}} + ^^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., + :child-2 + {:bar ..., :child-1 {:baz ..., :qux false}}} + ^^^^^ + +should satisfy + + string? + +or + + int? + +------------------------- +Detected 4 errors\n" + (expound/expound-str :keys-spec/map-spec-3 {:foo 1.2 + :child-2 {:bar 123 + :child-1 {:baz true + :qux false}}} + {:print-specs? false})))) + +(s/def :multi-spec/value string?) +(s/def :multi-spec/children vector?) +(defmulti el-type :multi-spec/el-type) +(defmethod el-type :text [_x] + (s/keys :req [:multi-spec/value])) +(defmethod el-type :group [_x] + (s/keys :req [:multi-spec/children])) +(s/def :multi-spec/el (s/multi-spec el-type :multi-spec/el-type)) + +(defmulti multi-spec-bar-spec :type) +(defmethod multi-spec-bar-spec ::b [_] (s/keys :req [::b])) +(deftest multi-spec + (testing "missing dispatch key" + (is (= + (pf "-- Missing spec ------------------- + +Cannot find spec for + + {} + +with + + Spec multimethod: `expound.alpha-test/el-type` + Dispatch value: `nil` + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {})))) + (testing "invalid dispatch value" + (is (= + (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:multi-spec/el-type :image} + +with + + Spec multimethod: `expound.alpha-test/el-type` + Dispatch value: `:image` + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {:multi-spec/el-type :image})))) + + (testing "valid dispatch value, but other error" + (is (= + (pf "-- Spec failed -------------------- + + {:multi-spec/el-type :text} + +should contain key: :multi-spec/value + +| key | spec | +|===================+=========| +| :multi-spec/value | string? | + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {:multi-spec/el-type :text})))) + + ;; https://github.com/bhb/expound/issues/122 + (testing "when re-tag is a function" + (s/def :multi-spec/b string?) + (s/def :multi-spec/bar (s/multi-spec multi-spec-bar-spec (fn [val tag] (assoc val :type tag)))) + (is (= "-- Missing spec ------------------- + +Cannot find spec for + + {} + +with + + Spec multimethod: `expound.alpha-test/multi-spec-bar-spec` + Dispatch value: `nil` + +------------------------- +Detected 1 error +" + (expound/expound-str :multi-spec/bar {} {:print-specs? false}))))) + +(s/def :recursive-spec/tag #{:text :group}) +(s/def :recursive-spec/on-tap (s/coll-of map? :kind vector?)) +(s/def :recursive-spec/props (s/keys :opt-un [:recursive-spec/on-tap])) +(s/def :recursive-spec/el (s/keys :req-un [:recursive-spec/tag] + :opt-un [:recursive-spec/props :recursive-spec/children])) +(s/def :recursive-spec/children (s/coll-of (s/nilable :recursive-spec/el) :kind vector?)) + +(s/def :recursive-spec/tag-2 (s/or :text (fn [n] (= n :text)) + :group (fn [n] (= n :group)))) +(s/def :recursive-spec/on-tap-2 (s/coll-of map? :kind vector?)) +(s/def :recursive-spec/props-2 (s/keys :opt-un [:recursive-spec/on-tap-2])) +(s/def :recursive-spec/el-2 (s/keys :req-un [:recursive-spec/tag-2] + :opt-un [:recursive-spec/props-2 + :recursive-spec/children-2])) +(s/def :recursive-spec/children-2 (s/coll-of (s/nilable :recursive-spec/el-2) :kind vector?)) + +(deftest recursive-spec + (testing "only shows problem with data at 'leaves' (not problems with all parents in tree)" + (is (= (pf + "-- Spec failed -------------------- + + {:tag ..., :children [{:tag :group, :children [{:tag :group, :props {:on-tap {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag ..., + :children [{:tag ..., :children [{:tag :group, :props {:on-tap {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag ..., + :children + [{:tag ..., + :children + [{:tag ..., :props {:on-tap {}}}]}]} + ^^ + +should satisfy + + vector? + +------------------------- +Detected 1 error\n") + (expound/expound-str + :recursive-spec/el + {:tag :group + :children [{:tag :group + :children [{:tag :group + :props {:on-tap {}}}]}]} + {:print-specs? false})))) + (testing "test that our new recursive spec grouping function works with + alternative paths" + (is (= (pf + "-- Spec failed -------------------- + + {:tag-2 ..., :children-2 [{:tag-2 :group, :children-2 [{:tag-2 :group, :props-2 {:on-tap-2 {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag-2 ..., + :children-2 [{:tag-2 ..., :children-2 [{:tag-2 :group, :props-2 {:on-tap-2 {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag-2 ..., + :children-2 + [{:tag-2 ..., + :children-2 + [{:tag-2 ..., :props-2 {:on-tap-2 {}}}]}]} + ^^ + +should satisfy + + vector? + +------------------------- +Detected 1 error\n") + (expound/expound-str + :recursive-spec/el-2 + {:tag-2 :group + :children-2 [{:tag-2 :group + :children-2 [{:tag-2 :group + :props-2 {:on-tap-2 {}}}]}]} + {:print-specs? false}))))) + +(s/def :cat-wrapped-in-or-spec/kv (s/and + sequential? + (s/cat :k keyword? :v any?))) +(s/def :cat-wrapped-in-or-spec/type #{:text}) +(s/def :cat-wrapped-in-or-spec/kv-or-string (s/or + :map (s/keys :req [:cat-wrapped-in-or-spec/type]) + :kv :cat-wrapped-in-or-spec/kv)) + +(deftest cat-wrapped-in-or-spec + (is (= (pf "-- Spec failed -------------------- + + {\"foo\" \"hi\"} + +should contain key: :cat-wrapped-in-or-spec/type + +| key | spec | +|==============================+==========| +| :cat-wrapped-in-or-spec/type | #{:text} | + +or + +should satisfy + + sequential? + +-- Relevant specs ------- + +:cat-wrapped-in-or-spec/kv: + (pf.spec.alpha/and + pf.core/sequential? + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?)) +:cat-wrapped-in-or-spec/kv-or-string: + (pf.spec.alpha/or + :map + (pf.spec.alpha/keys :req [:cat-wrapped-in-or-spec/type]) + :kv + :cat-wrapped-in-or-spec/kv) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-wrapped-in-or-spec/kv-or-string {"foo" "hi"})))) + +(s/def :map-of-spec/name string?) +(s/def :map-of-spec/age pos-int?) +(s/def :map-of-spec/name->age (s/map-of :map-of-spec/name :map-of-spec/age)) +(deftest map-of-spec + (is (= (pf "-- Spec failed -------------------- + + {\"Sally\" \"30\"} + ^^^^ + +should satisfy + + pos-int? + +-- Relevant specs ------- + +:map-of-spec/age: + pf.core/pos-int? +:map-of-spec/name->age: + (pf.spec.alpha/map-of :map-of-spec/name :map-of-spec/age) + +------------------------- +Detected 1 error\n") + (expound/expound-str :map-of-spec/name->age {"Sally" "30"}))) + (is (= (pf "-- Spec failed -------------------- + + {:sally ...} + ^^^^^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:map-of-spec/name: + pf.core/string? +:map-of-spec/name->age: + (pf.spec.alpha/map-of :map-of-spec/name :map-of-spec/age) + +------------------------- +Detected 1 error\n") + (expound/expound-str :map-of-spec/name->age {:sally 30})))) + +(deftest generated-simple-spec + (checking + "simple spec" + (chuck/times num-tests) + [simple-spec sg/simple-spec-gen + form gen/any-printable] + (is (string? (expound/expound-str simple-spec form))))) + +(deftest generated-coll-of-specs + (checking + "'coll-of' spec" + (chuck/times num-tests) + [simple-spec sg/simple-spec-gen + every-args (s/gen :specs/every-args) + :let [spec (sg/apply-coll-of simple-spec every-args)] + form gen/any-printable] + (is (string? (expound/expound-str spec form))))) + +(deftest generated-and-specs + (checking + "'and' spec" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + :let [spec (s/and simple-spec1 simple-spec2)] + form gen/any-printable] + (is (string? (expound/expound-str spec form))))) + +(deftest generated-or-specs + (checking + "'or' spec generates string" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + :let [spec (s/or :or1 simple-spec1 :or2 simple-spec2)] + form gen/any-printable] + (is (string? (expound/expound-str spec form)))) + (checking + "nested 'or' spec reports on all problems" + (chuck/times num-tests) + [simple-specs (gen/vector-distinct + (gen/elements [:specs/string + :specs/vector + :specs/int + :specs/boolean + :specs/keyword + :specs/map + :specs/symbol + :specs/pos-int + :specs/neg-int + :specs/zero]) + {:num-elements 4}) + :let [[simple-spec1 + simple-spec2 + simple-spec3 + simple-spec4] simple-specs + spec (s/or :or1 + (s/or :or1.1 + simple-spec1 + :or1.2 + simple-spec2) + :or2 + (s/or :or2.1 + simple-spec3 + :or2.2 + simple-spec4)) + sp-form (s/form spec)] + form gen/any-printable] + (let [ed (s/explain-data spec form)] + (when-not (zero? (count (::s/problems ed))) + (is (= (dec (count (::s/problems ed))) + (count (re-seq #"\nor\n" (expound/expound-str spec form)))) + (str "Failed to print out all problems\nspec: " sp-form "\nproblems: " (printer/pprint-str (::s/problems ed)) "\nmessage: " (expound/expound-str spec form))))))) + +(deftest generated-map-of-specs + (checking + "'map-of' spec" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + simple-spec3 sg/simple-spec-gen + every-args1 (s/gen :specs/every-args) + every-args2 (s/gen :specs/every-args) + :let [spec (sg/apply-map-of simple-spec1 (sg/apply-map-of simple-spec2 simple-spec3 every-args1) every-args2)] + form test-utils/any-printable-wo-nan] + (is (string? (expound/expound-str spec form))))) + +(s/def :expound.ds/spec-key (s/or :kw keyword? + :req (s/tuple + #{:expound.ds/req-key} + (s/map-of + #{:k} + keyword? + :count 1)) + :opt (s/tuple + #{:expound.ds/opt-key} + (s/map-of + #{:k} + keyword? + :count 1)))) + +(defn real-spec [form] + (walk/prewalk + (fn [x] + (if (vector? x) + (case (first x) + :expound.ds/opt-key + (ds/map->OptionalKey (second x)) + + :expound.ds/req-key + (ds/map->RequiredKey (second x)) + + :expound.ds/maybe-spec + (ds/maybe (second x)) + + x) + x)) + form)) + +(s/def :expound.ds/maybe-spec + (s/tuple + #{:expound.ds/maybe-spec} + :expound.ds/spec)) + +(s/def :expound.ds/simple-specs + #{string? + vector? + int? + boolean? + keyword? + map? + symbol? + pos-int? + neg-int? + nat-int?}) + +(s/def :expound.ds/vector-spec (s/coll-of + :expound.ds/spec + :count 1 + :kind vector?)) + +(s/def :expound.ds/set-spec (s/coll-of + :expound.ds/spec + :count 1 + :kind set?)) + +(s/def :expound.ds/map-spec + (s/map-of :expound.ds/spec-key + :expound.ds/spec)) + +(s/def :expound.ds/spec + (s/or + :map :expound.ds/map-spec + :vector :expound.ds/vector-spec + :set :expound.ds/set-spec + :simple :expound.ds/simple-specs + :maybe :expound.ds/maybe-spec)) + +(deftest generated-data-specs + (checking + "generated data specs" + (chuck/times num-tests) + [data-spec (s/gen :expound.ds/spec) + form test-utils/any-printable-wo-nan + prefix (s/gen qualified-keyword?) + :let [gen-spec (ds/spec prefix (real-spec data-spec))]] + (is (string? (expound/expound-str gen-spec form))))) + +;; FIXME - keys +;; FIXME - cat + alt, + ? * +;; FIXME - nilable +;; FIXME - test coll-of that is a set . can i should a bad element of a set? + +(s/def :test-assert/name string?) +(deftest test-assert + (testing "assertion passes" + (is (= "hello" + (s/assert :test-assert/name "hello")))) + (testing "assertion fails" + #?(:cljs + (try + (binding [s/*explain-out* expound/printer] + (s/assert :test-assert/name :hello)) + (catch :default e + (is (= "Spec assertion failed\n-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-assert/name: + cljs.core/string? + +------------------------- +Detected 1 error\n" + (.-message e))))) + :clj + (try + (binding [s/*explain-out* expound/printer] + (s/assert :test-assert/name :hello)) + (catch Exception e + (is (= "Spec assertion failed +-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-assert/name: + clojure.core/string? + +------------------------- +Detected 1 error\n" + ;; FIXME - move assertion out of catch, similar to instrument tests + (:cause (Throwable->map e))))))))) + +(s/def :test-explain-str/name string?) +(deftest test-explain-str + (is (= (pf "-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-explain-str/name: + pf.core/string? + +------------------------- +Detected 1 error\n") + (binding [s/*explain-out* expound/printer] + (s/explain-str :test-explain-str/name :hello))))) + +(s/fdef test-instrument-adder + :args (s/cat :x int? :y int?) + :fn #(> (:ret %) (-> % :args :x)) + :ret pos-int?) +(defn test-instrument-adder [& args] + (let [[x y] args] + (+ x y))) + +(defn no-linum [s] + (string/replace s #"(.cljc?):\d+" "$1:LINUM")) + +(deftest test-instrument + (st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (formatted-exception {:print-specs? false} #(test-instrument-adder "" :x)))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? false} #(test-instrument-adder "" :x)))))) + (st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-args-spec-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum (formatted-exception {:print-specs? false} #(test-instrument-adder "" :x))))) + :clj (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {} + #(test-instrument-adder "" :x)))))) + + (orch.st/unstrument `test-instrument-adder)) + +;; Note - you may need to comment out this test out when +;; using figwheel.main for testing, since the compilation +;; warning seems to impact the building of other tests +(deftest test-instrument-with-orchestra-args-syntax-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Syntax error ------------------- + +Function arguments + + (1) + +should have additional elements. The next element \":y\" should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum (formatted-exception {:print-specs? false} #(test-instrument-adder 1))))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Syntax error ------------------- + +Function arguments + + (1) + +should have additional elements. The next element \":y\" should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {:print-specs? false} + #(test-instrument-adder 1)))))) + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-ret-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Return value + + -3 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n" + (formatted-exception {} + #(test-instrument-adder -1 -2)) + #_(.-message (try + (binding [s/*explain-out* expound/printer] + (test-instrument-adder -1 -2)) + (catch :default e e))))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Return value + + -3 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {:print-specs? false} + #(test-instrument-adder -1 -2)))))) + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-fn-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments and return value + + {:ret 1, :args {:x 1, :y 0}} + +should satisfy + + (fn [%] (> (:ret %) (-> % :args :x))) + +------------------------- +Detected 1 error\n" + (formatted-exception {} #(test-instrument-adder 1 0)))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments and return value + + {:ret 1, :args {:x 1, :y 0}} + +should satisfy + + (fn + [%] + (> (:ret %) (-> % :args :x))) + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false} #(test-instrument-adder 1 0)))))) + + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-custom-value-printer + (st/instrument `test-instrument-adder) + #?(:cljs + (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" :x) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? true} #(test-instrument-adder "" :x))))) + :clj + (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" :x) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? true} #(test-instrument-adder "" :x)))))) + + (st/unstrument `test-instrument-adder)) + +(s/def :custom-printer/strings (s/coll-of string?)) +(deftest custom-printer + (testing "custom value printer" + (is (= (pf "-- Spec failed -------------------- + + + +should satisfy + + string? + +-- Relevant specs ------- + +:custom-printer/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:value-str-fn (fn [_spec-name _form _path _val] " ")})] + (s/explain-str :custom-printer/strings ["a" "b" :c])))))) + +(s/def :alt-spec/int-alt-str (s/alt :int int? :string string?)) + +(s/def :alt-spec/num-types (s/alt :int int? :float float?)) +(s/def :alt-spec/str-types (s/alt :int (fn [n] (= n "int")) + :float (fn [n] (= n "float")))) +(s/def :alt-spec/num-or-str (s/alt :num :alt-spec/num-types + :str :alt-spec/str-types)) + +(s/def :alt-spec/i int?) +(s/def :alt-spec/s string?) +(s/def :alt-spec/alt-or-map (s/or :i :alt-spec/i + :s :alt-spec/s + :k (s/keys :req-un [:alt-spec/i :alt-spec/s]))) + +(defmulti alt-spec-mspec :tag) +(s/def :alt-spec/mspec (s/multi-spec alt-spec-mspec :tag)) +(defmethod alt-spec-mspec :x [_] (s/keys :req-un [:alt-spec/one-many-int])) + +(deftest alt-spec + (testing "alternatives at different paths in spec" + (is (= + "-- Spec failed -------------------- + + [\"foo\"] + +should satisfy + + int? + +or value + + [\"foo\"] + ^^^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (expound/expound-str + (s/or + :i int? + :seq (s/cat :x1 int? :x2 int?)) + ["foo"] + {:print-specs? false}))) + (s/def :alt-spec/one-many-int (s/cat :bs (s/alt :one int? + :many (s/spec (s/+ int?))))) + (is (= (pf "-- Spec failed -------------------- + + [[\"1\"]] + ^^^^^ + +should satisfy + + int? + +or value + + [[\"1\"]] + ^^^ + +should satisfy + + int? + +-- Relevant specs ------- + +:alt-spec/one-many-int: + (pf.spec.alpha/cat + :bs + (pf.spec.alpha/alt + :one + pf.core/int? + :many + (pf.spec.alpha/spec (pf.spec.alpha/+ pf.core/int?)))) + +------------------------- +Detected 1 error\n") + (binding [s/*explain-out* (expound/custom-printer {})] + (s/explain-str + :alt-spec/one-many-int + [["1"]])))) + (s/def :alt-spec/one-many-int-or-str (s/cat :bs (s/alt :one :alt-spec/int-alt-str + :many (s/spec (s/+ :alt-spec/int-alt-str))))) + (is (= "-- Spec failed -------------------- + + [[:one]] + ^^^^^^ + +should satisfy + + int? + +or + + string? + +or value + + [[:one]] + ^^^^ + +should satisfy + + int? + +or + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str + :alt-spec/one-many-int-or-str + [[:one]])))) + (s/def :alt-spec/int-or-str (s/or :i int? + :s string?)) + (s/def :alt-spec/one-many-int-or-str (s/cat :bs (s/alt :one :alt-spec/int-or-str + :many (s/spec (s/+ :alt-spec/int-or-str))))) + (is (= "-- Spec failed -------------------- + + [[:one]] + ^^^^^^ + +should satisfy + + int? + +or + + string? + +or value + + [[:one]] + ^^^^ + +should satisfy + + int? + +or + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str + :alt-spec/one-many-int-or-str + [[:one]]))))) + (is (= (pf "-- Spec failed -------------------- + + [:hi] + ^^^ + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:alt-spec/int-alt-str: + %s + +------------------------- +Detected 1 error\n" + #?(:clj "(clojure.spec.alpha/alt + :int + clojure.core/int? + :string + clojure.core/string?)" + :cljs "(cljs.spec.alpha/alt :int cljs.core/int? :string cljs.core/string?)")) + (expound/expound-str :alt-spec/int-alt-str [:hi]))) + + (is (= "-- Spec failed -------------------- + + {:i \"\", :s 1} + +should satisfy + + int? + +or + + string? + +-- Spec failed -------------------- + + {:i \"\", :s ...} + ^^ + +should satisfy + + int? + +-- Spec failed -------------------- + + {:i ..., :s 1} + ^ + +should satisfy + + string? + +------------------------- +Detected 3 errors +" + + (expound/expound-str + :alt-spec/alt-or-map + {:i "" :s 1} + {:print-specs? false}))) + + (is (= "-- Spec failed -------------------- + + [true] + ^^^^ + +should satisfy + + int? + +or + + float? + +or + + (fn [n] (= n \"int\")) + +or + + (fn [n] (= n \"float\")) + +------------------------- +Detected 1 error\n" (expound/expound-str :alt-spec/num-or-str [true] {:print-specs? false}))) + ;; If two s/alt specs have the same tags, we shouldn't confuse them. + (is (= "-- Spec failed -------------------- + + {:num-types [true], :str-types ...} + ^^^^ + +should satisfy + + int? + +or + + float? + +-- Spec failed -------------------- + + {:num-types ..., :str-types [false]} + ^^^^^ + +should satisfy + + (fn [n] (= n \"int\")) + +or + + (fn [n] (= n \"float\")) + +------------------------- +Detected 2 errors\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/keys :req-un [:alt-spec/num-types :alt-spec/str-types]) + {:num-types [true] :str-types [false]})))) + + (is (= + "-- Spec failed -------------------- + + [\"\"] + +should satisfy + + nil? + +or value + + [\"\"] + ^^ + +should satisfy + + int? + +or + + float? + +------------------------- +Detected 1 error +" + (expound/expound-str + (s/nilable (s/cat :n (s/alt :int int? :float float?))) + [""] + {:print-specs? false}))) + (is (= + ;; This output is not what we want: ideally, the two alternates + ;; should be grouped into a single problem. + ;; I'm adding it as a spec to avoid regressions and to keep it as + ;; an example of something I could improve. + ;; The reason we can't do better is that we can't reliably look + ;; at the form of a multi-spec. It would be nice if spec inserted + ;; the actual spec form that was returned by the multi-spec, but + ;; as it stands today, we'd have to figure out how to call the multi- + ;; method with the actual value. That would be complicated and + ;; potentially have unknown side effects from running arbitrary code. + + "-- Spec failed -------------------- + + {:mspec {:tag ..., :one-many-int [[\"1\"]]}} + ^^^^^ + +should satisfy + + int? + +-- Spec failed -------------------- + + {:mspec {:tag ..., :one-many-int [[\"1\"]]}} + ^^^ + +should satisfy + + int? + +------------------------- +Detected 2 errors\n" + + (expound/expound-str + (s/keys + :req-un [:alt-spec/mspec]) + {:mspec + {:tag :x + :one-many-int [["1"]]}} + + {:print-specs? false})))) + +(defn mutate-coll [x] + (cond + (map? x) + (into [] x) + + (vector? x) + (into #{} x) + + (set? x) + (reverse (into '() x)) + + (list? x) + (into {} (map vec (partition 2 x))) + + :else + x)) + +(defn mutate-type [x] + (cond + (number? x) + (str x) + + (string? x) + (keyword x) + + (keyword? x) + (str x) + + (boolean? x) + (str x) + + (symbol? x) + (str x) + + (char? x) + #?(:cljs (.charCodeAt x) + :clj (int x)) + + (uuid? x) + (str x) + + :else + x)) + +(defn mutate [form path] + (let [[head & rst] path] + (cond + (empty? path) + (if (coll? form) + (mutate-coll form) + (mutate-type form)) + + (map? form) + (if (empty? form) + (mutate-coll form) + (let [k (nth (keys form) (mod head (count (keys form))))] + (assoc form k + (mutate (get form k) rst)))) + + (vector? form) + (if (empty? form) + (mutate-coll form) + (let [idx (mod head (count form))] + (assoc form idx + (mutate (nth form idx) rst)))) + + (not (coll? form)) + (mutate-type form) + + :else + (mutate-coll form)))) + +(deftest test-assert2 + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"\"Key must be integer\"\n\nshould be one of: \"Extra input\", \"Insufficient input\", \"no method" + (binding [s/*explain-out* expound/printer] + (try + (s/check-asserts true) + (s/assert (s/nilable #{"Insufficient input" "Extra input" "no method"}) "Key must be integer") + (finally (s/check-asserts false))))))) + +(defn inline-specs [keyword] + (walk/postwalk + (fn [x] + (if (contains? (s/registry) x) + (s/form x) + x)) + (s/form keyword))) + +#?(:clj + (deftest real-spec-tests + (checking + "for any real-world spec and any data, explain-str returns a string" + ;; At 50, it might find a bug in failures for the + ;; :ring/handler spec, but keep it plugged in, since it + ;; takes a long time to shrink + (chuck/times num-tests) + [spec sg/spec-gen + form gen/any-printable] + ;; Can't reliably test fspecs until + ;; https://dev.clojure.org/jira/browse/CLJ-2258 is fixed + ;; because the algorithm to fix up the 'in' paths depends + ;; on the non-conforming value existing somewhere within + ;; the top-level form + (when-not + ;; a conformer generally won't work against any arbitrary value + ;; e.g. we can't conform 0 with the conformer 'seq' + (or (contains? #{:conformers-test/string-AB} spec) + (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str)))) + (is (string? (expound/expound-str spec form))))))) + +#?(:clj + (deftest assert-on-real-spec-tests + (checking + "for any real-world spec and any data, assert returns an error that matches explain-str" + (chuck/times num-tests) + [spec sg/spec-gen + form gen/any-printable] + ;; Can't reliably test fspecs until + ;; https://dev.clojure.org/jira/browse/CLJ-2258 is fixed + ;; because the algorithm to fix up the 'in' paths depends + ;; on the non-conforming value existing somewhere within + ;; the top-level form + (when-not (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str))) + (when-not (s/valid? spec form) + (let [expected-err-msg (str "Spec assertion failed\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? true})] + (s/explain-str spec form)))] + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + (re-pattern (java.util.regex.Pattern/quote expected-err-msg)) + (binding [s/*explain-out* expound/printer] + (try + (s/check-asserts true) + (s/assert spec form) + (finally + (s/check-asserts false))))) + (str "Expected: " expected-err-msg)))))))) + +(deftest test-mutate + (checking + "mutation alters data structure" + (chuck/times num-tests) + [form gen/any-printable + mutate-path (gen/vector gen/nat 1 10)] + (is (not= form + (mutate form mutate-path))))) + +#?(:clj + 1 + #_(deftest real-spec-tests-mutated-valid-value + ;; FIXME - we need to use generate mutated value, instead + ;; of adding randomness to test + #_(checking + "for any real-world spec and any mutated valid data, explain-str returns a string" + (chuck/times num-tests) + [spec sg/spec-gen + mutate-path (gen/vector gen/pos-int)] + (when-not (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str))) + (when (contains? (s/registry) spec) + (try + (let [valid-form (first (s/exercise spec 1)) + invalid-form (mutate valid-form mutate-path)] + (is (string? (expound/expound-str spec invalid-form)))) + (catch clojure.lang.ExceptionInfo e + (when (not= :no-gen (::s/failure (ex-data e))) + (when (not= "Couldn't satisfy such-that predicate after 100 tries." (.getMessage e)) + (throw e)))))))))) + +;; Using conformers for transformation should not crash by default, or at least give useful error message. +(defn numberify [s] + (cond + (number? s) s + (re-matches #"^\d+$" s) #?(:cljs (js/parseInt s 10) + :clj (Integer. s)) + :else ::s/invalid)) + +(s/def :conformers-test/number (s/conformer numberify)) + +(defn conform-by + [tl-key payload-key] + (s/conformer (fn [m] + (let [id (get m tl-key)] + (if (and id (map? (get m payload-key))) + (assoc-in m [payload-key tl-key] id) + ::s/invalid))))) + +(s/def :conformers-test.query/id qualified-keyword?) + +(defmulti query-params :conformers-test.query/id) +(s/def :conformers-test.query/params (s/multi-spec query-params :conformers-test.query/id)) +(s/def :user/id string?) + +(defmethod query-params :conformers-test/lookup-user [_] + (s/keys :req [:user/id])) + +(s/def :conformers-test/query + (s/and + (conform-by :conformers-test.query/id :conformers-test.query/params) + (s/keys :req [:conformers-test.query/id + :conformers-test.query/params]))) + +(s/def :conformers-test/string-AB-seq (s/cat :a #{\A} :b #{\B})) + +(s/def :conformers-test/string-AB + (s/and + ;; conform as sequence (seq function) + (s/conformer #(if (seqable? %) (seq %) %)) + ;; re-use previous sequence spec + :conformers-test/string-AB-seq)) + +(defn parse-csv [s] + (map string/upper-case (string/split s #","))) + +(deftest conformers-test + ;; Example from http://cjohansen.no/a-unified-specification/ + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false}) + *print-namespace-maps* false] + (testing "conform string to int" + (is (string? + (s/explain-str :conformers-test/number "123a")))) + ;; Example from https://github.com/bhb/expound/issues/15#issuecomment-326838879 + (testing "conform maps" + (is (string? (s/explain-str :conformers-test/query {}))) + (is (= "-- Spec failed -------------------- + +Part of the value + + {:conformers-test.query/id :conformers-test/lookup-user, :conformers-test.query/params {}} + +when conformed as + + {:conformers-test.query/id :conformers-test/lookup-user} + +should contain key: :user/id + +| key | spec | +|==========+=========| +| :user/id | string? | + +------------------------- +Detected 1 error\n" + (s/explain-str :conformers-test/query {:conformers-test.query/id :conformers-test/lookup-user + :conformers-test.query/params {}})))) + ;; Minified example based on https://github.com/bhb/expound/issues/15 + ;; This doesn't look ideal, but really, it's not a good idea to use spec + ;; for string parsing, so I'm OK with it + (testing "conform string to seq" + (is (= + ;; clojurescript doesn't have a character type + #?(:cljs "-- Spec failed --------------------\n\n \"A\"C\"\"\n ^^^\n\nshould be: \"B\"\n\n-------------------------\nDetected 1 error\n" + :clj "-- Spec failed -------------------- + + \"A\\C\" + ^^ + +should be: \\B + +------------------------- +Detected 1 error +") + (s/explain-str :conformers-test/string-AB "AC")))) + (testing "s/cat" + (s/def :conformers-test/sorted-pair (s/and (s/cat :x int? :y int?) #(< (-> % :x) (-> % :y)))) + (is (= (pf "-- Spec failed -------------------- + + [1 0] + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error +" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str :conformers-test/sorted-pair [1 0] {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + [... [1 0]] + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str (s/coll-of :conformers-test/sorted-pair) [[0 1] [1 0]] {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + {:a [1 0]} + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str (s/map-of keyword? :conformers-test/sorted-pair) {:a [1 0]} {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + [... \"a\"] + ^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n") + (expound/expound-str :conformers-test/sorted-pair [1 "a"] {:print-specs? false})))) + (testing "conformers that modify path of values" + (s/def :conformers-test/vals (s/coll-of (s/and string? + #(re-matches #"[A-G]+" %)))) + (s/def :conformers-test/csv (s/and string? + (s/conformer parse-csv) + :conformers-test/vals)) + (is (= "-- Spec failed -------------------- + +Part of the value + + \"abc,def,ghi\" + +when conformed as + + \"GHI\" + +should satisfy + + (fn [%] (re-matches #\"[A-G]+\" %)) + +------------------------- +Detected 1 error\n" + (expound/expound-str :conformers-test/csv "abc,def,ghi" {:print-specs? false})))) + + ;; this is NOT recommended! + ;; so I'm not inclined to make this much nicer than + ;; the default spec output + (s/def :conformers-test/coerced-kw (s/and (s/conformer #(if (string? %) + (keyword %) + ::s/invalid)) + keyword?)) + (testing "coercion" + (is (= (pf "-- Spec failed -------------------- + + nil + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/coerced-kw nil)))) + + (is (= (pf "-- Spec failed -------------------- + + [... ... ... 0] + ^ + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/coll-of :conformers-test/coerced-kw) ["a" "b" "c" 0]))))) + ;; Also not recommended + (s/def :conformers-test/str-kw? (s/and (s/conformer #(if (string? %) + (keyword %) + ::s/invalid) + name) keyword?)) + (testing "coercion with unformer" + (is (= (pf "-- Spec failed -------------------- + + nil + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/coerced-kw nil)))) + + (is (= (pf "-- Spec failed -------------------- + + [... ... ... 0] + ^ + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/coll-of :conformers-test/coerced-kw) ["a" "b" "c" 0]))))) + + (s/def :conformers-test/name string?) + (s/def :conformers-test/age pos-int?) + (s/def :conformers-test/person (s/keys* :req-un [:conformers-test/name + :conformers-test/age])) + ;; FIXME: Implementation could be simpler once + ;; https://dev.clojure.org/jira/browse/CLJ-2406 is fixed + (testing "spec defined with keys*" + (is (= "-- Spec failed -------------------- + + [... ... ... :Stan] + ^^^^^ + +should satisfy + + string? + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/person [:age 30 :name :Stan]))))) + + (testing "spec defined with keys* and copies of bad value elsewhere in the data" + (is (= "-- Spec failed -------------------- + +Part of the value + + [:Stan [:age 30 :name :Stan]] + +when conformed as + + :Stan + +should satisfy + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/tuple + keyword? + :conformers-test/person) [:Stan [:age 30 :name :Stan]]))))) + + (testing "ambiguous value" + (is (= (pf "-- Spec failed -------------------- + + {[0 1] ..., [1 0] ...} + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error +" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/map-of :conformers-test/sorted-pair any?) {[0 1] [1 0] + [1 0] [1 0]}))))))) + +(s/def :duplicate-preds/str-or-str (s/or + ;; Use anonymous functions to assure + ;; non-equality + :str1 #(string? %) + :str2 #(string? %))) +(deftest duplicate-preds + (testing "duplicate preds only appear once" + (is (= (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + (fn [%%] (string? %%)) + +-- Relevant specs ------- + +:duplicate-preds/str-or-str: + (pf.spec.alpha/or + :str1 + (pf.core/fn [%%] (pf.core/string? %%)) + :str2 + (pf.core/fn [%%] (pf.core/string? %%))) + +------------------------- +Detected 1 error +") + (expound/expound-str :duplicate-preds/str-or-str 1))))) + +(s/def :fspec-test/div (s/fspec + :args (s/cat :x int? :y pos-int?))) + +(defn my-div [x y] + (assert (not (zero? (/ x y))))) + +(defn until-unsuccessful [f] + (let [nil-or-failure #(if (= "Success! +" %) + nil + %)] + (or (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f))))) + +(deftest fspec-exception-test + (testing "args that throw exception" + (is (= (pf "-- Exception ---------------------- + + expound.alpha-test/my-div + +threw exception + + \"Assert failed: (not (zero? (/ x y)))\" + +with args: + + 0, 1 + +-- Relevant specs ------- + +:fspec-test/div: + (pf.spec.alpha/fspec + :args + (pf.spec.alpha/cat :x pf.core/int? :y pf.core/pos-int?) + :ret + pf.core/any? + :fn + nil) + +------------------------- +Detected 1 error\n") + + ;; + (until-unsuccessful #(expound/expound-str :fspec-test/div my-div)))) + + (is (= (pf "-- Exception ---------------------- + + [expound.alpha-test/my-div] + ^^^^^^^^^^^^^^^^^^^^^^^^^ + +threw exception + + \"Assert failed: (not (zero? (/ x y)))\" + +with args: + + 0, 1 + +-- Relevant specs ------- + +:fspec-test/div: + (pf.spec.alpha/fspec + :args + (pf.spec.alpha/cat :x pf.core/int? :y pf.core/pos-int?) + :ret + pf.core/any? + :fn + nil) + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str (s/coll-of :fspec-test/div) [my-div])))))) + +(s/def :fspec-ret-test/my-int pos-int?) +(s/def :fspec-ret-test/plus (s/fspec + :args (s/cat :x int? :y pos-int?) + :ret :fspec-ret-test/my-int)) + +(defn my-plus [x y] + (+ x y)) + +(deftest fspec-ret-test + (testing "invalid ret" + (is (= (pf "-- Function spec failed ----------- + + expound.alpha-test/my-plus + +returned an invalid value + + 0 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str :fspec-ret-test/plus my-plus {:print-specs? false})))) + + (is (= (pf "-- Function spec failed ----------- + + [expound.alpha-test/my-plus] + ^^^^^^^^^^^^^^^^^^^^^^^^^^ + +returned an invalid value + + 0 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str (s/coll-of :fspec-ret-test/plus) [my-plus] {:print-specs? false})))) + (s/def :fspec-ret-test/return-map (s/fspec + :args (s/cat) + :ret (s/keys :req-un [:fspec-ret-test/my-int]))) + (is (= (pf "-- Function spec failed ----------- + + + +returned an invalid value + + {} + +should contain key: :my-int + +| key | spec | +|=========+==========| +| :my-int | pos-int? | + +------------------------- +Detected 1 error +") + (until-unsuccessful #(expound/expound-str :fspec-ret-test/return-map + (fn [] {}) + {:print-specs? false})))))) + +(s/def :fspec-fn-test/minus (s/fspec + :args (s/cat :x int? :y int?) + :fn (s/and + #(< (:ret %) (-> % :args :x)) + #(< (:ret %) (-> % :args :y))))) + +(defn my-minus [x y] + (- x y)) + +(deftest fspec-fn-test + (testing "invalid ret" + (is (= (pf "-- Function spec failed ----------- + + expound.alpha-test/my-minus + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + + #?(:clj + "(fn + [%] + (< (:ret %) (-> % :args :x)))" + :cljs "(fn [%] (< (:ret %) (-> % :args :x)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str :fspec-fn-test/minus my-minus))))) + + (is (= (pf "-- Function spec failed ----------- + + [expound.alpha-test/my-minus] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:clj + "(fn + [%] + (< (:ret %) (-> % :args :x)))" + :cljs "(fn [%] (< (:ret %) (-> % :args :x)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of :fspec-fn-test/minus) [my-minus]))))))) + +(deftest ifn-fspec-test + (testing "keyword ifn / ret failure" + (is (= "-- Function spec failed ----------- + + [:foo] + ^^^^ + +returned an invalid value + + nil + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [:foo]))))) + (testing "set ifn / ret failure" + (is (= "-- Function spec failed ----------- + + [#{}] + ^^^ + +returned an invalid value + + nil + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [#{}]))))))) + #?(:clj + (testing "vector ifn / exception failure" + (is (= "-- Exception ---------------------- + + [[]] + ^^ + +threw exception + + nil + +with args: + + 0 + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [[]])))))))) + +#?(:clj + (deftest form-containing-incomparables + (checking + "for any value including NaN, or Infinity, expound returns a string" + (chuck/times num-tests) + [form (gen/frequency + [[1 (gen/elements + [Double/NaN + Double/POSITIVE_INFINITY + Double/NEGATIVE_INFINITY + '(Double/NaN Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY) + [Double/NaN Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY] + {Double/NaN Double/NaN + Double/POSITIVE_INFINITY Double/POSITIVE_INFINITY + Double/NEGATIVE_INFINITY Double/NEGATIVE_INFINITY}])] + [5 gen/any-printable]])] + (is (string? (expound/expound-str (constantly false) form)))))) + +#?(:cljs + (deftest form-containing-incomparables + (checking + "for any value including NaN, or Infinity, expound returns a string" + (chuck/times num-tests) + [form (gen/frequency + [[1 (gen/elements + [js/NaN + js/Infinity + js/-Infinity + '(js/NaN js/Infinity js/-Infinity) + [js/NaN js/Infinity js/-Infinity] + {js/NaN js/NaN + js/Infinity js/Infinity + js/-Infinity js/-Infinity}])] + [5 gen/any-printable]])] + (is (string? (expound/expound-str (constantly false) form)))))) + +(defmulti pet :pet/type) +(defmethod pet :dog [_] + (s/keys)) +(defmethod pet :cat [_] + (s/keys)) + +(defmulti animal :animal/type) +(defmethod animal :dog [_] + (s/keys)) +(defmethod animal :cat [_] + (s/keys)) + +(s/def :multispec-in-compound-spec/pet1 (s/and + map? + (s/multi-spec pet :pet/type))) + +(s/def :multispec-in-compound-spec/pet2 (s/or + :map1 (s/multi-spec pet :pet/type) + :map2 (s/multi-spec animal :animal/type))) + +(deftest multispec-in-compound-spec + (testing "multispec combined with s/and" + (is (= (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:pet/type :fish} + +with + + Spec multimethod: `expound.alpha-test/pet` + Dispatch value: `:fish` + +-- Relevant specs ------- + +:multispec-in-compound-spec/pet1: + (pf.spec.alpha/and + pf.core/map? + (pf.spec.alpha/multi-spec expound.alpha-test/pet :pet/type)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multispec-in-compound-spec/pet1 {:pet/type :fish})))) + ;; FIXME - improve this, maybe something like: + ;;;;;;;;;;;;;;;;;;; + + ;; {:pet/type :fish} + + ;; should be described by a spec multimethod, but + + ;; expound.alpha-test/pet + + ;; is missing a method for value + + ;; (:pet/type {:pet/type :fish}) ; => :fish + + ;; or + + ;; should be described by a spec multimethod, but + + ;; expound.alpha-test/pet + + ;; is missing a method for value + + ;; (:animal/type {:pet/type :fish}) ; => nil + (testing "multispec combined with s/or" + (is (= (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:pet/type :fish} + +with + + Spec multimethod: `expound.alpha-test/pet` + Dispatch value: `:fish` + +or with + + Spec multimethod: `expound.alpha-test/animal` + Dispatch value: `nil` + +-- Relevant specs ------- + +:multispec-in-compound-spec/pet2: + (pf.spec.alpha/or + :map1 + (pf.spec.alpha/multi-spec expound.alpha-test/pet :pet/type) + :map2 + (pf.spec.alpha/multi-spec expound.alpha-test/animal :animal/type)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multispec-in-compound-spec/pet2 {:pet/type :fish}))))) + +(expound/def :predicate-messages/string string? "should be a string") +(expound/def :predicate-messages/vector vector? "should be a vector") + +(deftest predicate-messages + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (testing "predicate with error message" + (is (= "-- Spec failed -------------------- + + :hello + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str :predicate-messages/string :hello)))) + (testing "predicate within a collection" + (is (= "-- Spec failed -------------------- + + [... :foo] + ^^^^ + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str (s/coll-of :predicate-messages/string) ["" :foo])))) + (testing "two predicates with error messages" + (is (= "-- Spec failed -------------------- + + 1 + +should be a string + +or + +should be a vector + +------------------------- +Detected 1 error +" + (s/explain-str (s/or :s :predicate-messages/string + :v :predicate-messages/vector) 1)))) + (testing "one predicate with error message, one without" + (is (= "-- Spec failed -------------------- + + foo + +should satisfy + + pos-int? + +or + + vector? + +or + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str (s/or :p pos-int? + :s :predicate-messages/string + :v vector?) 'foo)))) + (testing "compound predicates" + (let [email-regex #"^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,63}$"] + (expound/def :predicate-messages/email (s/and string? #(re-matches email-regex %)) "should be a valid email address") + (is (= "-- Spec failed -------------------- + + \"sally@\" + +should be a valid email address + +------------------------- +Detected 1 error +" + (s/explain-str + :predicate-messages/email + "sally@")))) + (expound/def :predicate-messages/score (s/int-in 0 100) "should be between 0 and 100") + (is (= "-- Spec failed -------------------- + + 101 + +should be between 0 and 100 + +------------------------- +Detected 1 error +" + (s/explain-str + :predicate-messages/score + 101)))))) + +(s/fdef results-str-fn1 + :args (s/cat :x nat-int? :y nat-int?) + :ret pos?) +(defn results-str-fn1 [x y] + #?(:clj (+' x y) + :cljs (+ x y))) + +(s/fdef results-str-fn2 + :args (s/cat :x nat-int? :y nat-int?) + :fn #(let [x (-> % :args :x) + ret (-> % :ret)] + (< x ret))) +(defn results-str-fn2 [x y] + (+ x y)) + +(s/fdef results-str-fn3 + :args (s/cat :x #{0} :y #{0}) + :ret nat-int?) +(defn results-str-fn3 [x y] + (+ x y)) + +(s/fdef results-str-fn4 + :args (s/cat :x int?) + :ret (s/coll-of int?)) +(defn results-str-fn4 [x] + [x :not-int]) + +(s/fdef results-str-fn5 + :args (s/cat :x #{1} :y #{1}) + :ret string?) +(defn results-str-fn5 + [_x _y] + #?(:clj (throw (Exception. "Ooop!")) + :cljs (throw (js/Error. "Oops!")))) + +(s/fdef results-str-fn6 + :args (s/cat :f fn?) + :ret any?) +(defn results-str-fn6 + [f] + (f 1)) + +(s/def :results-str-fn7/k string?) +(s/fdef results-str-fn7 + :args (s/cat :m (s/keys)) + :ret (s/keys :req-un [:results-str-fn7/k])) +(defn results-str-fn7 + [m] + m) + +(s/fdef results-str-missing-fn + :args (s/cat :x int?)) + +(s/fdef results-str-missing-args-spec + :ret int?) +(defn results-str-missing-args-spec [] 1) + +(deftest explain-results + (testing "explaining results with non-expound printer" + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"Cannot print check results" + (binding [s/*explain-out* s/explain-printer] + (expound/explain-results-str (st/check `results-str-fn1)))))) + + (testing "single bad result (failing return spec)" + (is (= (pf + "== Checked expound.alpha-test/results-str-fn1 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn1 0 0) + +returned an invalid value. + + 0 + +should satisfy + + pos? + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn1)))))) + (is (= (pf + "== Checked expound.alpha-test/results-str-fn7 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn7 {}) + +returned an invalid value. + + {} + +should contain key: :k + +| key | spec | +|=====+=========| +| :k | string? | + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn7))))))) + (testing "single bad result (failing fn spec)" + (is (= (pf "== Checked expound.alpha-test/results-str-fn2 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn2 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%%] + (let + [x (-> %% :args :x) ret (-> %% :ret)] + (< x ret))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn2))))))) + (testing "single valid result" + (is (= "== Checked expound.alpha-test/results-str-fn3 + +Success! +" + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-fn3)))))) + #?(:clj + (testing "multiple results" + (is (= "== Checked expound.alpha-test/results-str-fn2 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn2 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%] + (let + [x (-> % :args :x) ret (-> % :ret)] + (< x ret))) + +------------------------- +Detected 1 error + + +== Checked expound.alpha-test/results-str-fn3 + +Success! +" + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check [`results-str-fn2 `results-str-fn3])))))))) + + (testing "check-fn" + (is (= "== Checked ======================== + +-- Function spec failed ----------- + + ( 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%] + (let + [x (-> % :args :x) ret (-> % :ret)] + (< x ret))) + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* expound/printer] + (expound/explain-result-str (st/check-fn `results-str-fn1 (s/spec `results-str-fn2))))))) + #?(:clj (testing "custom printer" + (is (= "== Checked expound.alpha-test/results-str-fn4 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn4 0) + +returned an invalid value. + + [0 :not-int] + ^^^^^^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* (expound/custom-printer {:show-valid-values? true})] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn4)))))))) + (testing "exceptions raised during check" + (is (= "== Checked expound.alpha-test/results-str-fn5 + + (expound.alpha-test/results-str-fn5 1 1) + + threw error" + (binding [s/*explain-out* expound/printer] + (take-lines 5 (expound/explain-results-str (st/check `results-str-fn5))))))) + (testing "colorized output" + (is (= (pf "== Checked expound.alpha-test/results-str-fn5 + + (expound.alpha-test/results-str-fn5 1 1) + + threw error") + (binding [s/*explain-out* (expound/custom-printer {:theme :figwheel-theme})] + (readable-ansi (take-lines 5 (expound/explain-results-str (st/check `results-str-fn5)))))))) + + (testing "failure to generate" + (is (= + #?(:clj "== Checked expound.alpha-test/results-str-fn6 + +Unable to construct generator for [:f] in + + (clojure.spec.alpha/cat :f clojure.core/fn?) +" + ;; CLJS doesn't contain correct data for check failure + + :cljs "== Checked expound.alpha-test/results-str-fn6 + +Unable to construct gen at: [:f] for: fn? in + + (cljs.spec.alpha/cat :f cljs.core/fn?) +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-fn6)))))) + (testing "no-fn failure" + (is (= #?(:clj "== Checked expound.alpha-test/results-str-missing-fn + +Failed to check function. + + expound.alpha-test/results-str-missing-fn + +is not defined +" + :cljs "== Checked ======================== + +Failed to check function. + + + +is not defined +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-missing-fn)))))) + (testing "no args spec" + (is (= (pf "== Checked expound.alpha-test/results-str-missing-args-spec + +Failed to check function. + + (pf.spec.alpha/fspec :ret pf.core/int?) + +should contain an :args spec +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/with-instrument-disabled (st/check `results-str-missing-args-spec)))))))) + +#?(:clj (deftest explain-results-gen + (checking + "all functions can be checked and printed" + (chuck/times num-tests) + [sym-to-check (gen/elements (remove + ;; these functions print to stdout, but return + ;; nothing + #{`expound/explain-results + `expound/explain-result + `expound/expound + `expound/printer} + (st/checkable-syms)))] + ;; Just confirm an error is not thrown + (is (string? + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str + (st/with-instrument-disabled + (st/check sym-to-check + {:clojure.spec.test.check/opts {:num-tests 10}}))))) + (str "Failed to check " sym-to-check))))) + +(s/def :colorized-output/strings (s/coll-of string?)) +(deftest colorized-output + (is (= (pf "-- Spec failed -------------------- + + [... :a ...] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:colorized-output/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :none}))) + (is (= (pf "-- Spec failed -------------------- + + [... :a ...] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:colorized-output/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (readable-ansi (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :figwheel-theme}))))) + +(s/def ::spec-name (s/with-gen + qualified-keyword? + #(gen/let [kw gen/keyword] + (keyword (str "expound-generated-spec/" (name kw)))))) + +(s/def ::fn-spec (s/with-gen + (s/or + :sym symbol? + :anon (s/cat :fn #{`fn `fn*} + :args-list (s/coll-of any? :kind vector?) + :body (s/* any?)) + :form (s/cat :comp #{`comp `partial} + :args (s/+ any?))) + #(gen/return `any?))) + +(s/def ::pred-spec + (s/with-gen + ::fn-spec + #(gen/elements + [`any? + `boolean? + `bytes? + `double? + `ident? + `indexed? + `int? + `keyword? + `map? + `nat-int? + `neg-int? + `pos-int? + `qualified-ident? + `qualified-keyword? + `qualified-symbol? + `seqable? + `simple-ident? + `simple-keyword? + `simple-symbol? + `string? + `symbol? + `uri? + `uuid? + `vector?]))) + +(s/def ::and-spec (s/cat + :and #{`s/and} + :branches (s/+ + ::spec))) + +(s/def ::or-spec (s/cat + :or #{`s/or} + :branches (s/+ + (s/cat + :kw keyword? + :spec ::spec)))) + +(s/def ::set-spec (s/with-gen + (s/coll-of + any? + :kind set? + :min-count 1) + #(s/gen (s/coll-of + (s/or + :s string? + :i int? + :b boolean? + :k keyword?) + :kind set?)))) + +(s/def ::spec (s/or + :amp ::amp-spec + :alt ::alt-spec + :and ::and-spec + :cat ::cat-spec + :coll ::coll-spec + :defined-spec ::spec-name + :every ::every-spec + :fspec ::fspec-spec + :keys ::keys-spec + :map ::map-of-spec + :merge ::merge-spec + :multi ::multispec-spec + :nilable ::nilable-spec + :or ::or-spec + :regex-unary ::regex-unary-spec + :set ::set-spec + :simple ::pred-spec + :spec-wrapper (s/cat :wrapper #{`s/spec} :spec ::spec) + :conformer (s/cat + :conformer #{`s/conformer} + :f ::fn-spec + :unf ::fn-spec) + :with-gen (s/cat + :with-gen #{`s/with-gen} + :spec ::spec + :f ::fn-spec) + :tuple-spec ::tuple-spec)) + +(s/def ::every-opts (s/* + (s/alt + :kind (s/cat + :k #{:kind} + :v #{nil + vector? set? map? list? + `vector? `set? `map? `list?}) + :count (s/cat + :k #{:count} + :v (s/nilable nat-int?)) + :min-count (s/cat + :k #{:min-count} + :v (s/nilable nat-int?)) + :max-count (s/cat + :k #{:max-count} + :v (s/nilable nat-int?)) + :distinct (s/cat + :k #{:distinct} + :v (s/nilable boolean?)) + :into (s/cat + :k #{:into} + :v (s/or :coll #{[] {} #{}} + :list #{'()})) + :gen-max (s/cat + :k #{:gen-max} + :v nat-int?)))) + +(s/def ::every-spec (s/cat + :every #{`s/every} + :spec ::spec + :opts ::every-opts)) + +(s/def ::coll-spec (s/cat + :coll-of #{`s/coll-of} + :spec (s/spec ::spec) + :opts ::every-opts)) + +(s/def ::map-of-spec (s/cat + :map-of #{`s/map-of} + :k ::spec + :w ::spec + :opts ::every-opts)) + +(s/def ::nilable-spec (s/cat + :nilable #{`s/nilable} + :spec ::spec)) + +(s/def ::name-combo + (s/or + :one ::spec-name + :combo (s/cat + :operator #{'and 'or} + :operands + (s/+ + ::name-combo)))) + +(s/def ::keys-spec (s/cat + :keys #{`s/keys `s/keys*} + + :reqs (s/* + (s/cat + :op #{:req :req-un} + :names (s/coll-of + ::name-combo + :kind vector?))) + :opts (s/* + (s/cat + :op #{:opt :opt-un} + :names (s/coll-of + ::spec-name + :kind vector?))))) + +(s/def ::amp-spec + (s/cat :op #{`s/&} + :spec ::spec + :preds (s/* + (s/with-gen + (s/or :pred ::pred-spec + :defined ::spec-name) + #(gen/return `any?))))) + +(s/def ::alt-spec + (s/cat :op #{`s/alt} + :key-pred-forms (s/+ + (s/cat + :key keyword? + :pred (s/spec ::spec))))) + +(s/def ::regex-unary-spec + (s/cat :op #{`s/+ `s/* `s/?} :pred (s/spec ::spec))) + +(s/def ::cat-pred-spec + (s/or + :spec (s/spec ::spec) + :regex-unary ::regex-unary-spec + :amp ::amp-spec + :alt ::alt-spec)) + +(defmulti fake-multimethod :fake-tag) + +(s/def ::multispec-spec + (s/cat + :mult-spec #{`s/multi-spec} + :mm (s/with-gen + symbol? + #(gen/return `fake-multimethod)) + :tag (s/with-gen + (s/or :sym symbol? + :k keyword?) + #(gen/return :fake-tag)))) + +(s/def ::cat-spec (s/cat + :cat #{`s/cat} + :key-pred-forms + (s/* + (s/cat + :key keyword? + :pred ::cat-pred-spec)))) + +(s/def ::fspec-spec (s/cat + :cat #{`s/fspec} + :args (s/cat + :args #{:args} + :spec ::spec) + :ret (s/? + (s/cat + :ret #{:ret} + :spec ::spec)) + :fn (s/? + (s/cat + :fn #{:fn} + :spec (s/nilable ::spec))))) + +(s/def ::tuple-spec (s/cat + :tuple #{`s/tuple} + :preds (s/+ + ::spec))) + +(s/def ::merge-spec (s/cat + :merge #{`s/merge} + :pred-forms (s/* ::spec))) + +(s/def ::spec-def (s/cat + :def #{`s/def} + :name ::spec-name + :spec (s/spec ::spec))) + +#?(:clj (s/def ::spec-defs (s/coll-of ::spec-def + :min-count 1 + :gen-max 3))) + +(defn exercise-count [spec] + (case spec + (::spec-def ::fspec-spec ::regex-unary-spec ::spec-defs ::alt-spec) 1 + + (::cat-spec ::merge-spec ::and-spec ::every-spec ::spec ::coll-spec ::map-of-spec ::or-spec ::tuple-spec ::keys-spec) 2 + + 4)) + +(deftest spec-specs-can-generate + (doseq [spec-spec (filter keyword? (sg/topo-sort (filter #(= "expound.alpha-test" (namespace %)) + (keys (s/registry)))))] + (is + (doall (s/exercise spec-spec (exercise-count spec-spec))) + (str "Failed to generate examples for spec " spec-spec)))) + +#_(defn sample-seq + "Return a sequence of realized values from `generator`." + [generator seed] + (s/assert some? generator) + (let [max-size 1 + r (if seed + (random/make-random seed) + (random/make-random)) + size-seq (gen/make-size-range-seq max-size)] + (map #(rose/root (gen/call-gen generator %1 %2)) + (gen/lazy-random-states r) + size-seq))) + +#_(defn missing-specs [spec-defs] + (let [defined (set (map second spec-defs)) + used (set + (filter + #(and (qualified-keyword? %) + (= "expound-generated-spec" (namespace %))) + (tree-seq coll? seq spec-defs)))] + (set/difference used defined))) + +#?(:clj 1 #_(deftest eval-gen-test + ;; FIXME - this is a useful test but not 100% reliable yet + ;; so I'm disabling to get this PR in + (binding [s/*recursion-limit* 2] + (checking + "expound returns string" + 5 ;; Hard-code at 5, since generating specs explodes in size quite quickly + [spec-defs (s/gen ::spec-defs) + pred-specs (gen/vector (s/gen ::pred-spec) 5) + seed (s/gen pos-int?) + mutate-path (gen/vector gen/pos-int)] + (try + (doseq [[spec-name spec] (map vector (missing-specs spec-defs) (cycle pred-specs))] + (eval `(s/def ~spec-name ~spec))) + (doseq [spec-def spec-defs] + (eval spec-def)) + + (let [spec (second (last spec-defs)) + form (last (last spec-defs)) + disallowed #{"clojure.spec.alpha/fspec" + "clojure.spec.alpha/multi-spec" + "clojure.spec.alpha/with-gen"}] + (when-not (or (some + disallowed + (map str (tree-seq coll? identity form))) + (some + disallowed + (->> spec + inline-specs + (tree-seq coll? identity) + (map str)))) + (let [valid-form (first (sample-seq (s/gen spec) seed)) + invalid-form (mutate valid-form mutate-path)] + (try + (is (string? + (expound/expound-str spec invalid-form))) + (is (not + (string/includes? + (expound/expound-str (second (last spec-defs)) invalid-form) + "should contain keys"))) + (catch Exception e + (is (or + (string/includes? + (:cause (Throwable->map e)) + "Method code too large!") + (string/includes? + (:cause (Throwable->map e)) + "Cannot convert path.")))))))) + (finally + ;; Get access to private atom in clojure.spec + (def spec-reg (deref #'s/registry-ref)) + (doseq [k (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))] + (swap! spec-reg dissoc k)))))))) + +(deftest clean-registry + (testing "only base spec remains" + (is (<= (count (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))) + 1) + (str "Found leftover specs: " (vec (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))))))) + +(deftest valid-spec-spec + (checking + "spec for specs validates against real specs" + (chuck/times num-tests) + [sp (gen/elements + (sg/topo-sort + (remove + (fn [k] + (string/includes? (pr-str (s/form (s/get-spec k))) "clojure.core.specs.alpha/quotable")) + (filter + (fn [k] (or + (string/starts-with? (namespace k) "clojure") + (string/starts-with? (namespace k) "expound") + (string/starts-with? (namespace k) "onyx") + (string/starts-with? (namespace k) "ring"))) + (keys (s/registry))))))] + (is (s/valid? ::spec (s/form (s/get-spec sp))) + (str + "Spec name: " sp "\n" + "Error: " + (binding [s/*explain-out* (expound/custom-printer {:show-valid-values? true + :print-specs? false + :theme :figwheel-theme})] + (s/explain-str ::spec (s/form (s/get-spec sp)))))))) + +(defmethod expound/problem-group-str ::test-problem1 [_type _spec-name _val _path _problems _opts] + "fake-problem-group-str") + +(defmethod expound/problem-group-str ::test-problem2 [type spec-name val path problems opts] + (str "fake-problem-group-str\n" + (expound/expected-str type spec-name val path problems opts))) + +(defmethod expound/expected-str ::test-problem2 [_type _spec-name _val _path _problems _opts] + "fake-expected-str") + +(deftest extensibility-test + (testing "can overwrite entire message" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem1)] + + (is (= "fake-problem-group-str\n\n-------------------------\nDetected 1 error\n" + (printer-str {:print-specs? false} ed))))) + (testing "can overwrite 'expected' str" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem2)] + + (is (= "fake-problem-group-str\nfake-expected-str\n\n-------------------------\nDetected 1 error\n" + (printer-str {:print-specs? false} ed))))) + (testing "if type has no mm implemented, throw an error" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem3)] + + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"No method in multimethod" + (printer-str {:print-specs? false} ed)))))) + +#?(:clj (deftest macroexpansion-errors + (let [actual (formatted-exception {:print-specs? false} #(macroexpand '(clojure.core/let [a] 2)))] + (is (or + (= "Call to #'clojure.core/let did not conform to spec. +-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + actual) + (= "Call to clojure.core/let did not conform to spec. +-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + actual)))) + (let [ed (try + (macroexpand '(clojure.core/let [a] 2)) + (catch Exception e + (-> (Throwable->map e) :via last :data)))] + (is (= "-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + (with-out-str ((expound/custom-printer {:print-specs? false}) + + ed))))))) + +(deftest sorted-map-values + (is (= "-- Spec failed -------------------- + + {\"bar\" 1} + +should satisfy + + number? + +------------------------- +Detected 1 error\n" + (expound/expound-str + number? + (sorted-map "bar" 1)))) + (is (= "-- Spec failed -------------------- + + {:foo {\"bar\" 1}} + +should satisfy + + number? + +------------------------- +Detected 1 error\n" + (expound/expound-str + number? + {:foo (sorted-map "bar" + + 1)})))) + +(defn select-expound-info [spec value] + (->> (s/explain-data spec value) + (problems/annotate) + (:expound/problems) + (map #(select-keys % [:expound.spec.problem/type :expound/in])) + (set))) + +#?(:clj + (deftest or-includes-problems-for-each-branch + (let [p1 (select-expound-info :ring.sync/handler (fn handler [_req] {})) + p2 (select-expound-info :ring.async/handler (fn handler [_req] {})) + p3 (select-expound-info :ring.sync+async/handler (fn handler [_req] {})) + all-problems (select-expound-info :ring/handler (fn handler [_req] {}))] + + (is (set/subset? p1 all-problems) {:extra (set/difference p1 all-problems)}) + (is (set/subset? p2 all-problems) {:extra (set/difference p2 all-problems)}) + (is (set/subset? p3 all-problems) {:extra (set/difference p3 all-problems)}))) + :cljs + (set/index #{} [:x]) ; noop to keep clj-kondo happy + ) + +(deftest defmsg-test + (s/def :defmsg-test/id1 string?) + (expound/defmsg :defmsg-test/id1 "should be a string ID") + (testing "messages for predicate specs" + (is (= "-- Spec failed -------------------- + + 123 + +should be a string ID + +------------------------- +Detected 1 error\n" + (expound/expound-str + :defmsg-test/id1 + 123 + {:print-specs? false})))) + + (s/def :defmsg-test/id2 (s/and string? + #(<= 4 (count %)))) + (expound/defmsg :defmsg-test/id2 "should be a string ID of length 4 or more") + (testing "messages for 'and' specs" + (is (= "-- Spec failed -------------------- + + \"123\" + +should be a string ID of length 4 or more + +------------------------- +Detected 1 error\n" + (expound/expound-str + :defmsg-test/id2 + "123" + {:print-specs? false})))) + + (s/def :defmsg-test/statuses #{:ok :failed}) + (expound/defmsg :defmsg-test/statuses "should be either :ok or :failed") + (testing "messages for set specs" + (is (= "-- Spec failed -------------------- + + :oak + +should be either :ok or :failed + +------------------------- +Detected 1 error +" + (expound/expound-str + :defmsg-test/statuses + :oak + {:print-specs? false})))) + (testing "messages for alt specs" + (s/def ::x int?) + (s/def ::y int?) + (expound/defmsg ::x "must be an integer") + (is (= + "-- Spec failed -------------------- + + [\"\" ...] + ^^ + +must be an integer + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/alt :one + (s/cat :x ::x) + :two + (s/cat :x ::x + :y ::y)) + + ["" ""] + {:print-specs? false})))) + + (testing "messages for alt specs (if user duplicates existing message)" + (s/def ::x int?) + (s/def ::y int?) + (expound/defmsg ::x "should satisfy\n\n int?") + (is (= + "-- Spec failed -------------------- + + [\"\"] + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/alt :one + ::x + :two + ::y) + [""] + {:print-specs? false})))) + (testing "messages for alternatives and set specs" + (is (= "-- Spec failed -------------------- + + :oak + +should be either :ok or :failed + +or + +should satisfy + + string? + +------------------------- +Detected 1 error\n" + (expound/expound-str + (s/or + :num + :defmsg-test/statuses + :s string?) + :oak + {:print-specs? false}))))) + +(deftest printer + (st/instrument ['expound/printer]) + (binding [s/*explain-out* expound/printer] + (is (string? (s/explain-str int? "a"))) + (is (= "Success!\n" (s/explain-str int? 1))) + (is (= "Success!\n" (with-out-str (expound/printer (s/explain-data int? 1)))))) + (st/unstrument ['expound/printer])) + +(deftest undefined-key + (is (= "-- Spec failed -------------------- + + {} + +should contain key: :undefined-key/does-not-exist + +| key | spec | +|===============================+===============================| +| :undefined-key/does-not-exist | :undefined-key/does-not-exist | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/keys :req [:undefined-key/does-not-exist]) + {} + {:print-specs? false})))) + +#?(:clj + (deftype FakeDB [m] + + clojure.lang.Seqable + (seq [_] + (seq m)) + + clojure.lang.IPersistentCollection + + (count [_] + (count m)) + (cons [_ _o] + (throw (Exception. "FakeDB doesn't implement 'cons'"))) + (empty [_] + (FakeDB. {})) + (equiv [_ o] + (= + m + (:m o))) + + clojure.lang.Associative + (containsKey [_ k] (contains? m k)) + (entryAt [_ k] (get m k)) + + clojure.lang.IPersistentMap + (assoc [_this _k _v] (throw (Exception. "FakeDB doesn't implement 'assoc'"))) + (assocEx [_this _k _v] (throw (Exception. "FakeDB doesn't implement 'assocEx'"))) + (without [_this _k] (throw (Exception. "FakeDB doesn't implement 'without'"))) + + clojure.lang.ILookup + (valAt [_ k] + (get m k)) + (valAt [_ k not-found] + (get m k not-found)))) + +(s/def ::db-val (s/or :i int? :s string?)) + +;; https://github.com/bhb/expound/issues/205 +#?(:clj (deftest unwalkable-values + ;; run bin/test-datomic for real test of datomic DB, + ;; but this at least simulates the failure. We should not + ;; try to walk arbitrary values + (let [db (FakeDB. {:a 1})] + (is (= true (map? db))) + (is (= "Success!\n" + (expound/expound-str some? db))) + (is (= "-- Spec failed -------------------- + + [{:a 1}] + ^^^^^^ + +should contain key: :expound.alpha-test/db-val + +| key | spec | +|============================+=========================| +| :expound.alpha-test/db-val | (or :i int? :s string?) | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/cat :db (s/keys + :req [::db-val])) [db])))))) + +;; https://github.com/bhb/expound/issues/217 +(deftest small-values-for-print-length + (binding [*print-length* 5] + (is (= "-- Spec failed -------------------- + + 9 + + in + + (0 1 2 3 4 ...) + +should satisfy + + (fn [x] (< x 9)) + +------------------------- +Detected 1 error +" + (expound/expound-str + (clojure.spec.alpha/coll-of (fn [x] (< x 9))) + (range 10)))))) + +;; https://github.com/bhb/expound/issues/215 +(s/def :keys-within-operators.user/name string?) +(s/def :keys-within-operators.user/age pos-int?) + +(deftest keys-within-operators + + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :age, :keys-within-operators.user/name + +| key | spec | +|==================================+==========| +| :age | pos-int? | +|----------------------------------+----------| +| :keys-within-operators.user/name | string? | + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/and (s/keys :req [:keys-within-operators.user/name] + :req-un [:keys-within-operators.user/age]) + #(contains? % :foo)) {} {:print-specs? false}))) + + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :age, :foo, :keys-within-operators.user/name + +| key | spec | +|==================================+===================================================| +| :age | pos-int? | +|----------------------------------+---------------------------------------------------| +| :foo | | +|----------------------------------+---------------------------------------------------| +| :keys-within-operators.user/name | string? | + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/or :k1 (s/keys :req [:keys-within-operators.user/name] + :req-un [:keys-within-operators.user/age]) + :k2 #(contains? % :foo)) {} {:print-specs? false})))) diff --git a/test-resources/lib_tests/expound/paths_test.cljc b/test-resources/lib_tests/expound/paths_test.cljc new file mode 100644 index 00000000..e64a5136 --- /dev/null +++ b/test-resources/lib_tests/expound/paths_test.cljc @@ -0,0 +1,39 @@ +(ns expound.paths-test + (:require [clojure.test :as ct :refer [is deftest use-fixtures]] + [clojure.test.check.generators :as gen] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.paths :as paths] + [expound.test-utils :as test-utils] + [com.gfredericks.test.chuck :as chuck])) + +(def num-tests 100) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(deftest compare-paths-test + (checking + "path to a key comes before a path to a value" + 10 + [k gen/simple-type-printable] + (is (= -1 (paths/compare-paths [(paths/->KeyPathSegment k)] [k]))) + (is (= 1 (paths/compare-paths [k] [(paths/->KeyPathSegment k)]))))) + +(defn nth-value [form i] + (let [seq (remove map-entry? (tree-seq coll? seq form))] + (nth seq (mod i (count seq))))) + +(deftest paths-to-value-test + (checking + "value-in is inverse of paths-to-value" + (chuck/times num-tests) + [form test-utils/any-printable-wo-nan + i gen/nat + :let [x (nth-value form i) + paths (paths/paths-to-value form x [] [])]] + (is (seq paths)) + (doseq [path paths] + (is (= x + (paths/value-in form + path)))))) diff --git a/test-resources/lib_tests/expound/print_length_test.cljc b/test-resources/lib_tests/expound/print_length_test.cljc new file mode 100644 index 00000000..7c89fb58 --- /dev/null +++ b/test-resources/lib_tests/expound/print_length_test.cljc @@ -0,0 +1,23 @@ +(ns expound.print-length-test + (:require [clojure.test :as ct :refer [is deftest testing]] + [clojure.spec.alpha :as s] + [expound.alpha] + [clojure.string :as string])) + +(def the-value (range 10)) +;; Fails on the last element of the range +(def the-spec (s/coll-of #(< % 9))) +(def the-explanation (s/explain-data the-spec the-value)) + +(deftest print-length-test + (testing "Expound works even in face of a low `*print-length*` and `*print-level*`, without throwing exceptions. +See https://github.com/bhb/expound/issues/217" + (doseq [length [1 5 100 *print-length*] + level [1 5 100 *print-level*] + ;; Note that the `is` resides outside of the `binding`. Else test output itself can be affected. + :let [v (binding [*print-length* length + *print-level* level] + (with-out-str + (expound.alpha/printer the-explanation)))]] + ;; Don't make a particularly specific test assertion, since a limited print-length isn't necessarily realistic/usual: + (is (not (string/blank? v)))))) diff --git a/test-resources/lib_tests/expound/printer_test.cljc b/test-resources/lib_tests/expound/printer_test.cljc new file mode 100644 index 00000000..2ea1ccb0 --- /dev/null +++ b/test-resources/lib_tests/expound/printer_test.cljc @@ -0,0 +1,428 @@ +(ns expound.printer-test + (:require [clojure.spec.alpha :as s] + [clojure.test :as ct :refer [is deftest use-fixtures testing]] + [expound.printer :as printer] + [clojure.string :as string] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.test-utils :as test-utils :refer [contains-nan?]] + [expound.spec-gen :as sg] + [expound.problems :as problems])) + +(def num-tests 5) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(defn example-fn []) +(defn get-args [& args] args) + +(deftest pprint-fn + (is (= "string?" + (printer/pprint-fn (::s/spec (s/explain-data string? 1))))) + (is (= "expound.printer-test/example-fn" + (printer/pprint-fn example-fn))) + (is (= "" + (printer/pprint-fn #(inc (inc %))))) + (is (= "" + (printer/pprint-fn (constantly true)))) + (is (= "" + (printer/pprint-fn (comp vec str)))) + (is (= "expound.test-utils/instrument-all" + (printer/pprint-fn test-utils/instrument-all))) + (is (= "expound.test-utils/contains-nan?" + (printer/pprint-fn contains-nan?)))) + +(s/def :print-spec-keys/field1 string?) +(s/def :print-spec-keys/field2 (s/coll-of :print-spec-keys/field1)) +(s/def :print-spec-keys/field3 int?) +(s/def :print-spec-keys/field4 string?) +(s/def :print-spec-keys/field5 string?) +(s/def :print-spec-keys/key-spec (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2])) +(s/def :print-spec-keys/key-spec2 (s/keys + :req-un [(and + :print-spec-keys/field1 + (or + :print-spec-keys/field2 + :print-spec-keys/field3))])) +(s/def :print-spec-keys/key-spec3 (s/keys + :req-un [:print-spec-keys/field1 + :print-spec-keys/field4 + :print-spec-keys/field5])) +(s/def :print-spec-keys/set-spec (s/coll-of :print-spec-keys/field1 + :kind set?)) +(s/def :print-spec-keys/vector-spec (s/coll-of :print-spec-keys/field1 + :kind vector?)) +(s/def :print-spec-keys/key-spec4 (s/keys + :req-un [:print-spec-keys/set-spec + :print-spec-keys/vector-spec + :print-spec-keys/key-spec3])) + +(defn copy-key [m k1 k2] + (assoc m k2 (get m k1))) + +(deftest print-spec-keys* + (is (= + [{"key" :field2, "spec" "(coll-of :print-spec-keys/field1)"} + {"key" :print-spec-keys/field1, "spec" "string?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec + {})))))) + (is (nil? + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2]) + {})))))) + + (is (= + [{"key" :print-spec-keys/field1, "spec" "string?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2]) + {:field2 [""]})))))) + + (is (= + [{"key" :print-spec-keys/field1, "spec" "string?"} + {"key" :print-spec-keys/field2, + "spec" "(coll-of :print-spec-keys/field1)"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1 + :print-spec-keys/field2]) + {})))))) + (is (= + [{"key" :field1, "spec" "string?"} + {"key" :field2, "spec" "(coll-of :print-spec-keys/field1)"} + {"key" :field3, "spec" "int?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec2 + {})))))) + (is (= + [{"key" :key-spec3, + "spec" #?(:clj + "(keys\n :req-un\n [:print-spec-keys/field1\n :print-spec-keys/field4\n :print-spec-keys/field5])" + :cljs + "(keys\n :req-un\n [:print-spec-keys/field1\n :print-spec-keys/field4 \n :print-spec-keys/field5])")} + {"key" :set-spec, "spec" #?(:clj + "(coll-of\n :print-spec-keys/field1\n :kind\n set?)" + :cljs + "(coll-of :print-spec-keys/field1 :kind set?)")} + {"key" :vector-spec, "spec" #?(:clj "(coll-of\n :print-spec-keys/field1\n :kind\n vector?)" + :cljs "(coll-of\n :print-spec-keys/field1 \n :kind \n vector?)")}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec4 + {}))))))) + +(deftest print-table + (is (= + " +| :key | :spec | +|======+=======| +| abc | a | +| | b | +|------+-------| +| def | d | +| | e | +" + (printer/print-table [{:key "abc" :spec "a\nb"} + {:key "def" :spec "d\ne"}]))) + ;; can select ordering of keys + (is (= + " +| :b | :c | +|====+====| +| 2 | 3 | +|----+----| +| {} | () | +" + (printer/print-table + [:b :c] + [{:a 1 :b 2 :c 3} + {:a [] :b {} :c '()}]))) + + ;; ordering is deterministic, not based on hashmap + ;; semantics + (is (= + " +| :k | :a | :b | :c | :d | :e | :f | :g | :h | :i | :j | +|====+====+====+====+====+====+====+====+====+====+====| +| k | a | b | c | d | e | f | g | h | i | j | +|----+----+----+----+----+----+----+----+----+----+----| +| k | a | b | c | d | e | f | g | h | i | j | +" + (printer/print-table + [:k :a :b :c :d :e :f :g :h :i :j] + [{:a "a" :b "b" :c "c" :d "d" :e "e" :f "f" :g "g" :h "h" :i "i" :j "j" :k "k" :l "l"} + {:l "l" :k "k" :j "j" :i "i" :h "h" :g "g" :f "f" :e "e" :d "d" :c "c" :b "b" :a "a"}])))) + +(deftest print-table-gen + (checking + "any table with have constant width" + num-tests + [col-count (s/gen pos-int?) + keys (s/gen (s/coll-of keyword? :min-count 1)) + row-count (s/gen pos-int?) + vals (s/gen (s/coll-of + (s/coll-of string? :count col-count) + :count row-count)) + :let [rows (mapv + #(zipmap keys (get vals %)) + (range 0 row-count)) + table (printer/print-table rows) + srows (rest (string/split table #"\n"))]] + + (is (apply = (map count srows)))) + + (checking + "any table will contain a sub-table of all rows but the last" + num-tests + [col-count (s/gen pos-int?) + keys (s/gen (s/coll-of keyword? :min-count 1)) + row-count (s/gen (s/int-in 2 10)) + vals (s/gen (s/coll-of + (s/coll-of string? :count col-count) + :count row-count)) + :let [rows (mapv + #(zipmap keys (get vals %)) + (range 0 row-count)) + sub-rows (butlast rows) + table (printer/print-table rows) + sub-table (printer/print-table sub-rows) + sub-table-last-row (last (string/split sub-table #"\n")) + table-last-row (last (string/split table #"\n"))]] + ;; If the line we delete shrinks the width of the table + ;; (because it was the widest value) + ;; then the property will not apply + (when (= (count sub-table-last-row) (count table-last-row)) + (is (string/includes? table sub-table)))) + + #?(:clj + (checking + "for any known registered spec, table has max width" + num-tests + [spec sg/spec-gen + :let [rows [{:key spec + :spec (printer/expand-spec spec)}] + table (printer/print-table rows) + srows (rest (string/split table #"\n"))]] + (is (< (count (last srows)) 200))) + :cljs + ;; Noop, just to make clj-kondo happy + (sg/topo-sort []))) + +(deftest highlighted-value + (testing "atomic value" + (is (= "\"Fred\"\n^^^^^^" + (printer/highlighted-value + {} + {:expound/form "Fred" + :expound/in []})))) + (testing "value in vector" + (is (= "[... :b ...]\n ^^" + (printer/highlighted-value + {} + {:expound/form [:a :b :c] + :expound/in [1]})))) + (testing "long, composite values are pretty-printed" + (is (= (str "{:letters {:a \"aaaaaaaa\", + :b \"bbbbbbbb\", + :c \"cccccccd\", + :d \"dddddddd\", + :e \"eeeeeeee\"}}" + #?(:clj "\n ^^^^^^^^^^^^^^^" + :cljs "\n ^^^^^^^^^^^^^^^^")) + ;; ^- the above works in clojure - maybe not CLJS? + (printer/highlighted-value + {} + {:expound/form + {:letters + {:a "aaaaaaaa" + :b "bbbbbbbb" + :c "cccccccd" + :d "dddddddd" + :e "eeeeeeee"}} + :expound/in [:letters]})))) + (testing "args to function" + (is (= "(1 ... ...)\n ^" + (printer/highlighted-value + {} + {:expound/form (get-args 1 2 3) + :expound/in [0]})))) + (testing "show all values" + (is (= "(1 2 3)\n ^" + (printer/highlighted-value + {:show-valid-values? true} + {:expound/form (get-args 1 2 3) + :expound/in [0]})))) + + (testing "special replacement chars are not used" + (is (= "\"$ $$ $1 $& $` $'\"\n^^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data keyword? "$ $$ $1 $& $` $'")))))))) + + (testing "nested map-of specs" + (is (= "{:a {:b 1}}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {:a {:b 1}}))))))) + (is (= "{:a {\"a\" ...}}\n ^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {:a {"a" :b}}))))))) + (is (= "{1 ...}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {1 {:a :b}})))))))) + + (testing "nested keys specs" + (is (= "{:address {:city 1}}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {:address {:city 1}}))))))) + (is (= "{:address {\"city\" \"Denver\"}}\n ^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {:address {"city" "Denver"}}))))))) + (is (= "{\"address\" {:city \"Denver\"}}\n^^^^^^^^^^^^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {"address" {:city "Denver"}}))))))))) + +(deftest highlighted-value-on-alt + (is (= "[... 0]\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (clojure.spec.alpha/alt :a int? + :b (clojure.spec.alpha/spec (clojure.spec.alpha/cat :c int?))) + [1 0])))))))) + +(deftest highlighted-value-on-coll-of + ;; sets + (is (= "#{1 3 2 :a}\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + #{1 :a 2 3}))))))) + (is (= "#{:a}\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + #{:a}))))))) + + ;; lists + (is (= "(... :a ... ...)\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + '(1 :a 2 3)))))))) + (is (= "(:a)\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + '(:a)))))))) + + ;; vectors + (is (= "[... :a ... ...]\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + [1 :a 2 3]))))))) + + (is (= "[:a]\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + [:a]))))))) + + ;; maps + (is (= "[1 :a]\n^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + {1 :a 2 3}))))))) + + (is (= "[:a 1]\n^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + {:a 1})))))))) diff --git a/test-resources/lib_tests/expound/problems_test.cljc b/test-resources/lib_tests/expound/problems_test.cljc new file mode 100644 index 00000000..a40642af --- /dev/null +++ b/test-resources/lib_tests/expound/problems_test.cljc @@ -0,0 +1,30 @@ +(ns expound.problems-test + (:require [clojure.test :as ct :refer [is deftest use-fixtures]] + [clojure.spec.alpha :as s] + [expound.problems :as problems] + [expound.test-utils :as test-utils])) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(s/def :highlighted-value/nested-map-of (s/map-of keyword? (s/map-of keyword? keyword?))) + +(s/def :highlighted-value/city string?) +(s/def :highlighted-value/address (s/keys :req-un [:highlighted-value/city])) +(s/def :highlighted-value/house (s/keys :req-un [:highlighted-value/address])) + +(s/def :annotate-test/div-fn (s/fspec + :args (s/cat :x int? :y pos-int?))) +(defn my-div [x y] + (assert (pos? (/ x y)))) + +(deftest annotate-test + (is (= {:expound/in [0] + :val '(0 1) + :reason "Assert failed: (pos? (/ x y))"} + (-> (s/explain-data (s/coll-of :annotate-test/div-fn) [my-div]) + problems/annotate + :expound/problems + first + (select-keys [:expound/in :val :reason]))))) \ No newline at end of file diff --git a/test-resources/lib_tests/expound/spec_gen.cljc b/test-resources/lib_tests/expound/spec_gen.cljc new file mode 100644 index 00000000..68c684ac --- /dev/null +++ b/test-resources/lib_tests/expound/spec_gen.cljc @@ -0,0 +1,97 @@ +(ns expound.spec-gen + (:require [clojure.spec.alpha :as s] + [com.stuartsierra.dependency :as deps] + [clojure.test.check.generators :as gen] + [expound.alpha :as expound])) + +;; I want to do something like +;; (s/def :specs.coll-of/into #{[] '() #{}}) +;; but Clojure (not Clojurescript) won't allow +;; this. As a workaround, I'll just use vectors instead +;; of vectors and lists. +;; FIXME - force a specific type of into/kind one for each test +;; (one for vectors, one for lists, etc) + +(s/def :specs.coll-of/into #{[] #{}}) +(s/def :specs.coll-of/kind #{vector? list? set?}) +(s/def :specs.coll-of/count pos-int?) +(s/def :specs.coll-of/max-count pos-int?) +(s/def :specs.coll-of/min-count pos-int?) +(s/def :specs.coll-of/distinct boolean?) + +(s/def :specs/every-args + (s/keys :req-un + [:specs.coll-of/into + :specs.coll-of/kind + :specs.coll-of/count + :specs.coll-of/max-count + :specs.coll-of/min-count + :specs.coll-of/distinct])) + +(defn apply-coll-of [spec {:keys [into max-count min-count distinct]}] + (s/coll-of spec :into into :min-count min-count :max-count max-count :distinct distinct)) + +(defn apply-map-of [spec1 spec2 {:keys [into max-count min-count distinct _gen-max]}] + (s/map-of spec1 spec2 :into into :min-count min-count :max-count max-count :distinct distinct)) + +;; Since CLJS prints out entire source of a function when +;; it pretty-prints a failure, the output becomes much nicer if +;; we wrap each function in a simple spec +(expound/def :specs/string string? "should be a string") +(expound/def :specs/vector vector? "should be a vector") +(s/def :specs/int int?) +(s/def :specs/boolean boolean?) +(expound/def :specs/keyword keyword? "should be a keyword") +(s/def :specs/map map?) +(s/def :specs/symbol symbol?) +(s/def :specs/pos-int pos-int?) +(s/def :specs/neg-int neg-int?) +(s/def :specs/zero #(and (number? %) (zero? %))) +(s/def :specs/keys (s/keys + :req-un [:specs/string] + :req [:specs/map] + :opt-un [:specs/vector] + :opt [:specs/int])) + +(def simple-spec-gen (gen/one-of + [(gen/elements [:specs/string + :specs/vector + :specs/int + :specs/boolean + :specs/keyword + :specs/map + :specs/symbol + :specs/pos-int + :specs/neg-int + :specs/zero + :specs/keys]) + (gen/set gen/simple-type-printable)])) + +(defn spec-dependencies [spec] + (->> spec + s/form + (tree-seq coll? seq) + (filter #(and (s/get-spec %) (not= spec %))) + distinct)) + +(defn topo-sort [specs] + (deps/topo-sort + (reduce + (fn [gr spec] + (reduce + (fn [g d] + ;; If this creates a circular reference, then + ;; just skip it. + (if (deps/depends? g d spec) + g + (deps/depend g spec d))) + gr + (spec-dependencies spec))) + (deps/graph) + specs))) + +#?(:clj + (def spec-gen (gen/elements (->> (s/registry) + (map key) + topo-sort + (filter keyword?))))) diff --git a/test-resources/lib_tests/expound/specs_test.cljc b/test-resources/lib_tests/expound/specs_test.cljc new file mode 100644 index 00000000..bd545ce7 --- /dev/null +++ b/test-resources/lib_tests/expound/specs_test.cljc @@ -0,0 +1,26 @@ +(ns expound.specs-test + (:require [expound.specs] + [clojure.spec.alpha :as s] + [clojure.test :as ct :refer [is deftest use-fixtures]] + [expound.test-utils :as test-utils] + [expound.alpha :as expound])) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(deftest provided-specs + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (is (= "-- Spec failed -------------------- + + 1 + +should be a keyword with no namespace + +------------------------- +Detected 1 error +" + (s/explain-str :expound.specs/simple-kw 1))) + (doseq [kw expound.specs/public-specs] + (is (some? (s/get-spec kw)) (str "Failed to find spec for keyword " kw)) + (is (some? (expound/error-message kw)) (str "Failed to find error message for keyword " kw))))) diff --git a/test-resources/lib_tests/expound/spell_spec_test.cljc b/test-resources/lib_tests/expound/spell_spec_test.cljc new file mode 100644 index 00000000..6ffb1e4f --- /dev/null +++ b/test-resources/lib_tests/expound/spell_spec_test.cljc @@ -0,0 +1,115 @@ +;; copied from +;; https://github.com/bhauman/spell-spec/blob/master/test/spell_spec/expound_test.cljc +;; so I don't break the extension API +(ns expound.spell-spec-test + (:require [#?(:clj clojure.test :cljs cljs.test) + :refer [deftest is testing]] + [#?(:clj clojure.spec.alpha + :cljs cljs.spec.alpha) + :as s] + [clojure.string :as string] + [spell-spec.alpha :as spell :refer [warn-keys strict-keys warn-strict-keys]] + [expound.alpha :as exp] + [spell-spec.expound :as sp.ex])) + +;; copied from +;; https://github.com/bhauman/spell-spec/blob/48ea2ca544f02b04a73dc42a91aa4876dcc5fc95/src/spell_spec/expound.cljc#L23-L34 +;; because test-refresh doesn't refesh libraries if I set explicit paths and +;; if I don't restrict the paths, it tries to reload deps in the CLJS build + +(defmethod exp/problem-group-str :spell-spec.alpha/misspelled-key [_type spec-name val path problems opts] + (sp.ex/exp-formated "Misspelled map key" _type spec-name val path problems opts)) + +(defmethod exp/expected-str :spell-spec.alpha/misspelled-key [_type _spec-name _val _path problems _opts] + (let [{:keys [:spell-spec.alpha/likely-misspelling-of]} (first problems)] + (str "should probably be" (sp.ex/format-correction-list likely-misspelling-of)))) + +(defmethod exp/problem-group-str :spell-spec.alpha/unknown-key [_type spec-name val path problems opts] + (sp.ex/exp-formated "Unknown map key" _type spec-name val path problems opts)) + +(defmethod exp/expected-str :spell-spec.alpha/unknown-key [_type _spec-name _val _path problems _opts] + (str "should be" (sp.ex/format-correction-list (-> problems first :pred)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn fetch-warning-output [thunk] + #?(:clj (binding [*err* (java.io.StringWriter.)] + (thunk) + (str *err*)) + :cljs (with-out-str (thunk)))) + +(deftest check-misspell-test + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1} + result + (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result " :hello\n")))) + +(deftest check-misspell-with-namespace-test + (let [spec (spell/keys :opt [::hello ::there]) + data {::there 1 ::helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result ":expound.spell-spec-test/hello\n")))) + +(s/def ::hello integer?) +(s/def ::there integer?) + +(deftest other-errors-test + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there "1" :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result " :hello\n")) + + (is (not (string/includes? result "Spec failed"))) + (is (not (string/includes? result "should satisfy"))) + (is (not (string/includes? result "integer?"))))) + +(deftest warning-is-valid-test + (let [spec (warn-keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1}] + (testing "expound prints warning to *err*" + (is (= (fetch-warning-output #(exp/expound-str spec data)) + "SPEC WARNING: possible misspelled map key :helloo should probably be :hello in {:there 1, :helloo 1, :barabara 1}\n"))))) + +(deftest strict-keys-test + (let [spec (strict-keys :opt-un [::hello ::there]) + data {:there 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Unknown map key")) + (is (string/includes? result "should be one of")) + (is (string/includes? result " :hello, :there\n")))) + +(deftest warn-on-unknown-keys-test + (let [spec (warn-strict-keys :opt-un [::hello ::there]) + data {:there 1 :barabara 1}] + (testing "expound prints warning to *err*" + (is (= (fetch-warning-output #(exp/expound-str spec data)) + "SPEC WARNING: unknown map key :barabara in {:there 1, :barabara 1}\n"))))) + +(deftest multiple-spelling-matches + (let [spec (spell/keys :opt-un [::hello1 ::hello2 ::hello3 ::hello4 ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be one of")) + (doseq [k [:hello1 :hello2 :hello3 :hello4]] + (is (string/includes? result (pr-str k))))) + (let [spec (spell/keys :opt-un [::hello1 ::hello2 ::hello3 ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be one of")) + (is (not (string/includes? result (pr-str :hello4)))) + (doseq [k [:hello1 :hello2 :hello3]] + (is (string/includes? result (pr-str k))))) + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be: :hello\n")))) diff --git a/test-resources/lib_tests/expound/test_runner.cljs b/test-resources/lib_tests/expound/test_runner.cljs new file mode 100644 index 00000000..39f3e00e --- /dev/null +++ b/test-resources/lib_tests/expound/test_runner.cljs @@ -0,0 +1,28 @@ +(ns expound.test-runner + (:require [jx.reporter.karma :refer-macros [#_run-tests #_run-all-tests]] + [expound.alpha-test] + [expound.paths-test] + [expound.printer-test] + [expound.print-length-test] + [expound.problems-test] + [expound.test-utils] + [expound.specs-test] + [expound.spell-spec-test])) + +(enable-console-print!) + +;; runs all tests in all namespaces +;; This is what runs by default +(defn ^:export run-all [karma] + (jx.reporter.karma/run-all-tests karma)) + +;; runs all tests in all namespaces - only namespaces with names matching +;; the regular expression will be tested +;; You can use this by changing client.args in karma.conf.js +#_(defn ^:export run-all-regex [karma] + (run-all-tests karma #".*-test$")) + +;; runs all tests in the given namespaces +;; You can use this by changing client.args in karma.conf.js +#_(defn ^:export run [karma] + (run-tests karma 'expound.alpha-test)) diff --git a/test-resources/lib_tests/expound/test_utils.cljc b/test-resources/lib_tests/expound/test_utils.cljc new file mode 100644 index 00000000..e1975ae5 --- /dev/null +++ b/test-resources/lib_tests/expound/test_utils.cljc @@ -0,0 +1,41 @@ +(ns expound.test-utils + (:require [clojure.spec.alpha :as s] + #?(:cljs + [clojure.spec.test.alpha :as st] + ;; FIXME + ;; orchestra is supposed to work with cljs but + ;; it isn't working for me right now + #_[orchestra-cljs.spec.test :as st] + :clj [orchestra.spec.test :as st]) + [expound.alpha :as expound] + [clojure.test :as ct] + ;; BB-TEST-PATCH: Don't have this dep and can't load it + #_[com.gfredericks.test.chuck.clojure-test :as chuck] + [expound.util :as util] + [clojure.test.check.generators :as gen])) + +;; test.chuck defines a reporter for the shrunk results, but only for the +;; default reporter (:cljs.test/default). Since karma uses its own reporter, +;; we need to provide an implementation of the report multimethod for +;; the karma reporter and shrunk results + +; (defmethod ct/report [:jx.reporter.karma/karma ::chuck/shrunk] [m] +; (let [f (get (methods ct/report) [::ct/default ::chuck/shrunk])] +; (f m))) + +(defn check-spec-assertions [test-fn] + (s/check-asserts true) + (test-fn) + (s/check-asserts false)) + +(defn instrument-all [test-fn] + (binding [s/*explain-out* (expound/custom-printer {:theme :figwheel-theme})] + (st/instrument) + (test-fn) + (st/unstrument))) + +(defn contains-nan? [x] + (boolean (some util/nan? (tree-seq coll? identity x)))) + +(def any-printable-wo-nan (gen/such-that (complement contains-nan?) + gen/any-printable)) diff --git a/test-resources/lib_tests/io/aviso/binary_test.clj b/test-resources/lib_tests/io/aviso/binary_test.clj new file mode 100644 index 00000000..bdaf0bc8 --- /dev/null +++ b/test-resources/lib_tests/io/aviso/binary_test.clj @@ -0,0 +1,52 @@ +(ns io.aviso.binary-test + "Tests for the io.aviso.binary namespace." + (:use io.aviso.binary + clojure.test) + (:import (java.nio ByteBuffer))) + +(defn ^:private format-string-as-byte-array [str] + (format-binary (.getBytes str))) + +(deftest format-byte-array-test + + (are [input expected] + (= expected (format-string-as-byte-array input)) + + "Hello" "0000: 48 65 6C 6C 6F\n" + + "This is a longer text that spans to a second line." + "0000: 54 68 69 73 20 69 73 20 61 20 6C 6F 6E 67 65 72 20 74 65 78 74 20 74 68 61 74 20 73 70 61 6E 73\n0020: 20 74 6F 20 61 20 73 65 63 6F 6E 64 20 6C 69 6E 65 2E\n")) + +(deftest format-string-as-byte-data + (are [input expected] + (= expected (format-binary input)) + "" "" + + "Hello" "0000: 48 65 6C 6C 6F\n" + + "This is a longer text that spans to a second line." + + "0000: 54 68 69 73 20 69 73 20 61 20 6C 6F 6E 67 65 72 20 74 65 78 74 20 74 68 61 74 20 73 70 61 6E 73\n0020: 20 74 6F 20 61 20 73 65 63 6F 6E 64 20 6C 69 6E 65 2E\n")) + +(deftest nil-is-an-empty-data + (is (= (format-binary nil) ""))) + +(deftest byte-buffer + (let [bb (ByteBuffer/wrap (.getBytes "Duty Now For The Future" "UTF-8"))] + (is (= "0000: 44 75 74 79 20 4E 6F 77 20 46 6F 72 20 54 68 65 20 46 75 74 75 72 65\n" + (format-binary bb))) + + (is (= "0000: 44 75 74 79\n" + (-> bb + (.position 5) + (.limit 9) + format-binary))) + + (is (= "0000: 46 6F 72\n" + (-> bb + (.position 9) + (.limit 12) + .slice + format-binary))) + + )) diff --git a/test-resources/lib_tests/io/aviso/exception_test.clj b/test-resources/lib_tests/io/aviso/exception_test.clj new file mode 100644 index 00000000..f8b1cbe0 --- /dev/null +++ b/test-resources/lib_tests/io/aviso/exception_test.clj @@ -0,0 +1,583 @@ +(ns io.aviso.exception-test + (:use clojure.test) + (:require [clojure.string :as str] + [io.aviso.exception :as e :refer [*fonts* parse-exception format-exception]] + [clojure.pprint :refer [pprint]] + [com.stuartsierra.component :as component] + [com.walmartlabs.test-reporting :refer [reporting]] + io.aviso.component)) + +(deftest write-exceptions + (testing "exception properties printing" + (testing "Does not fail with ex-info's map keys not implementing clojure.lang.Named" + (is (re-find #"string-key.*string-val" + (format-exception (ex-info "Error" {"string-key" "string-val"}))))))) + +(defn parse [& text-lines] + (let [text (str/join \newline text-lines)] + (binding [*fonts* nil] + (parse-exception text nil)))) + +(deftest parse-exceptions + (is (= [{:class-name "java.lang.IllegalArgumentException" + :message "No value supplied for key: {:host \"example.com\"}" + :stack-trace + [{:simple-class "PersistentHashMap" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "create" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.PersistentHashMap" + :names []} + {:simple-class "client$tcp_client" + :package "riemann" + :is-clojure? true + :method "doInvoke" + :name "riemann.client/tcp-client" + :formatted-name "riemann.client/tcp-client" + :file "client.clj" + :line 90 + :class "riemann.client$tcp_client" + :names '("riemann.client" "tcp-client")} + {:simple-class "RestFn" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "invoke" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.RestFn" + :names []} + {:simple-class "error_monitor$make_connection" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-connection" + :formatted-name "com.example.error-monitor/make-connection" + :file "error_monitor.clj" + :line 22 + :class "com.example.error_monitor$make_connection" + :names '("com.example.error-monitor" "make-connection")} + {:simple-class "error_monitor$make_client" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-client" + :formatted-name "com.example.error-monitor/make-client" + :file "error_monitor.clj" + :line 26 + :class "com.example.error_monitor$make_client" + :names '("com.example.error-monitor" "make-client")} + {:simple-class "core$map$fn__4553" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/map/fn" + :formatted-name "clojure.core/map/fn" + :file "core.clj" + :line 2624 + :class "clojure.core$map$fn__4553" + :names '("clojure.core" "map" "fn")} + {:simple-class "LazySeq" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "sval" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.LazySeq" + :names []} + {:simple-class "core$seq__4128" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/seq" + :formatted-name "clojure.core/seq" + :file "core.clj" + :line 137 + :class "clojure.core$seq__4128" + :names '("clojure.core" "seq")} + {:simple-class "core$sort" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort" + :formatted-name "clojure.core/sort" + :file "core.clj" + :line 2981 + :class "clojure.core$sort" + :names '("clojure.core" "sort")} + {:simple-class "core$sort_by" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort-by" + :formatted-name "clojure.core/sort-by" + :file "core.clj" + :line 2998 + :class "clojure.core$sort_by" + :names '("clojure.core" "sort-by")} + {:simple-class "core$sort_by" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort-by" + :formatted-name "clojure.core/sort-by" + :file "core.clj" + :line 2996 + :class "clojure.core$sort_by" + :names '("clojure.core" "sort-by")} + {:simple-class "error_monitor$make_clients" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-clients" + :formatted-name "com.example.error-monitor/make-clients" + :file "error_monitor.clj" + :line 31 + :class "com.example.error_monitor$make_clients" + :names '("com.example.error-monitor" "make-clients")} + {:simple-class "error_monitor$report_and_reset" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/report-and-reset" + :formatted-name "com.example.error-monitor/report-and-reset" + :file "error_monitor.clj" + :line 185 + :class "com.example.error_monitor$report_and_reset" + :names '("com.example.error-monitor" "report-and-reset")} + {:simple-class "main$_main$fn__705" + :package "com.example.error_monitor" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor.main/-main/fn" + :formatted-name "com.example.error-monitor.main/-main/fn" + :file "main.clj" + :line 19 + :class "com.example.error_monitor.main$_main$fn__705" + :names '("com.example.error-monitor.main" "-main" "fn")} + {:simple-class "main$_main" + :package "com.example.error_monitor" + :is-clojure? true + :method "doInvoke" + :name "com.example.error-monitor.main/-main" + :formatted-name "com.example.error-monitor.main/-main" + :file "main.clj" + :line 16 + :class "com.example.error_monitor.main$_main" + :names '("com.example.error-monitor.main" "-main")} + {:simple-class "RestFn" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "applyTo" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.RestFn" + :names []} + {:class "com.example.error_monitor.main" + :file "" + :formatted-name "com.example.error_monitor.main.main" + :is-clojure? false + :line nil + :method "main" + :name "" + :names [] + :package "com.example.error_monitor" + :simple-class "main"}]}] + (parse "java.lang.IllegalArgumentException: No value supplied for key: {:host \"example.com\"}" + "\tat clojure.lang.PersistentHashMap.create(PersistentHashMap.java:77)" + "\tat riemann.client$tcp_client.doInvoke(client.clj:90)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:408)" + "\tat com.example.error_monitor$make_connection.invoke(error_monitor.clj:22)" + "\tat com.example.error_monitor$make_client.invoke(error_monitor.clj:26)" + "\tat clojure.core$map$fn__4553.invoke(core.clj:2624)" + "\tat clojure.lang.LazySeq.sval(LazySeq.java:40)" + "\tat clojure.lang.LazySeq.seq(LazySeq.java:49)" + "\tat clojure.lang.RT.seq(RT.java:507)" + "\tat clojure.core$seq__4128.invoke(core.clj:137)" + "\tat clojure.core$sort.invoke(core.clj:2981)" + "\tat clojure.core$sort_by.invoke(core.clj:2998)" + "\tat clojure.core$sort_by.invoke(core.clj:2996)" + "\tat com.example.error_monitor$make_clients.invoke(error_monitor.clj:31)" + "\tat com.example.error_monitor$report_and_reset.invoke(error_monitor.clj:185)" + "\tat com.example.error_monitor.main$_main$fn__705.invoke(main.clj:19)" + "\tat com.example.error_monitor.main$_main.doInvoke(main.clj:16)" + "\tat clojure.lang.RestFn.applyTo(RestFn.java:137)" + "\tat com.example.error_monitor.main.main(Unknown Source)")) + + (is (= [{:class-name "java.lang.RuntimeException", :message "Request handling exception"} + {:class-name "java.lang.RuntimeException", :message "Failure updating row"} + {:class-name "java.sql.SQLException" + :message "Database failure\nSELECT FOO, BAR, BAZ\nFROM GNIP\nfailed with ABC123" + :stack-trace [{:simple-class "user$jdbc_update" + :package nil + :is-clojure? true + :method "invoke" + :name "user/jdbc-update" + :formatted-name "user/jdbc-update" + :file "user.clj" + :line 7 + :class "user$jdbc_update" + :names '("user" "jdbc-update")} + {:simple-class "user$make_jdbc_update_worker$reify__497" + :package nil + :is-clojure? true + :method "do_work" + :name "user/make-jdbc-update-worker/reify/do-work" + :formatted-name "user/make-jdbc-update-worker/reify/do-work" + :file "user.clj" + :line 18 + :class "user$make_jdbc_update_worker$reify__497" + :names '("user" "make-jdbc-update-worker" "reify" "do-work")} + {:simple-class "user$update_row" + :package nil + :is-clojure? true + :method "invoke" + :name "user/update-row" + :formatted-name "user/update-row" + :file "user.clj" + :line 23 + :class "user$update_row" + :names '("user" "update-row")} + {:simple-class "user$make_exception" + :package nil + :is-clojure? true + :method "invoke" + :name "user/make-exception" + :formatted-name "user/make-exception" + :file "user.clj" + :line 31 + :class "user$make_exception" + :names '("user" "make-exception")} + {:simple-class "user$eval2018" + :package nil + :is-clojure? true + :method "invoke" + :name "user/eval2018" + :formatted-name "user/eval2018" + :file "REPL Input" + :line nil + :class "user$eval2018" + :names '("user" "eval2018")} + {:simple-class "Compiler" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "eval" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.Compiler" + :names []} + {:simple-class "core$eval" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/eval" + :formatted-name "clojure.core/eval" + :file "core.clj" + :line 2852 + :class "clojure.core$eval" + :names '("clojure.core" "eval")}]}] + (parse "java.lang.RuntimeException: Request handling exception" + "\tat user$make_exception.invoke(user.clj:31)" + "\tat user$eval2018.invoke(form-init1482095333541107022.clj:1)" + "\tat clojure.lang.Compiler.eval(Compiler.java:6619)" + "\tat clojure.lang.Compiler.eval(Compiler.java:6582)" + "\tat clojure.core$eval.invoke(core.clj:2852)" + "\tat clojure.main$repl$read_eval_print__6602$fn__6605.invoke(main.clj:259)" + "\tat clojure.main$repl$read_eval_print__6602.invoke(main.clj:259)" + "\tat clojure.main$repl$fn__6611$fn__6612.invoke(main.clj:277)" + "\tat clojure.main$repl$fn__6611.invoke(main.clj:277)" + "\tat clojure.main$repl.doInvoke(main.clj:275)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:1523)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$evaluate$fn__1419.invoke(interruptible_eval.clj:72)" + "\tat clojure.lang.AFn.applyToHelper(AFn.java:159)" + "\tat clojure.lang.AFn.applyTo(AFn.java:151)" + "\tat clojure.core$apply.invoke(core.clj:617)" + "\tat clojure.core$with_bindings_STAR_.doInvoke(core.clj:1788)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:425)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$evaluate.invoke(interruptible_eval.clj:56)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$interruptible_eval$fn__1461$fn__1464.invoke(interruptible_eval.clj:191)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$run_next$fn__1456.invoke(interruptible_eval.clj:159)" + "\tat clojure.lang.AFn.run(AFn.java:24)" + "\tat java.util.concurrent.ThreadPoolExecutor.runWorker(ThreadPoolExecutor.java:1142)" + "\tat java.util.concurrent.ThreadPoolExecutor$Worker.run(ThreadPoolExecutor.java:617)" + "\tat java.lang.Thread.run(Thread.java:745)" + "Caused by: java.lang.RuntimeException: Failure updating row" + "\tat user$update_row.invoke(user.clj:23)" + "\t... 24 more" + "Caused by: java.sql.SQLException: Database failure" + "SELECT FOO, BAR, BAZ" + "FROM GNIP" + "failed with ABC123" + "\tat user$jdbc_update.invoke(user.clj:7)" + "\tat user$make_jdbc_update_worker$reify__497.do_work(user.clj:18)" + "\t... 25 more")) + + (is (= [{:class-name "com.datastax.driver.core.TransportException", :message "/17.76.3.14:9042 Cannot connect"} + {:class-name "java.net.ConnectException", + :message "Connection refused: /17.76.3.14:9042", + :stack-trace [{:simple-class "SocketChannelImpl" + :package "sun.nio.ch" + :is-clojure? false + :method "checkConnect" + :name "" + :formatted-name "sun.nio.ch.SocketChannelImpl.checkConnect" + :file "" + :line nil + :class "sun.nio.ch.SocketChannelImpl" + :names []} + {:simple-class "SocketChannelImpl" + :package "sun.nio.ch" + :is-clojure? false + :method "finishConnect" + :name "" + :formatted-name "sun.nio.ch.SocketChannelImpl.finishConnect" + :file "SocketChannelImpl.java" + :line 717 + :class "sun.nio.ch.SocketChannelImpl" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "connect" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.connect" + :file "NioClientBoss.java" + :line 150 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "processSelectedKeys" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.processSelectedKeys" + :file "NioClientBoss.java" + :line 105 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "process" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.process" + :file "NioClientBoss.java" + :line 79 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "AbstractNioSelector" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector.run" + :file "AbstractNioSelector.java" + :line 318 + :class "com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.run" + :file "NioClientBoss.java" + :line 42 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "ThreadRenamingRunnable" + :package "com.datastax.shaded.netty.util" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.util.ThreadRenamingRunnable.run" + :file "ThreadRenamingRunnable.java" + :line 108 + :class "com.datastax.shaded.netty.util.ThreadRenamingRunnable" + :names []} + {:simple-class "DeadLockProofWorker$1" + :package "com.datastax.shaded.netty.util.internal" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1.run" + :file "DeadLockProofWorker.java" + :line 42 + :class "com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1" + :names []} + {:simple-class "Connection" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.Connection." + :file "Connection.java" + :line 104 + :class "com.datastax.driver.core.Connection" + :names []} + {:simple-class "PooledConnection" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.PooledConnection." + :file "PooledConnection.java" + :line 32 + :class "com.datastax.driver.core.PooledConnection" + :names []} + {:simple-class "Connection$Factory" + :package "com.datastax.driver.core" + :is-clojure? false + :method "open" + :name "" + :formatted-name "com.datastax.driver.core.Connection$Factory.open" + :file "Connection.java" + :line 557 + :class "com.datastax.driver.core.Connection$Factory" + :names []} + {:simple-class "DynamicConnectionPool" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.DynamicConnectionPool." + :file "DynamicConnectionPool.java" + :line 74 + :class "com.datastax.driver.core.DynamicConnectionPool" + :names []} + {:simple-class "HostConnectionPool" + :package "com.datastax.driver.core" + :is-clojure? false + :method "newInstance" + :name "" + :formatted-name "com.datastax.driver.core.HostConnectionPool.newInstance" + :file "HostConnectionPool.java" + :line 33 + :class "com.datastax.driver.core.HostConnectionPool" + :names []} + {:simple-class "SessionManager$2" + :package "com.datastax.driver.core" + :is-clojure? false + :method "call" + :name "" + :formatted-name "com.datastax.driver.core.SessionManager$2.call" + :file "SessionManager.java" + :line 231 + :class "com.datastax.driver.core.SessionManager$2" + :names []} + {:simple-class "SessionManager$2" + :package "com.datastax.driver.core" + :is-clojure? false + :method "call" + :name "" + :formatted-name "com.datastax.driver.core.SessionManager$2.call" + :file "SessionManager.java" + :line 224 + :class "com.datastax.driver.core.SessionManager$2" + :names []} + {:simple-class "FutureTask" + :package "java.util.concurrent" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.util.concurrent.FutureTask.run" + :file "FutureTask.java" + :line 266 + :class "java.util.concurrent.FutureTask" + :names []} + {:simple-class "ThreadPoolExecutor" + :package "java.util.concurrent" + :is-clojure? false + :method "runWorker" + :name "" + :formatted-name "java.util.concurrent.ThreadPoolExecutor.runWorker" + :file "ThreadPoolExecutor.java" + :line 1142 + :class "java.util.concurrent.ThreadPoolExecutor" + :names []} + {:simple-class "ThreadPoolExecutor$Worker" + :package "java.util.concurrent" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.util.concurrent.ThreadPoolExecutor$Worker.run" + :file "ThreadPoolExecutor.java" + :line 617 + :class "java.util.concurrent.ThreadPoolExecutor$Worker" + :names []} + {:simple-class "Thread" + :package "java.lang" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.lang.Thread.run" + :file "Thread.java" + :line 745 + :class "java.lang.Thread" + :names []}]}] + + (parse "com.datastax.driver.core.TransportException: /17.76.3.14:9042 Cannot connect" + "\tat com.datastax.driver.core.Connection.(Connection.java:104) ~store-service.jar:na" + "\tat com.datastax.driver.core.PooledConnection.(PooledConnection.java:32) ~store-service.jar:na" + "\tat com.datastax.driver.core.Connection$Factory.open(Connection.java:557) ~store-service.jar:na" + "\tat com.datastax.driver.core.DynamicConnectionPool.(DynamicConnectionPool.java:74) ~store-service.jar:na" + "\tat com.datastax.driver.core.HostConnectionPool.newInstance(HostConnectionPool.java:33) ~store-service.jar:na" + "\tat com.datastax.driver.core.SessionManager$2.call(SessionManager.java:231) store-service.jar:na" + "\tat com.datastax.driver.core.SessionManager$2.call(SessionManager.java:224) store-service.jar:na" + "\tat java.util.concurrent.FutureTask.run(FutureTask.java:266) na:1.8.0_66" + "\tat java.util.concurrent.ThreadPoolExecutor.runWorker(ThreadPoolExecutor.java:1142) na:1.8.0_66" + "\tat java.util.concurrent.ThreadPoolExecutor$Worker.run(ThreadPoolExecutor.java:617) na:1.8.0_66" + "\tat java.lang.Thread.run(Thread.java:745) na:1.8.0_66" + "Caused by: java.net.ConnectException: Connection refused: /17.76.3.14:9042" + "\tat sun.nio.ch.SocketChannelImpl.checkConnect(Native Method) ~na:1.8.0_66" + "\tat sun.nio.ch.SocketChannelImpl.finishConnect(SocketChannelImpl.java:717) ~na:1.8.0_66" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.connect(NioClientBoss.java:150) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.processSelectedKeys(NioClientBoss.java:105) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.process(NioClientBoss.java:79) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector.run(AbstractNioSelector.java:318) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.run(NioClientBoss.java:42) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.util.ThreadRenamingRunnable.run(ThreadRenamingRunnable.java:108) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1.run(DeadLockProofWorker.java:42) ~store-service.jar:na" + "\t... 3 common frames omitted")))))) + +(defrecord MyComponent [] + + component/Lifecycle + (start [this] this) + (stop [this] this)) + + +(deftest component-print-behavior + (binding [e/*fonts* nil] + (let [my-component (map->MyComponent {}) + system (component/system-map + :my-component my-component) + sys-exception (format-exception (ex-info "System Exception" {:system system})) + comp-exception (format-exception (ex-info "Component Exception" {:component my-component}))] + + (reporting {sys-exception (str/split-lines sys-exception)} + (is (re-find #"system: #" sys-exception))) + + (reporting {comp-exception (str/split-lines comp-exception)} + (is (re-find #"component: #" comp-exception)))))) + +(deftest write-exceptions-with-nil-data + (testing "Does not fail with a nil ex-info map key" + (is (re-find #"nil.*nil" + (format-exception (ex-info "Error" {nil nil})))))) diff --git a/test-resources/lib_tests/missing/test/assertions_test.cljc b/test-resources/lib_tests/missing/test/assertions_test.cljc new file mode 100644 index 00000000..9eb4e9e0 --- /dev/null +++ b/test-resources/lib_tests/missing/test/assertions_test.cljc @@ -0,0 +1,12 @@ +(ns missing.test.assertions-test + (:require + [clojure.test :refer [deftest testing is] :as t] + [missing.test.old-methods] + [missing.test.assertions])) + +(deftest a-test + (testing "FIXME, I fail." + 1)) + +(deftest another-test + (testing (is 1))) diff --git a/test-resources/lib_tests/missing/test/old_methods.cljc b/test-resources/lib_tests/missing/test/old_methods.cljc new file mode 100644 index 00000000..4ef98a0d --- /dev/null +++ b/test-resources/lib_tests/missing/test/old_methods.cljc @@ -0,0 +1,13 @@ +(ns missing.test.old-methods + (:require [clojure.test :as t] + [missing.test.assertions :refer [register!]])) + +(defmethod t/report #?(:clj :begin-test-var + :cljs [::t/default :begin-test-var]) [_] + (println "Begin test var.")) + +(defmethod t/report #?(:clj :end-test-var + :cljs [::t/default :end-test-var]) [_] + (println "End test var.")) + +(register! {:throw? false}) diff --git a/test-resources/lib_tests/portal/bench.cljc b/test-resources/lib_tests/portal/bench.cljc new file mode 100644 index 00000000..3263189c --- /dev/null +++ b/test-resources/lib_tests/portal/bench.cljc @@ -0,0 +1,18 @@ +(ns portal.bench + #?(:cljs (:refer-clojure :exclude [simple-benchmark])) + #?(:cljs (:require-macros portal.bench))) + +(defn now [] + #?(:clj (System/currentTimeMillis) + :cljs (.now js/Date))) + +(defmacro simple-benchmark + [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}] + (let [expr-str (pr-str expr)] + `(let ~bindings + (dotimes [_# ~iterations] ~expr) + (let [start# (now) + ret# (dotimes [_# ~iterations] ~expr) + end# (now) + elapsed# (- end# start#)] + (~print-fn (str ~iterations " runs, " elapsed# " msecs, " ~expr-str)))))) diff --git a/test-resources/lib_tests/portal/e2e.clj b/test-resources/lib_tests/portal/e2e.clj new file mode 100644 index 00000000..26597322 --- /dev/null +++ b/test-resources/lib_tests/portal/e2e.clj @@ -0,0 +1,32 @@ +(ns portal.e2e + (:require [portal.colors :as c])) + +(defn step [code] + (binding [*out* *err*] + (println "\n==> Enter to execute:" code "\n")) + (read-line) + (prn code)) + +(def pane-titles '("Alice" "Mad Hatter" "The Cake is a Lie")) + +(defn options [] + {:portal.colors/theme + (rand-nth (keys (dissoc c/themes ::c/vs-code-embedded))) + :portal.launcher/window-title + (rand-nth pane-titles)}) + +(defn -main [& args] + (if (= (first args) "web") + (step '(require '[portal.web :as p])) + (step '(require '[portal.api :as p]))) + (step `(do (add-tap #'p/submit) + (p/open ~(options)))) + (step '(tap> :hello-world)) + (step '(p/clear)) + (step '(require '[examples.data :refer [data]])) + (step '(tap> data)) + (step '(p/clear)) + (step '(remove-tap #'p/submit)) + (step '(tap> :hello-world)) + (step '(p/eval-str "(js/alert 1)")) + (step '(p/close))) diff --git a/test-resources/lib_tests/portal/jvm_test.clj b/test-resources/lib_tests/portal/jvm_test.clj new file mode 100644 index 00000000..20553047 --- /dev/null +++ b/test-resources/lib_tests/portal/jvm_test.clj @@ -0,0 +1,23 @@ +(ns portal.jvm-test + (:require [clojure.test :refer [deftest is]] + [portal.api :as p] + [portal.runtime.browser :as browser] + [portal.runtime.index :as index] + [portal.runtime.jvm.client :as client])) + +(defn- headless-chrome-flags [url] + ["--headless" "--disable-gpu" url]) + +(defn- open [f] + (with-redefs [browser/flags f] (p/open))) + +(deftest e2e-jvm + (reset! index/testing? true) + (when-let [portal (open headless-chrome-flags)] + (with-redefs [client/timeout 60000] + (reset! portal 0) + (is (= @portal 0)) + (swap! portal inc) + (is (= @portal 1)))) + (p/close)) + diff --git a/test-resources/lib_tests/portal/runtime/cson_test.cljc b/test-resources/lib_tests/portal/runtime/cson_test.cljc new file mode 100644 index 00000000..c7b5a4ce --- /dev/null +++ b/test-resources/lib_tests/portal/runtime/cson_test.cljc @@ -0,0 +1,172 @@ +(ns portal.runtime.cson-test + (:require [clojure.test :refer [deftest are is]] + #?(:clj [clojure.edn :as edn] + :cljs [cljs.reader :as edn]) + [cognitect.transit :as transit] + [portal.bench :as b] + [portal.runtime.cson :as cson]) + #?(:clj (:import [java.io ByteArrayOutputStream ByteArrayInputStream] + [java.util Date] + [java.util UUID]))) + +(defn- transit-read [^String string] + #?(:clj (-> string + .getBytes + ByteArrayInputStream. + (transit/reader :json) + transit/read) + :cljs (transit/read (transit/reader :json) string))) + +(defn- transit-write [value] + #?(:clj (let [out (ByteArrayOutputStream. 1024)] + (transit/write + (transit/writer out :json {:transform transit/write-meta}) + value) + (.toString out)) + :cljs (transit/write + (transit/writer :json {:transform transit/write-meta}) + value))) + +(defn pass [v] + (cson/read (cson/write v))) + +(deftest simple-values + (are [value] + (= value (pass value)) + nil + 0 + 1.0 + #?(:clj 42N + :cljs (when (exists? js/BigInt) + (js/BigInt "42"))) + \newline + true + false + 'hello + 'hello/world + :hello + :hello/world + "" + "hello" + "hello/world")) + +(deftest escape-strings + (are [value] + (= value (pass value)) + "\n" + "\"" + " \"hello\" ")) + +(deftest basic-collections + (are [value] + (= value (pass value)) + [] + [1 2 3] + {} + {:a :b} + #{} + #{1 2 3} + '() + (list 1 2 3))) + +(def composite-value + ['hello + 'hello/world + '(1 2 3) + "" + 3.14 + true + false + #inst "2021-04-07T22:43:59.393-00:00" + #uuid "1d80bdbb-ab16-47b2-a8bd-068f94950248" + nil + 1 + \h + "data" + {:hello/world :grep} + #{1 2 3}]) + +(deftest composite-collections + (are [value] + (= value (pass value)) + [[[]]] + #{#{#{}}} + {{} {}} + {[] []} + {#{} #{}} + {(list) (list)} + (list [] #{} {}) + composite-value)) + +(deftest special-collections + (are [value] + (= value (pass value)) + (range 10))) + +(deftest seq-collections + (are [value] + (= (seq value) (pass (seq value))) + '(0) + [0] + #{0} + {0 0})) + +(def tagged + [#?(:clj (Date.) + :cljs (js/Date.)) + #?(:clj (UUID/randomUUID) + :cljs (random-uuid)) + (tagged-literal 'tag :value)]) + +(deftest tagged-objects + (doseq [value tagged] + (is (= value (pass value))))) + +(deftest metadata + (doseq [value ['hello {} [] #{}]] + (let [m {:my :meta} + value (with-meta value m)] + (is (= m (meta (pass value))))))) + +(deftest symbol-key-with-meta + (let [m {:a :b} + value {(with-meta 'k m) 'v}] + (is (= value (pass value))) + (is (= m (meta (first (keys (pass value)))))))) + +(deftest cson-over-edn + (is + (-> composite-value + (cson/write {:stringify pr-str}) + (cson/read {:parse edn/read-string}) + (= composite-value)))) + +(def n 10000) +(def v composite-value) + +(def edn + {:parse edn/read-string + :stringify pr-str}) + +(comment + (deftest rich-benchmark + (b/simple-benchmark [] (transit-write v) n) + (b/simple-benchmark [] (cson/write v edn) n) + (b/simple-benchmark [] (cson/write v) n) + + (prn) + + (b/simple-benchmark + [v (transit-write v)] (transit-read v) n) + (b/simple-benchmark + [v (cson/write v edn)] (cson/read v edn) n) + (b/simple-benchmark + [v (cson/write v)] (cson/read v) n))) + +#?(:clj + (deftest java-longs + (is (= 1 (byte 1) (pass (byte 1)))) + (is (= 1 (short 1) (pass (short 1)))) + (is (= 1 (int 1) (pass (int 1)))) + (is (= 1 (long 1) (pass (long 1)))) + (is (= 4611681620380904123 (pass 4611681620380904123))))) diff --git a/test-resources/lib_tests/portal/runtime/fs_test.cljc b/test-resources/lib_tests/portal/runtime/fs_test.cljc new file mode 100644 index 00000000..96c1bef2 --- /dev/null +++ b/test-resources/lib_tests/portal/runtime/fs_test.cljc @@ -0,0 +1,21 @@ +(ns portal.runtime.fs-test + (:require [clojure.test :refer [deftest is]] + [portal.runtime.fs :as fs])) + +(deftest fs + (is (some? (fs/slurp "deps.edn"))) + (let [deps (fs/join (fs/cwd) "deps.edn")] + (is (= (fs/exists deps) deps))) + (is (some? (fs/home))) + (is (some? (seq (fs/paths)))) + (is (contains? + (into #{} (fs/list (fs/cwd))) + (fs/join (fs/cwd) "deps.edn"))) + (let [dir (str "target/" (gensym)) + file (str dir "/" (gensym))] + (fs/mkdir dir) + (fs/spit file "hello") + (is (= (fs/slurp file) "hello")) + (fs/rm dir) + (is (nil? (fs/exists file))) + (is (nil? (fs/exists dir))))) diff --git a/test-resources/lib_tests/portal/test_planck.cljs b/test-resources/lib_tests/portal/test_planck.cljs new file mode 100644 index 00000000..3e7769a9 --- /dev/null +++ b/test-resources/lib_tests/portal/test_planck.cljs @@ -0,0 +1,11 @@ +(ns portal.test-planck + (:require [cljs.test :refer [run-tests]] + [planck.core :refer [exit]] + [portal.runtime.cson-test])) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] + (when-not (cljs.test/successful? m) + (exit 1))) + +(defn -main [] + (run-tests 'portal.runtime.cson-test)) diff --git a/test-resources/lib_tests/portal/test_runner.clj b/test-resources/lib_tests/portal/test_runner.clj new file mode 100644 index 00000000..d6c1fb71 --- /dev/null +++ b/test-resources/lib_tests/portal/test_runner.clj @@ -0,0 +1,14 @@ +(ns portal.test-runner + (:require [clojure.test :refer [run-tests]] + [portal.jvm-test] + [portal.runtime.cson-test] + [portal.runtime.fs-test])) + +(defn -main [] + (let [{:keys [fail error]} + (run-tests 'portal.jvm-test + 'portal.runtime.cson-test + 'portal.runtime.fs-test)] + (shutdown-agents) + (System/exit (+ fail error)))) + diff --git a/test-resources/lib_tests/portal/test_runner.cljs b/test-resources/lib_tests/portal/test_runner.cljs new file mode 100644 index 00000000..e4d4d30e --- /dev/null +++ b/test-resources/lib_tests/portal/test_runner.cljs @@ -0,0 +1,14 @@ +(ns portal.test-runner + (:require [cljs.test :refer [run-tests]] + [portal.runtime.cson-test] + [portal.runtime.fs-test])) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] + (when-not (cljs.test/successful? m) + (.exit js/process 1))) + +(defn -main [] + (run-tests 'portal.runtime.cson-test + 'portal.runtime.fs-test)) + +(-main) diff --git a/test-resources/lib_tests/progrock/core_test.clj b/test-resources/lib_tests/progrock/core_test.clj new file mode 100644 index 00000000..095b2dcc --- /dev/null +++ b/test-resources/lib_tests/progrock/core_test.clj @@ -0,0 +1,41 @@ +(ns progrock.core-test + (:require [clojure.test :refer :all] + [progrock.core :as pr])) + +(deftest test-progress-bar + (let [bar (pr/progress-bar 50)] + (is (= (:total bar) 50)) + (is (= (:progress bar) 0)) + (is (not (:done? bar))))) + +(deftest test-tick + (let [bar (pr/progress-bar 50)] + (is (= (-> bar pr/tick :progress) 1)) + (is (= (-> bar (pr/tick 16) :progress) 16)) + (is (= (-> bar (pr/tick 5) pr/tick :progress) 6)))) + +(deftest test-done + (let [bar (pr/progress-bar 50)] + (is (-> bar pr/done :done?)))) + +(deftest test-render + (let [bar (pr/progress-bar 50)] + (is (= (pr/render bar) + " 0/50 0% [ ] ETA: --:--")) + (is (= (pr/render (pr/tick bar 25)) + "25/50 50% [========================= ] ETA: 00:00")) + (is (= (pr/render (pr/tick bar 25) {:format "(:bar)", :length 10}) + "(===== )")) + (is (= (pr/render (pr/tick bar 25) {:format "[:bar]", :complete \#, :incomplete \-}) + "[#########################-------------------------]")) + (is (= (pr/render (pr/progress-bar 0)) + "0/0 0% [ ] ETA: --:--")))) + +(deftest test-print + (let [bar (pr/progress-bar 50)] + (is (= (with-out-str (pr/print bar)) + "\r 0/50 0% [ ] ETA: --:--")) + (is (= (with-out-str (pr/print bar {:length 10})) + "\r 0/50 0% [ ] ETA: --:--")) + (is (= (with-out-str (pr/print (pr/done bar) {:length 10})) + "\r 0/50 0% [ ] ETA: --:--\n")))) diff --git a/test-resources/lib_tests/testdoc/core_test.clj b/test-resources/lib_tests/testdoc/core_test.clj new file mode 100644 index 00000000..c8f68b32 --- /dev/null +++ b/test-resources/lib_tests/testdoc/core_test.clj @@ -0,0 +1,133 @@ +(ns testdoc.core-test + (:require + [clojure.java.io :as io] + [clojure.test :as t] + [testdoc.core :as sut])) + +(defn- repl-styled-success-test-func + "foo bar + + => (+ 1 2 3) + 6 + => (+ 1 2 + => 3 4) + 10 + => *1 + 10 + => (inc *1) + 11" + []) + +(defn- code-first-styled-success-test-func + "foo bar + + (+ 1 2 3) + ;; => 6 + + (+ 1 2 + 3 4) + ;; => 10 + *1 + ;; => 10 + (inc *1) + ;; => 11" + []) + +(defn- repl-styled-partial-success-test-func + "foo bar + + => (+ 1 2 3) + 6 + => (+ 1 2 3 4) + 999" + []) + +(defn- code-first-styled-partial-success-test-func + "foo bar + + (+ 1 2 3) + ;; => 6 + (+ 1 2 3 4) + ;; => 999" + []) + +(t/deftest testdoc-test + (t/testing "repl style" + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 11 :actual 11}] + (->> (sut/testdoc nil #'repl-styled-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))) + + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :fail :expected 999 :actual 10}] + (->> (sut/testdoc nil #'repl-styled-partial-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected))))) + + (t/testing "code-first style" + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 11 :actual 11}] + (->> (sut/testdoc nil #'code-first-styled-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))) + + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :fail :expected 999 :actual 10}] + (->> (sut/testdoc nil #'code-first-styled-partial-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))))) + +(t/deftest testdoc-unsupported-test + (let [[result :as results] (sut/testdoc nil 123)] + (t/is (= 1 (count results))) + (t/is (= :fail (:type result))) + (t/is (re-seq #"^Unsupported document:" (:message result))))) + +(defn plus + "Add a and b + + => (plus 1 2) + 3 + => (plus 2 + => 3) + 5" + [a b] + (+ a b)) + +(t/deftest plus-test + (t/is (testdoc #'plus))) + +(t/deftest plus-string-test + (t/is (testdoc "=> (require '[testdoc.core-test :as ct]) + nil + => (ct/plus 1 2) + 3 + => (ct/plus 2 + => 3) + 5"))) + +(t/deftest nil-value-test + (t/is (= [{:type :fail :message "(= 1 nil)" :expected nil :actual 1}] + (sut/testdoc nil "=> 1 + nil")))) + +(t/deftest unresolved-symbol-test + (let [[err :as res] (sut/testdoc nil " + => (unresolved-fn 10) + 11")] + (t/is (= 1 (count res))) + (t/is (= :fail (:type err))) + (t/is (every? #(some? (get err %)) [:type :message :expected :actual])) + (t/is (= "(= (unresolved-fn 10) 11), [line: 2]" (:message err))))) + +(t/deftest debug-test + (with-out-str + (t/is (testdoc #'sut/debug)))) + +(t/deftest README-test + (t/is (testdoc (slurp (io/file "README.md"))))) diff --git a/test-resources/lib_tests/testdoc/style/code_first_test.clj b/test-resources/lib_tests/testdoc/style/code_first_test.clj new file mode 100644 index 00000000..f3747c9e --- /dev/null +++ b/test-resources/lib_tests/testdoc/style/code_first_test.clj @@ -0,0 +1,26 @@ +(ns testdoc.style.code-first-test + (:require + [clojure.string :as str] + [clojure.test :as t] + [testdoc.style.code-first :as sut])) + +(defn- lines + [ls] + (str/join "\n" ls)) + +(t/deftest parse-doc-test + (t/are [expected in] (= expected (sut/parse-doc (lines in))) + '[[a b]], ["a" ";; => b"] + '[[(a b) c]], ["(a" "b)" ";; => c"] + '[[(a b) c]], ["head" "(a" "b)" ";; => c"] + '[[a b] [c d]], ["a" ";; => b" "c" ";; => d"] + '[], ["a"] + '[[a b]], ["a" ";; => b" "c"] + '[[a b]], ["a" ";; => b" ";; => c"] + '[[a (b c)]], ["a" ";; => [b" ";; => c]"])) + +(t/deftest parse-doc-with-meta-test + (let [ret (sut/parse-doc (lines ["" "a" ";; => 6" "c" ";; => :d"]))] + (t/is (= '[[a 6] [c :d]] ret)) + (t/is (= 2 (-> ret first meta :testdoc.string/line))) + (t/is (= 4 (-> ret second meta :testdoc.string/line))))) diff --git a/test-resources/lib_tests/testdoc/style/repl_test.clj b/test-resources/lib_tests/testdoc/style/repl_test.clj new file mode 100644 index 00000000..8952e314 --- /dev/null +++ b/test-resources/lib_tests/testdoc/style/repl_test.clj @@ -0,0 +1,25 @@ +(ns testdoc.style.repl-test + (:require + [clojure.string :as str] + [clojure.test :as t] + [testdoc.style.repl :as sut])) + +(defn- lines + [ls] + (str/join "\n" ls)) + +(t/deftest parse-doc-test + (t/are [expected in] (= expected (sut/parse-doc (lines in))) + '[[a b]], ["=> a" "b"] + '[[(a b) c]], ["=> (a" "=> b)" "c"] + '[[a b] [c d]], ["=> a" "b" "=> c" "d"] + '[], ["=> a"] + '[[a b]], ["=> a" "b" "=> c"] + '[[a b]], ["=> a" "b" "c"] + '[[a (b c)]], ["=> a" "[b" "c]"])) + +(t/deftest parse-doc-with-meta-test + (let [ret (sut/parse-doc (lines ["" "=> a" "6" "=> c" ":d"]))] + (t/is (= '[[a 6] [c :d]] ret)) + (t/is (= 2 (-> ret first meta :testdoc.string/line))) + (t/is (= 4 (-> ret second meta :testdoc.string/line)))))