From 665ae4dd97535bf72a5ce34a19d624e74e5c4fe8 Mon Sep 17 00:00:00 2001 From: Gabriel Horner Date: Wed, 29 Dec 2021 10:35:14 -0500 Subject: [PATCH] Finish up library tests (#1120) * Add tests for markdown-clj and tools.namespace See comment for why only one markdown test could be run. Closes #1069 and #1064 * Convert 10 test libs using add-libtest Also improved add-libtest to only require maven artifact and rely on clojars for getting git-url most of the time * Convert 8 more test libs using add-libtest Also updated table and added comment for newline test * Fix doric test * Disable tools.namespace test that fails on windows * Added dozen manual test libs and converted 2 test libs add-libtest.clj supports manually-added and test-directories options * Converts last tests to test namespaces and write libraries.csv * Add a number of library tests from projects.md Also add more docs around adding test libs and tweak add script * Use :sha for gitlib and older clojure cli * Revert "Use :sha for gitlib and older clojure cli" This reverts commit c663ab8368e76f627bf8d109e420705190db17a4. * Fix and disable failing tests Disabled tests that fail consistently and fixed windows one --- deps.edn | 34 +- doc/dev.md | 8 +- doc/libraries.csv | 72 + doc/projects.md | 36 +- script/add-libtest.clj | 162 +- test-resources/lib_tests/aero/core_test.cljc | 4 +- test-resources/lib_tests/aero/lumo_test.cljs | 23 + .../babashka/lambdaisland/regal_test.clj | 15 - .../lib_tests/babashka/run_all_libtests.clj | 196 +- test-resources/lib_tests/bb-tested-libs.edn | 84 +- .../lib_tests/bond/assertions_test.clj | 121 + test-resources/lib_tests/bond/james_test.clj | 109 + test-resources/lib_tests/bond/target_data.clj | 35 + .../lib_tests/borkdude/deps/smoke_test.clj | 20 + .../lib_tests/borkdude/rewrite_edn_test.cljc | 133 + .../camel_snake_kebab/core_test.cljc | 6 +- .../camel_snake_kebab/extras_test.cljc | 16 + .../internals/string_separator_test.cljc | 41 + .../camel_snake_kebab/test_runner.cljs | 10 + .../lib_tests/clj_http/lite/client_test.clj | 7 +- .../lib_tests/clj_http/lite/test_runner.clj | 10 + .../lib_tests/clj_yaml/core_test.clj | 110 +- .../clojure/data/generators_test.clj | 2 +- .../lib_tests/clojure/data/json_test.clj | 1 + .../lib_tests/clojure/data/zip_test.clj | 17 + .../lib_tests/clojure/term/colors_test.clj | 29 + .../lib_tests/clojure/test_clojure/instr.clj | 14 +- .../lib_tests/clojure/test_clojure/spec.clj | 9 +- .../tools/namespace/dependency_test.clj | 315 ++ .../clojure/tools/namespace/dir_test.clj | 20 + .../clojure/tools/namespace/find_test.clj | 29 + .../clojure/tools/namespace/move_test.clj | 52 + .../clojure/tools/namespace/parse_test.clj | 210 + .../clojure/tools/namespace/test_helpers.clj | 82 + .../test_runner/sample_property_test.clj | 10 + .../cognitect/test_runner/samples_test.clj | 14 + .../lib_tests/cognitect/test_runner_test.clj | 23 + .../com/stuartsierra/component_test.clj | 307 ++ .../lib_tests/component/component_test.clj | 41 - .../lib_tests/contajners/core_test.clj | 22 + .../lib_tests/contajners/impl_test.clj | 45 + test-resources/lib_tests/cprop/smoke_test.clj | 7 + test-resources/lib_tests/docopt/core_test.clj | 88 + .../lib_tests/docopt/extra_testcases.docopt | 57 + test-resources/lib_tests/doric/test/core.clj | 4 +- .../lib_tests/doric/test/doctest.clj | 93 + .../lib_tests/doric/test/readme.clj | 6 + .../lib_tests/expound/alpha_test.cljc | 4350 +++++++++++++++++ .../lib_tests/expound/paths_test.cljc | 39 + .../lib_tests/expound/print_length_test.cljc | 23 + .../lib_tests/expound/printer_test.cljc | 428 ++ .../lib_tests/expound/problems_test.cljc | 30 + .../lib_tests/expound/spec_gen.cljc | 97 + .../lib_tests/expound/specs_test.cljc | 26 + .../lib_tests/expound/spell_spec_test.cljc | 115 + .../lib_tests/expound/test_runner.cljs | 28 + .../lib_tests/expound/test_utils.cljc | 41 + test-resources/lib_tests/failjure/runner.cljs | 5 + test-resources/lib_tests/gaka/core_test.clj | 6 +- .../lib_tests/honey/sql/helpers_test.cljc | 3 +- .../lib_tests/honey/sql/postgres_test.cljc | 11 +- test-resources/lib_tests/honey/sql_test.cljc | 100 +- .../lib_tests/honeysql/core_test.cljc | 141 +- .../lib_tests/honeysql/format_test.cljc | 14 + .../lib_tests/io/aviso/binary_test.clj | 52 + .../lib_tests/io/aviso/exception_test.clj | 583 +++ .../lambdaisland/regal/malli_test.cljc | 19 + .../lambdaisland/regal/parse_test.cljc | 29 + .../lib_tests/lambdaisland/regal/re2_test.clj | 45 + .../lambdaisland/regal/spec_gen_test.clj | 39 + .../lambdaisland/regal/test_util.cljc | 146 + .../lib_tests/lambdaisland/regal_test.cljc | 174 + .../lib_tests/markdown/md_test.cljc | 450 ++ .../lib_tests/markdown/nbb_runner.cljs | 10 + test-resources/lib_tests/markdown/runner.cljs | 5 + .../lib_tests/medley/core_test.cljc | 409 ++ .../lib_tests/medley/test_runner.cljs | 5 + .../lib_tests/minimallist/core_test.cljc | 145 +- .../lib_tests/minimallist/generator_test.cljc | 546 +++ .../lib_tests/minimallist/util_test.cljc | 53 + .../missing/test/assertions_test.cljc | 12 + .../lib_tests/missing/test/old_methods.cljc | 13 + test-resources/lib_tests/portal/bench.cljc | 18 + test-resources/lib_tests/portal/e2e.clj | 32 + test-resources/lib_tests/portal/jvm_test.clj | 23 + .../lib_tests/portal/runtime/cson_test.cljc | 172 + .../lib_tests/portal/runtime/fs_test.cljc | 21 + .../lib_tests/portal/test_planck.cljs | 11 + .../lib_tests/portal/test_runner.clj | 14 + .../lib_tests/portal/test_runner.cljs | 14 + .../lib_tests/progrock/core_test.clj | 43 + .../lib_tests/slingshot/slingshot_test.clj | 9 +- .../lib_tests/slingshot/support_test.clj | 4 +- test-resources/lib_tests/table/core_test.clj | 2 +- .../lib_tests/testdoc/core_test.clj | 133 + .../testdoc/style/code_first_test.clj | 26 + .../lib_tests/testdoc/style/repl_test.clj | 25 + .../lib_tests/version_clj/compare_test.cljc | 9 + .../lib_tests/version_clj/split_test.cljc | 4 + .../lib_tests/version_clj/via_use_test.clj | 1 + 100 files changed, 11043 insertions(+), 459 deletions(-) create mode 100644 doc/libraries.csv create mode 100644 test-resources/lib_tests/aero/lumo_test.cljs delete mode 100644 test-resources/lib_tests/babashka/lambdaisland/regal_test.clj create mode 100644 test-resources/lib_tests/bond/assertions_test.clj create mode 100644 test-resources/lib_tests/bond/james_test.clj create mode 100644 test-resources/lib_tests/bond/target_data.clj create mode 100644 test-resources/lib_tests/borkdude/deps/smoke_test.clj create mode 100644 test-resources/lib_tests/borkdude/rewrite_edn_test.cljc create mode 100644 test-resources/lib_tests/camel_snake_kebab/extras_test.cljc create mode 100644 test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc create mode 100644 test-resources/lib_tests/camel_snake_kebab/test_runner.cljs create mode 100644 test-resources/lib_tests/clj_http/lite/test_runner.clj create mode 100644 test-resources/lib_tests/clojure/data/zip_test.clj create mode 100644 test-resources/lib_tests/clojure/term/colors_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/dir_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/find_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/move_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/parse_test.clj create mode 100644 test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj create mode 100644 test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj create mode 100644 test-resources/lib_tests/cognitect/test_runner/samples_test.clj create mode 100644 test-resources/lib_tests/cognitect/test_runner_test.clj create mode 100644 test-resources/lib_tests/com/stuartsierra/component_test.clj delete mode 100644 test-resources/lib_tests/component/component_test.clj create mode 100644 test-resources/lib_tests/contajners/core_test.clj create mode 100644 test-resources/lib_tests/contajners/impl_test.clj create mode 100644 test-resources/lib_tests/cprop/smoke_test.clj create mode 100644 test-resources/lib_tests/docopt/core_test.clj create mode 100644 test-resources/lib_tests/docopt/extra_testcases.docopt create mode 100644 test-resources/lib_tests/doric/test/doctest.clj create mode 100644 test-resources/lib_tests/doric/test/readme.clj create mode 100644 test-resources/lib_tests/expound/alpha_test.cljc create mode 100644 test-resources/lib_tests/expound/paths_test.cljc create mode 100644 test-resources/lib_tests/expound/print_length_test.cljc create mode 100644 test-resources/lib_tests/expound/printer_test.cljc create mode 100644 test-resources/lib_tests/expound/problems_test.cljc create mode 100644 test-resources/lib_tests/expound/spec_gen.cljc create mode 100644 test-resources/lib_tests/expound/specs_test.cljc create mode 100644 test-resources/lib_tests/expound/spell_spec_test.cljc create mode 100644 test-resources/lib_tests/expound/test_runner.cljs create mode 100644 test-resources/lib_tests/expound/test_utils.cljc create mode 100644 test-resources/lib_tests/failjure/runner.cljs create mode 100644 test-resources/lib_tests/io/aviso/binary_test.clj create mode 100644 test-resources/lib_tests/io/aviso/exception_test.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/malli_test.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal/parse_test.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal/re2_test.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/test_util.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal_test.cljc create mode 100644 test-resources/lib_tests/markdown/md_test.cljc create mode 100644 test-resources/lib_tests/markdown/nbb_runner.cljs create mode 100644 test-resources/lib_tests/markdown/runner.cljs create mode 100644 test-resources/lib_tests/medley/core_test.cljc create mode 100644 test-resources/lib_tests/medley/test_runner.cljs create mode 100644 test-resources/lib_tests/minimallist/generator_test.cljc create mode 100644 test-resources/lib_tests/minimallist/util_test.cljc create mode 100644 test-resources/lib_tests/missing/test/assertions_test.cljc create mode 100644 test-resources/lib_tests/missing/test/old_methods.cljc create mode 100644 test-resources/lib_tests/portal/bench.cljc create mode 100644 test-resources/lib_tests/portal/e2e.clj create mode 100644 test-resources/lib_tests/portal/jvm_test.clj create mode 100644 test-resources/lib_tests/portal/runtime/cson_test.cljc create mode 100644 test-resources/lib_tests/portal/runtime/fs_test.cljc create mode 100644 test-resources/lib_tests/portal/test_planck.cljs create mode 100644 test-resources/lib_tests/portal/test_runner.clj create mode 100644 test-resources/lib_tests/portal/test_runner.cljs create mode 100644 test-resources/lib_tests/progrock/core_test.clj create mode 100644 test-resources/lib_tests/testdoc/core_test.clj create mode 100644 test-resources/lib_tests/testdoc/style/code_first_test.clj create mode 100644 test-resources/lib_tests/testdoc/style/repl_test.clj diff --git a/deps.edn b/deps.edn index d45a9704..25faf037 100644 --- a/deps.edn +++ b/deps.edn @@ -55,10 +55,7 @@ :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"} org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha" :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"} - lambdaisland/regal {:git/url "https://github.com/lambdaisland/regal" - :sha "f902d2c43121f9e1c48603d6eb99f5900eb6a9f6"} - weavejester/medley {:git/url "https://github.com/weavejester/medley" - :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} + lambdaisland/regal {:mvn/version "0.0.143"} cprop/cprop {:mvn/version "0.1.16"} comb/comb {:mvn/version "0.1.1"} mvxcvi/arrangement {:mvn/version "2.0.0"} @@ -69,16 +66,16 @@ henryw374/cljc.java-time {:git/url "https://github.com/henryw374/cljc.java-time.git" :sha "e3d184b78e933322b3fcaa6ca66cbb8f42a6b35c"} - camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.1"} + camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.2"} aero/aero {:mvn/version "1.1.6"} org.clojure/data.generators {:mvn/version "1.0.0"} - honeysql/honeysql {:mvn/version "1.0.444"} - com.github.seancorfield/honeysql {:mvn/version "2.0.0-rc2"} - minimallist/minimallist {:mvn/version "0.0.6"} - circleci/bond {:mvn/version "0.4.0"} - version-clj/version-clj {:mvn/version "2.0.1"} + honeysql/honeysql {:mvn/version "1.0.461"} + com.github.seancorfield/honeysql {:mvn/version "2.2.840"} + minimallist/minimallist {:mvn/version "0.0.10"} + circleci/bond {:mvn/version "0.6.0"} + version-clj/version-clj {:mvn/version "2.0.2"} gaka/gaka {:mvn/version "0.3.0"} - failjure/failjure {:mvn/version "2.1.1"} + failjure/failjure {:mvn/version "2.2.0"} io.helins/binf {:mvn/version "1.1.0-beta0"} rm-hull/jasentaa {:mvn/version "0.2.5"} slingshot/slingshot {:mvn/version "0.12.2"} @@ -104,7 +101,20 @@ listora/again {:mvn/version "1.0.0"} org.clojure/tools.gitlibs {:mvn/version "2.4.172"} environ/environ {:mvn/version "1.2.0"} - table/table {:git/url "https://github.com/cldwalker/table", :sha "55aef3d5fced682942af811bf5d642f79fb87688"}} + 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"} + 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 new file mode 100644 index 00000000..2665caa7 --- /dev/null +++ b/doc/libraries.csv @@ -0,0 +1,72 @@ +maven-name,git-url +aero/aero,http://github.com/juxt/aero +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 +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 +lambdaisland/regal,https://github.com/lambdaisland/regal +listora/again,https://github.com/liwp/again +markdown-clj/markdown-clj,https://github.com/yogthos/markdown-clj +medley/medley,https://github.com/weavejester/medley +minimallist/minimallist,https://github.com/green-coder/minimallist +mvxcvi/arrangement,https://github.com/greglook/clj-arrangement +orchestra/orchestra,https://github.com/jeaye/orchestra +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 +org.clojure/data.json,https://github.com/clojure/data.json +org.clojure/data.zip,https://github.com/clojure/data.zip +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 0a55b0b1..b3cc625c 100644 --- a/doc/projects.md +++ b/doc/projects.md @@ -56,6 +56,7 @@ The following libraries and projects are known to work with babashka. - [contajners](#contajners) - [dependency](#dependency) - [specmonstah](#specmonstah) + - [markdown-clj](#markdown-clj) - [Pods](#pods) - [Projects](#projects-1) - [babashka-test-action](#babashka-test-action) @@ -82,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 @@ -110,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 @@ -145,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}} @@ -201,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)*" @@ -792,6 +782,10 @@ Represent dependency graphs as a directed acylic graph. Write concise, maintainable test fixtures with clojure.spec.alpha. +### [markdown-clj](https://github.com/yogthos/markdown-clj) + +Markdown parser that translates markdown to html. + ## Pods [Babashka pods](https://github.com/babashka/babashka.pods) are programs that can diff --git a/script/add-libtest.clj b/script/add-libtest.clj index d44e549e..98215340 100755 --- a/script/add-libtest.clj +++ b/script/add-libtest.clj @@ -1,21 +1,29 @@ #!/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] [babashka.fs :as fs] [babashka.tasks :refer [shell]] + [org.httpkit.client :as http] [clojure.string :as str] [clojure.java.io :as io] [clojure.tools.cli :as cli] [clojure.edn :as edn])) (deps/add-deps '{:deps {org.clojure/tools.gitlibs {:mvn/version "2.4.172"} - borkdude/rewrite-edn {:mvn/version "0.1.0"}}}) + borkdude/rewrite-edn {:mvn/version "0.1.0"} + org.clojure/data.csv {:mvn/version "1.0.0"}}}) (require '[clojure.tools.gitlibs :as gl]) (require '[borkdude.rewrite-edn :as r]) +(require '[clojure.data.csv :as csv]) ;; CLI Utils ;; ========= @@ -53,48 +61,66 @@ (let [nodes (-> "deps.edn" slurp r/parse-string)] (spit "deps.edn" (str (r/assoc-in nodes - [:aliases :lib-tests :extra-deps (symbol lib-name)] + [:aliases :lib-tests :extra-deps lib-name] lib-coordinate))))) +(defn- default-test-dir + [lib-root-dir] + (some #(when (fs/exists? (fs/file lib-root-dir %)) + (str (fs/file lib-root-dir %))) + ;; Most common test dir + ["test" + ;; official clojure repos like https://github.com/clojure/tools.gitlibs + "src/test/clojure"])) + (defn- copy-tests - [git-url lib-name {:keys [directory branch]}] + [git-url lib-name {:keys [directory branch test-directories]}] (let [lib-dir (if branch (gl/procure git-url lib-name branch) (or (gl/procure git-url lib-name "master") (gl/procure git-url lib-name "main"))) - lib-root-dir (if directory - (fs/file lib-dir directory) lib-dir) - test-dir (some #(when (fs/exists? (fs/file lib-root-dir %)) - (str (fs/file lib-root-dir %))) - ;; Search common test dirs - ["test" - ;; official clojure repos like https://github.com/clojure/tools.gitlibs - "src/test/clojure"])] - (when-not test-dir - (error "No test dir found")) - (shell "cp -R" (str test-dir fs/file-separator) "test-resources/lib_tests/") + _ (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 %)) + (str (fs/file lib-root-dir %))) + test-directories) + (some-> (default-test-dir lib-root-dir) vector))] + (when (empty? test-dirs) + (error "No test directories found")) + (doseq [test-dir test-dirs] + (shell "cp -R" (str test-dir fs/file-separator) "test-resources/lib_tests/")) {:lib-dir lib-dir - :test-dir test-dir})) + :test-dirs test-dirs})) + +(defn- default-test-namespaces + [test-dir] + (let [relative-test-files (map #(str (fs/relativize test-dir %)) + (fs/glob test-dir "**/*.{clj,cljc}"))] + (when (empty? relative-test-files) + (error (str "No test files found in " test-dir))) + (map #(-> % + (str/replace fs/file-separator ".") + (str/replace "_" "-") + (str/replace-first #"\.clj(c?)$" "") + symbol) + relative-test-files))) (defn- add-lib-to-tested-libs - [lib-name git-url {:keys [lib-dir test-dir]} options] - (let [git-sha (fs/file-name lib-dir) - relative-test-files (map #(str (fs/relativize test-dir %)) - (fs/glob test-dir "**/*.{clj,cljc}")) - _ (when (empty? relative-test-files) - (error "No test files found")) - namespaces (map #(-> % - (str/replace fs/file-separator ".") - (str/replace "_" "-") - (str/replace-first #"\.clj(c?)$" "") - symbol) - relative-test-files) - lib (merge - {:git-sha git-sha - :git-url git-url - :test-namespaces namespaces} - ;; Options needed to update libs - (select-keys options [:branch :directory])) + [lib-name git-url {:keys [lib-dir test-dirs]} options] + (let [namespaces (or (get-in options [:manually-added :test-namespaces]) + (mapcat default-test-namespaces test-dirs)) + default-lib (merge + {:git-url git-url + :test-namespaces namespaces} + ;; Options needed to update libs + (select-keys options [:branch :directory :test-directories])) + lib (if (:manually-added options) + (-> default-lib + (merge (:manually-added options)) + (assoc :manually-added true)) + (assoc default-lib + :git-sha (fs/file-name lib-dir))) nodes (-> "test-resources/lib_tests/bb-tested-libs.edn" slurp r/parse-string)] (spit "test-resources/lib_tests/bb-tested-libs.edn" (str (r/assoc-in nodes @@ -102,25 +128,63 @@ lib))) 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 "...") + resp @(http/get url {:headers {"Accept" "application/edn"}})] + (if (= 200 (:status resp)) + (-> resp :body slurp edn/read-string) + (error (str "Response failed and returned " (pr-str resp)))))) + +(defn- get-lib-map + [deps-string options] + ;; if deps-string is artifact name + (if (re-matches #"\S+/\S+" deps-string) + (let [artifact-edn (fetch-artifact deps-string)] + {: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 (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 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" + [] + (let [libs (-> "test-resources/lib_tests/bb-tested-libs.edn" slurp edn/read-string) + rows (sort-by first + (map (fn [[name {:keys [git-url]}]] + [name git-url]) libs))] + (with-open [w (io/writer "doc/libraries.csv")] + (csv/write-csv w (into [["maven-name" "git-url"]] rows))))) + (defn- add-libtest* [args options] - (let [[deps-string git-url] args - 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) - _ (add-lib-to-deps lib-name lib-coordinate) - dirs (copy-tests git-url lib-name options) + (let [[artifact-or-deps-string] args + {:keys [lib-name lib-coordinate git-url]} + (get-lib-map artifact-or-deps-string options) + _ (when (nil? git-url) + (error "git-url is required. Please specify with --git-url")) + _ (when-not (:manually-added options) (add-lib-to-deps lib-name lib-coordinate)) + dirs (when-not (:manually-added options) (copy-tests git-url lib-name options)) namespaces (add-lib-to-tested-libs lib-name git-url dirs options)] (println "Added lib" lib-name "which tests the following namespaces:" namespaces) + (write-lib-to-csv) (when (:test options) (apply shell "script/lib_tests/run_all_libtests" namespaces)))) (defn add-libtest [{:keys [arguments options summary]}] - (if (or (< (count arguments) 2) (:help options)) - (print-summary "DEPS-MAP GIT-URL " summary) + (if (or (< (count arguments) 1) (:help options)) + (print-summary "ARTIFACT-OR-DEPS-MAP " summary) (add-libtest* arguments options))) (def cli-options @@ -129,7 +193,13 @@ ;; https://github.com/weavejester/environ/tree/master/environ used this option ["-d" "--directory DIRECTORY" "Directory where library is located"] ;; https://github.com/reifyhealth/specmonstah used this option - ["-b" "--branch BRANCH" "Default branch for git url"]]) + ["-b" "--branch BRANCH" "Default branch for git url"] + ["-g" "--git-url GITURL" "Git url for artifact. Defaults to homepage on clojars"] + ["-m" "--manually-added LIB-MAP" "Only add library to edn file with LIB-MAP merged into library entry" + :parse-fn edn/read-string :validate-fn map?] + ;; https://github.com/jeaye/orchestra used this option + ["-T" "--test-directories TEST-DIRECTORY" "Directories where library tests are located" + :multi true :update-fn conj]]) (when (= *file* (System/getProperty "babashka.file")) (run-command add-libtest *command-line-args* cli-options)) diff --git a/test-resources/lib_tests/aero/core_test.cljc b/test-resources/lib_tests/aero/core_test.cljc index aabbae06..62b552d8 100644 --- a/test-resources/lib_tests/aero/core_test.cljc +++ b/test-resources/lib_tests/aero/core_test.cljc @@ -13,7 +13,7 @@ goog.string.format [cljs.tools.reader.reader-types :refer [source-logging-push-back-reader]]])) - ;; TODO: + ;; BB-TEST-PATCH #_#?(:clj (:import [aero.core Deferred]))) (defn env [s] @@ -38,6 +38,8 @@ (if (= value :favorite) :chocolate :vanilla)) (deftest basic-test + ;; BB-TEST-PATCH: This and several other test files were changed to work with + ;; our dir structure (let [config (read-config "test-resources/lib_tests/aero/config.edn")] (is (= "Hello World!" (:greeting config)))) (testing "Reading empty config returns nil" diff --git a/test-resources/lib_tests/aero/lumo_test.cljs b/test-resources/lib_tests/aero/lumo_test.cljs new file mode 100644 index 00000000..365e61c9 --- /dev/null +++ b/test-resources/lib_tests/aero/lumo_test.cljs @@ -0,0 +1,23 @@ +(ns aero.lumo-test + (:require + aero.core-test + [cljs.test :refer-macros [deftest is testing run-tests]])) + +(def resolve-p (atom nil)) + +(def p (new js/Promise (fn [resolve reject] + (reset! resolve-p resolve)))) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] + [m] + (@resolve-p m)) + +(defn -main [& argv] + (println "Testing with lumo") + (run-tests 'aero.core-test) + (-> p + (.then (fn [m] + (.exit (js/require "process") + (if (cljs.test/successful? m) + 0 + 1)))))) diff --git a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj b/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj deleted file mode 100644 index 7f2fcf60..00000000 --- a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj +++ /dev/null @@ -1,15 +0,0 @@ -(ns babashka.lambdaisland.regal-test - (:require [clojure.test :as t :refer [deftest is]])) - -(prn :requiring :lambdaisland) -(require '[lambdaisland.regal :as regal]) -(prn ::done :requiring :lambdaisland) - -(def r [:cat - [:+ [:class [\a \z]]] - "=" - [:+ [:not \=]]]) - -(deftest regal-test - (is (= "[a-z]+=[^=]+" (str (regal/regex r)))) - (is (= "foo=bar" (re-matches (regal/regex r) "foo=bar")))) diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index a3511e78..58cc0ba8 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -4,8 +4,6 @@ [clojure.edn :as edn] [clojure.test :as t])) -#_(require 'clojure.spec.alpha) - (def ns-args (set (map symbol *command-line-args*))) (def status (atom {})) @@ -27,82 +25,13 @@ (str/lower-case) (str/includes? "win"))) -;;;; clj-http-lite +;; Standard test-runner for libtests +(let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))] + (doseq [{tns :test-namespaces skip-windows :skip-windows} (vals lib-tests)] + (when-not (and skip-windows windows?) + (apply test-namespaces tns)))) -(test-namespaces 'clj-http.lite.client-test) - -;; ;;;; clojure.spec - -(test-namespaces 'clojure.test-clojure.spec - 'clojure.test-clojure.instr - 'clojure.test-clojure.multi-spec) - -;;;; regal - -(test-namespaces 'babashka.lambdaisland.regal-test) - -;;;; medley - -(require '[medley.core :refer [index-by random-uuid]]) -(prn (index-by :id [{:id 1} {:id 2}])) -(prn (random-uuid)) - -;;;; babashka.curl -; skip tests on Windows because of the :compressed thing -(when-not windows? (test-namespaces 'babashka.curl-test)) - -;;;; cprop - -;; TODO: port to test-namespaces - -(require '[cprop.core]) -(require '[cprop.source :refer [from-env]]) -(println (:cprop-env (from-env))) - -;;;; clj-yaml - -(test-namespaces 'clj-yaml.core-test) - -;;;; clojure.data.zip - -;; TODO: port to test-namespaces - -(require '[clojure.data.xml :as xml]) -(require '[clojure.zip :as zip]) -(require '[clojure.data.zip.xml :refer [attr attr= xml1->]]) - -(def data (str "" - " " - " " - "")) - -;; TODO: convert to test -(let [xml (zip/xml-zip (xml/parse (java.io.StringReader. data)))] - ;(prn :xml xml) - (prn :alice-is-a (xml1-> xml :character [(attr= :name "alice")] (attr :type))) - (prn :animal-is-called (xml1-> xml :character [(attr= :type "animal")] (attr :name)))) - -;;;; clojure.data.csv - -(test-namespaces 'clojure.data.csv-test) - -;;;; clojure.math.combinatorics - -(test-namespaces 'clojure.math.test-combinatorics) - -;;;; deps.clj - -;; TODO: port to test-namespaces - -(require '[babashka.curl :as curl]) -(spit "deps_test.clj" - (:body (curl/get "https://raw.githubusercontent.com/borkdude/deps.clj/master/deps.clj" - (if windows? {:compressed false} {})))) - -(binding [*command-line-args* ["-Sdescribe"]] - (load-file "deps_test.clj")) - -(.delete (io/file "deps_test.clj")) +;; Non-standard tests - These are tests with unusual setup around test-namespaces ;;;; doric @@ -112,45 +41,7 @@ ((resolve 'doric.core/table) [:a :b] [{:a 1 :b 2}])) (when (test-namespace? 'doric.test.core) - (test-doric-cyclic-dep-problem) - (test-namespaces 'doric.test.core)) - -;;;; cljc-java-time - -(test-namespaces 'cljc.java-time-test) - -;;;; camel-snake-kebab - -(test-namespaces 'camel-snake-kebab.core-test) - -;;;; aero - -(test-namespaces 'aero.core-test) - -;;;; clojure.data.generators - -(test-namespaces 'clojure.data.generators-test) - -;;;; honeysql - -(test-namespaces 'honeysql.core-test 'honeysql.format-test) - -;;;; minimallist - -(test-namespaces 'minimallist.core-test) - -;;;; bond -(test-namespaces 'bond.test.james) - -;;;; version-clj -(test-namespaces 'version-clj.compare-test - 'version-clj.core-test - 'version-clj.split-test - 'version-clj.via-use-test) - -;;;; httpkit client - -(test-namespaces 'httpkit.client-test) + (test-doric-cyclic-dep-problem)) ;;;; babashka.process (when-not windows? @@ -161,79 +52,6 @@ (require '[babashka.process] :reload) (test-namespaces 'babashka.process-test)) -(test-namespaces 'core-match.core-tests) - -(test-namespaces 'hiccup.core-test) -(test-namespaces 'hiccup2.core-test) - -(test-namespaces 'test-check.smoke-test) - -(test-namespaces 'gaka.core-test) - -(test-namespaces 'failjure.test-core) - -(test-namespaces 'rewrite-clj.parser-test - 'rewrite-clj.node-test - 'rewrite-clj.zip-test - 'rewrite-clj.paredit-test - 'rewrite-clj.zip.subedit-test - 'rewrite-clj.node.coercer-test) - -(test-namespaces 'helins.binf.test) - -(test-namespaces 'selmer.core-test) -(test-namespaces 'selmer.our-test) - -(test-namespaces 'jasentaa.position-test - 'jasentaa.worked-example-1 - 'jasentaa.worked-example-2 - 'jasentaa.collections-test - 'jasentaa.parser.basic-test - 'jasentaa.parser.combinators-test) - -(test-namespaces 'honey.sql-test - 'honey.sql.helpers-test - 'honey.sql.postgres-test) - -(test-namespaces 'slingshot.slingshot-test - 'slingshot.support-test - ;; TODO: - ;; 'slingshot.test-test - ) - -(test-namespaces 'omniconf.core-test) - -(test-namespaces 'crispin.core-test) - -(test-namespaces 'multigrep.core-test) - -(test-namespaces - ;; TODO: env tests don't work because envoy lib isn't compatible with bb - #_'vault.env-test - 'vault.lease-test - 'vault.client.http-test - ;; TODO: - ;; failing tests in the following namespaces: - #_'vault.client.mock-test - #_'vault.secrets.kvv1-test - #_'vault.secrets.kvv2-test) - -;; we don't really run any tests for java-http-clj yet, but we require the -;; namespaces to see if they at least load correctly -(test-namespaces 'java-http-clj.smoke-test) - -(test-namespaces 'component.component-test) - -(test-namespaces 'clj-commons.digest-test) - -(test-namespaces 'hato.client-test) - -(test-namespaces 'orchestra.core-test 'orchestra.expound-test 'orchestra.many-fns 'orchestra.reload-test) - -(let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))] - (doseq [{tns :test-namespaces} (vals lib-tests)] - (apply test-namespaces tns))) - ;;;; final exit code (let [{:keys [:test :fail :error] :as m} @status] diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index cbc276be..2eafea51 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -8,7 +8,7 @@ mvxcvi/arrangement {:git-sha "360d29e7ae81abbf986b5a8e272f2086227d038d", :git-url "https://github.com/greglook/clj-arrangement", :test-namespaces (arrangement.core-test)} clojure-csv/clojure-csv {:git-sha "b6bb882a3a9ac1f82e06eb2262ae7c8141935228", :git-url "https://github.com/davidsantiago/clojure-csv", :test-namespaces (clojure-csv.test.utils clojure-csv.test.core)} environ/environ {:git-sha "aa90997b38bb8070d94dc4a00a14e656eb5fc9ae", :git-url "https://github.com/weavejester/environ", :test-namespaces (environ.core-test), :directory "environ"} - table/table {:git-sha "55aef3d5fced682942af811bf5d642f79fb87688", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} + table/table {:git-sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} com.stuartsierra/dependency {:git-sha "3a467918cd0e5b6ab775d344cfb2a80b56daad6d", :git-url "https://github.com/stuartsierra/dependency", :test-namespaces (com.stuartsierra.dependency-test)} reifyhealth/specmonstah {:git-sha "a2b357009a3aa99a0c2d2361f3bbcd0b0e36505e", :git-url "https://github.com/reifyhealth/specmonstah", :test-namespaces (reifyhealth.specmonstah.spec-gen-test reifyhealth.specmonstah.test-data reifyhealth.specmonstah.core-test), :branch "develop"} exoscale/coax {:git-sha "0d4212af7c07e4f05f74186f05df8a97777b43fe", :git-url "https://github.com/exoscale/coax", :test-namespaces (exoscale.coax-test)} @@ -16,4 +16,84 @@ org.clojars.askonomm/ruuter {:git-sha "78659212f95cac827efc816dfbdab8181c25fc3d", :git-url "https://github.com/askonomm/ruuter", :test-namespaces (ruuter.core-test)} ;; clojure.data.json-gen-test ommitted from test-namespaces b/c it hangs on stest/check org.clojure/data.json {:git-sha "9f1c9ccf3fd3e5a39cfb7289d3d456e842ddf442", :git-url "https://github.com/clojure/data.json", :test-namespaces (clojure.data.json-test clojure.data.json-test-suite-test clojure.data.json-compat-0-1-test)} - io.replikativ/hasch {:git-sha "04d9c0bd34d86bad79502d8a6963eb2525a22b15", :git-url "https://github.com/replikativ/hasch", :test-namespaces (hasch.test)}} + io.replikativ/hasch {:git-sha "04d9c0bd34d86bad79502d8a6963eb2525a22b15", :git-url "https://github.com/replikativ/hasch", :test-namespaces (hasch.test)} + ;; BB-TEST-PATCH: Removed markdown.md-file-test b/c tests hardcode path to test + ;; files. Removed markdown.benchmark b/c it depends on criterium which isn't bb compatible + markdown-clj/markdown-clj {:git-sha "ac245d3049afa25a6d41fcb5ba5a268f52c610e4", :git-url "https://github.com/yogthos/markdown-clj", :test-namespaces (markdown.md-test)} + ;; BB-TEST-PATCH: Removed clojure.tools.namespace.dir-test as it fails on windows + org.clojure/tools.namespace {:git-sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b", :git-url "https://github.com/babashka/tools.namespace", :test-namespaces (clojure.tools.namespace.test-helpers clojure.tools.namespace.dependency-test clojure.tools.namespace.find-test clojure.tools.namespace.move-test clojure.tools.namespace.parse-test), :branch "babashka"} + com.stuartsierra/component {:git-sha "9f9653d1d95644e3c30beadf8c8811f86758ea23", :git-url "https://github.com/stuartsierra/component", :test-namespaces (com.stuartsierra.component-test)} + slingshot/slingshot {:git-sha "6961ab0593ab9633c15b7697ffd43823090720be", :git-url "https://github.com/scgilardi/slingshot", :test-namespaces (slingshot.slingshot-test slingshot.support-test slingshot.test-test)} + rm-hull/jasentaa {:git-sha "f52a0e75cbdf1d2b72d9604232db264ff6473f12", :git-url "https://github.com/rm-hull/jasentaa", :test-namespaces (jasentaa.position-test jasentaa.worked-example-2 jasentaa.collections-test jasentaa.parser.basic-test jasentaa.parser.combinators-test jasentaa.test-helpers jasentaa.worked-example-1)} + failjure/failjure {:git-sha "c6e528c1eda6ad5eaab0f1fb2a97e766bf41fdd5", :git-url "https://github.com/adambard/failjure", :test-namespaces (failjure.test-core)} + gaka/gaka {:git-sha "2f264758881d6dc586b948ca8757134675f542a7", :git-url "https://github.com/cdaddr/gaka", :test-namespaces (gaka.core-test)} + version-clj/version-clj {:git-sha "9d86cd870f7e435fd6d593cb689790a22d8040a6", :git-url "https://github.com/xsc/version-clj", :test-namespaces (version-clj.compare-test version-clj.split-test version-clj.core-test version-clj.via-use-test)} + circleci/bond {:git-sha "0d389cfb4628341824bddbe8bf102f15ad25ad0d", :git-url "https://github.com/circleci/bond", :test-namespaces (bond.assertions-test bond.james-test bond.target-data)} + ;; BB-TEST-PATCH: minimallist.generator-test excluded because generator ns can't be required + minimallist/minimallist {:git-sha "f10ebbd3c2b93e7579295618a7ed1e870c489bc4", :git-url "https://github.com/green-coder/minimallist", :test-namespaces (minimallist.util-test minimallist.core-test), :branch "all-work-and-no-play"} + 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: 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 + ;; additional libs that aren't bb compatible e.g. instaparse and malli + lambdaisland/regal {:git-sha "d13f26dfdf37186ee86016ed144fc823c5b24c11", :git-url "https://github.com/lambdaisland/regal", :test-namespaces (lambdaisland.regal.test-util lambdaisland.regal-test)} + medley/medley {:git-sha "d723afcb18e1fae27f3b68a25c7a151569159a9e", :git-url "https://github.com/weavejester/medley", :test-namespaces (medley.core-test)} + clj-commons/clj-yaml {:git-sha "9c2d602ec6ab33da061575f52e3de1aff41f67f5", :git-url "https://github.com/clj-commons/clj-yaml", :test-namespaces (clj-yaml.core-test)} + org.clojure/data.csv {:git-sha "aa9b3bdd3a1d3f6a7fe12eaab76b45ef3f197ad5", :git-url "https://github.com/clojure/data.csv", :test-namespaces (clojure.data.csv-test)} + org.clojure/math.combinatorics {:git-sha "e555a45b5802cf5e8c43b4377628ef34a634554b", :git-url "https://github.com/clojure/math.combinatorics", :test-namespaces (clojure.math.test-combinatorics)} + doric/doric {:git-sha "8747fdce565187a5c368c575cf4ca794084b0a5c", :git-url "https://github.com/joegallo/doric", :test-namespaces (doric.test.core doric.test.readme doric.test.doctest)} + com.github.seancorfield/honeysql {:git-sha "6e4e1f6928450788353c181f32474d930d6afe84", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honey.sql-test honey.sql.helpers-test honey.sql.postgres-test), :branch "develop"} + honeysql/honeysql {:git-sha "1137dd12350afdc30ad4976c3718279581390b36", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honeysql.format-test honeysql.core-test), :branch "v1"} + ; skip tests on Windows because of the :compressed thing + babashka/babashka.curl {:git-url "https://github.com/babashka/babashka.curl", :test-namespaces [babashka.curl-test], :skip-windows true, :manually-added true} + http-kit/http-kit {:git-url "https://github.com/http-kit/http-kit", :test-namespaces [httpkit.client-test], :manually-added true} + org.clojure/core.match {:git-url "https://github.com/clojure/core.match", :test-namespaces [core-match.core-tests], :manually-added true} + hiccup/hiccup {:git-url "http://github.com/weavejester/hiccup", :test-namespaces [hiccup.core-test hiccup2.core-test], :manually-added true} + org.clojure/test.check {:git-url "https://github.com/clojure/test.check", :test-namespaces [test-check.smoke-test], :manually-added true} + io.helins/binf {:git-url "https://github.com/helins/binf.cljc", :test-namespaces [helins.binf.test], :manually-added true} + selmer/selmer {:git-url "https://github.com/yogthos/Selmer", :test-namespaces [selmer.core-test selmer.our-test], :manually-added true} + com.grammarly/omniconf {:git-url "https://github.com/grammarly/omniconf", :test-namespaces [omniconf.core-test], :manually-added true} + crispin/crispin {:git-url "https://github.com/dunaj-project/crispin", :test-namespaces [crispin.core-test], :manually-added true} + clj-commons/multigrep {:git-url "https://github.com/clj-commons/multigrep", :test-namespaces [multigrep.core-test], :manually-added true} + org.clj-commons/digest {:git-url "https://github.com/clj-commons/clj-digest", :test-namespaces [clj-commons.digest-test], :manually-added true} + hato/hato {:git-url "https://github.com/gnarroway/hato", :test-namespaces [hato.client-test], :manually-added true} + java-http-clj/java-http-clj {:git-url "http://www.github.com/schmee/java-http-clj", :test-namespaces [java-http-clj.smoke-test], :manually-added true} + rewrite-clj/rewrite-clj {:git-url "https://github.com/clj-commons/rewrite-clj", :test-namespaces [rewrite-clj.parser-test rewrite-clj.node-test rewrite-clj.zip-test rewrite-clj.paredit-test rewrite-clj.zip.subedit-test rewrite-clj.node.coercer-test], :manually-added true} + ;; TODO: env tests don't work because envoy lib isn't compatible with bb + ;; 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: 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} + 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"} + ;; BB-TEST-PATCH: Remove contajners.core-test as it fails + org.clojars.lispyclouds/contajners {:git-url "https://github.com/lispyclouds/contajners", :test-namespaces (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 + ;; BB-TEST-PATCH: Don't run on windows as most binary tests fail + io.aviso/pretty {:git-url "https://github.com/AvisoNovate/pretty", :test-namespaces (io.aviso.binary-test), :git-sha "155926f991f94addaf6f5c8621748924ab144988" :skip-windows true} + progrock/progrock {:git-url "https://github.com/weavejester/progrock", :test-namespaces (progrock.core-test), :git-sha "9c277a3244c52bfde19c21add327d6e20b94fdf5"} + ;; Don't run portal.jvm-test as it depends on headless chrome + djblue/portal {:git-url "https://github.com/djblue/portal", :test-namespaces (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/bond/assertions_test.clj b/test-resources/lib_tests/bond/assertions_test.clj new file mode 100644 index 00000000..1969600a --- /dev/null +++ b/test-resources/lib_tests/bond/assertions_test.clj @@ -0,0 +1,121 @@ +(ns bond.assertions-test + (:require [clojure.test :refer (deftest is testing)] + [bond.assertions :as assertions] + [bond.james :as bond :include-macros true] + [bond.target-data :as target])) + +(deftest called?-works + (testing "a spy was called directly" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called? target/foo)))) + + (testing "a spy was called indirectly" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called? target/foo)))) + + (testing "a spy was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called? target/foo))))) + + (testing "called? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called? target/foo))))) + +(deftest called-times?-works + (testing "the number of times a spy was called" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called-times? target/foo 1)) + (target/foo 2) + (is (assertions/called-times? target/foo 2)))) + + (testing "the number of times a spy was not called" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (not (assertions/called-times? target/foo 2))) + (target/foo-caller 2) + (is (not (assertions/called-times? target/foo 1))))) + + (testing "called-times? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-times? target/foo 0))))) + +(deftest called-with-args?-works + (testing "an assertion for calling a spy with args" + (bond/with-spy [target/foo + target/bar] + (target/foo-caller 1) + (is (assertions/called-with-args? target/foo [[1]])) + (is (not (assertions/called-with-args? target/foo [[2]]))) + (is (not (assertions/called-with-args? target/bar [[1]]))) + (is (not (assertions/called-with-args? target/foo [[1 2]]))))) + + (testing "an assertion for calling a spy multiple times with args" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (target/foo-caller 2) + (is (assertions/called-with-args? target/foo [[1] [2]])))) + + (testing "called-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-with-args? target/foo []))))) + +(deftest called-once-with-args?-works + (testing "an assertion for calling a spy once with args" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called-once-with-args? target/foo [1])) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy twice with args" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 2) + (is (not (assertions/called-once-with-args? target/foo [1]))) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy indirectly once with args" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called-once-with-args? target/foo [1])) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for a spy that was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called-once-with-args? target/foo []))))) + + (testing "called-once-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-once-with-args? target/foo []))))) + +(deftest called-at-least-once-with-args?-works + (testing "an assertion for calling a spy multiple times" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 2) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (assertions/called-at-least-once-with-args? target/foo [2])) + (is (not (assertions/called-at-least-once-with-args? target/foo [3]))))) + + (testing "an assertion for calling a spy multiple times with the same value" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 1) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (not (assertions/called-at-least-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy once" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (not (assertions/called-at-least-once-with-args? target/foo [2]))))) + + (testing "an assertion for a spy that was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called-at-least-once-with-args? target/foo []))))) + + (testing "called-at-least-once-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-at-least-once-with-args? target/foo []))))) diff --git a/test-resources/lib_tests/bond/james_test.clj b/test-resources/lib_tests/bond/james_test.clj new file mode 100644 index 00000000..f6a5696f --- /dev/null +++ b/test-resources/lib_tests/bond/james_test.clj @@ -0,0 +1,109 @@ +(ns bond.james-test + {:clj-kondo/config {:linters {:private-call {:level :off} + :invalid-arity {:level :off}}}} + (:require [clojure.test :refer (deftest is testing)] + [bond.james :as bond :include-macros true] + [bond.target-data :as target])) + +(deftest spy-logs-args-and-results + (bond/with-spy [target/foo] + (is (= 2 (target/foo 1))) + (is (= 4 (target/foo 2))) + (is (= [{:args [1] :return 2} + {:args [2] :return 4}] + (bond/calls target/foo))) + (let [exception (is (thrown? clojure.lang.ArityException (target/foo 3 4)))] + (is (= {:args [3 4] :throw exception} + (-> target/foo bond/calls last)))))) + +(deftest calls-fails-on-unspied-fns + (is (thrown? IllegalArgumentException + (bond/calls target/foo)))) + +(deftest spy-can-spy-private-fns + (bond/with-spy [target/private-foo] + (is (= 4 (#'target/private-foo 2))) + (is (= 6 (#'target/private-foo 3))) + (is (= [{:args [2] :return 4} + {:args [3] :return 6}] + (bond/calls #'target/private-foo))))) + +(deftest stub-works + (is (= "" + (with-out-str + (bond/with-stub [target/bar] + (target/bar 3)))))) + +(deftest stub-works-with-private-fn + (testing "without replacement" + (bond/with-stub [target/private-foo] + (is (nil? (#'target/private-foo 3))) + (is (= [3] (-> #'target/private-foo bond/calls first :args))))) + (testing "with replacement" + (bond/with-stub [[target/private-foo (fn [x] (* x x))]] + (is (= 9 (#'target/private-foo 3))) + (is (= [3] (-> #'target/private-foo bond/calls first :args)))))) + +(deftest stub-with-replacement-works + (bond/with-stub [target/foo + [target/bar #(str "arg is " %)]] + (testing "stubbing works" + (is (nil? (target/foo 4))) + (is (= "arg is 3" (target/bar 3)))) + (testing "spying works" + (is (= [4] (-> target/foo bond/calls first :args))) + (is (= [3] (-> target/bar bond/calls first :args)))))) + + +(deftest iterator-style-stubbing-works + (bond/with-stub [target/foo + [target/bar [#(str "first arg is " %) + #(str "second arg is " %) + #(str "third arg is " %)]]] + (testing "stubbing works" + (is (nil? (target/foo 4))) + (is (= "first arg is 3" (target/bar 3))) + (is (= "second arg is 4" (target/bar 4))) + (is (= "third arg is 5" (target/bar 5)))) + (testing "spying works" + (is (= [4] (-> target/foo bond/calls first :args))) + (is (= [3] (-> target/bar bond/calls first :args))) + (is (= [4] (-> target/bar bond/calls second :args))) + (is (= [5] (-> target/bar bond/calls last :args)))))) + +(deftest stub!-complains-loudly-if-there-is-no-arglists + (is (thrown? IllegalArgumentException + (bond/with-stub! [[target/without-arglists (constantly 42)]] + (throw (Exception. "shouldn't get here")))))) + +(deftest stub!-throws-arity-exception + (bond/with-stub! [[target/foo (constantly 9)]] + (is (= 9 (target/foo 12))) + (is (= [{:args [12] :return 9}] (bond/calls target/foo)))) + (bond/with-stub! [target/bar + target/quuk + [target/quux (fn [_ _ & x] x)]] + (is (thrown? clojure.lang.ArityException + (target/bar 1 2))) + (is (thrown? clojure.lang.ArityException + (target/quuk 1))) + (is (= [6 5] (target/quux 8 7 6 5))))) + +(deftest spying-entire-namespaces-works + (bond/with-spy-ns [bond.target-data] + (target/foo 1) + (target/foo 2) + (is (= [{:args [1] :return 2} + {:args [2] :return 4}] + (bond/calls target/foo))) + (is (= 0 (-> target/bar bond/calls count))))) + +(deftest stubbing-entire-namespaces-works + (testing "without replacements" + (bond/with-stub-ns [bond.target-data] + (is (nil? (target/foo 10))) + (is (= [10] (-> target/foo bond/calls first :args))))) + (testing "with replacements" + (bond/with-stub-ns [[bond.target-data (constantly 3)]] + (is (= 3 (target/foo 10))) + (is (= [10] (-> target/foo bond/calls first :args)))))) diff --git a/test-resources/lib_tests/bond/target_data.clj b/test-resources/lib_tests/bond/target_data.clj new file mode 100644 index 00000000..986a06de --- /dev/null +++ b/test-resources/lib_tests/bond/target_data.clj @@ -0,0 +1,35 @@ +(ns bond.target-data + "Reference def targets for bond to test against." + {:clj-kondo/config {:linters {:unused-binding {:level :off} + :unused-private-var {:level :off}}}}) + +(defn foo + [x] + (* 2 x)) + +(defn- private-foo + [x] + (* 2 x)) + +(defn foo-caller [x] + (foo x)) + +(defn bar + [x] + (println "bar!") (* 2 x)) + +(defn quux + [a b & c] + c) + +(defn quuk + [a b & c] + c) + +(defmacro baz + [x] + `(* ~x 2)) + +(def without-arglists + (fn [x] + (* 2 x))) diff --git a/test-resources/lib_tests/borkdude/deps/smoke_test.clj b/test-resources/lib_tests/borkdude/deps/smoke_test.clj new file mode 100644 index 00000000..50781333 --- /dev/null +++ b/test-resources/lib_tests/borkdude/deps/smoke_test.clj @@ -0,0 +1,20 @@ +(ns borkdude.deps.smoke-test + (:require [clojure.test :as t :refer [deftest is]] + [clojure.java.io :as io] + [clojure.string :as str] + [babashka.curl :as curl])) + + +(def windows? (-> (System/getProperty "os.name") + (str/lower-case) + (str/includes? "win"))) + +(deftest basic-test + (spit "deps_test.clj" + (:body (curl/get "https://raw.githubusercontent.com/borkdude/deps.clj/master/deps.clj" + (if windows? {:compressed false} {})))) + + (binding [*command-line-args* ["-Sdescribe"]] + (load-file "deps_test.clj")) + + (.delete (io/file "deps_test.clj"))) 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/camel_snake_kebab/core_test.cljc b/test-resources/lib_tests/camel_snake_kebab/core_test.cljc index ab65cb53..cf426706 100644 --- a/test-resources/lib_tests/camel_snake_kebab/core_test.cljc +++ b/test-resources/lib_tests/camel_snake_kebab/core_test.cljc @@ -47,7 +47,11 @@ (testing "handling of blank input string" (is (= "" (csk/->kebab-case ""))) - (is (= "" (csk/->kebab-case " "))))) + (is (= "" (csk/->kebab-case " ")))) + + (testing "handling of input consisting of only separator(s)" + (is (= "" (csk/->kebab-case "a" :separator \a))) + (is (= "" (csk/->kebab-case "aa" :separator \a))))) (deftest http-header-case-test (are [x y] (= x (csk/->HTTP-Header-Case y)) diff --git a/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc b/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc new file mode 100644 index 00000000..81d0c08f --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc @@ -0,0 +1,16 @@ +(ns camel-snake-kebab.extras-test + (:require [camel-snake-kebab.core :as csk] + [camel-snake-kebab.extras :refer [transform-keys]] + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest testing is are]]))) + +(deftest transform-keys-test + (are [x y] (= x (transform-keys csk/->kebab-case-keyword y)) + nil nil + {} {} + [] [] + {:total-books 0 :all-books []} {'total_books 0 "allBooks" []} + [{:the-author "Dr. Seuss" :the-title "Green Eggs and Ham"}] + [{'the-Author "Dr. Seuss" "The_Title" "Green Eggs and Ham"}] + {:total-books 1 :all-books [{:the-author "Dr. Seuss" :the-title "Green Eggs and Ham"}]} + {'total_books 1 "allBooks" [{'THE_AUTHOR "Dr. Seuss" "the_Title" "Green Eggs and Ham"}]})) diff --git a/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc b/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc new file mode 100644 index 00000000..31a5704a --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc @@ -0,0 +1,41 @@ +(ns camel-snake-kebab.internals.string-separator-test + (:require [camel-snake-kebab.internals.string-separator :refer [split generic-separator]] + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest testing is are]]))) + +(deftest split-test + (testing "regex, string and character separators" + (are [sep] + (and (= ["foo" "bar"] (split sep "foo.bar")) + (= [""] (split sep ""))) + #"\." "." \.)) + + (testing "input consisting of separator(s)" + (is (empty? (split "x" "x"))) + (is (empty? (split "x" "xx")))) + + (testing "generic separator" + (are [x y] + (= x (split generic-separator y)) + + [""] "" + [""] " " + ["x"] " x " + + ["foo" "bar"] "foo bar" + ["foo" "bar"] "foo\n\tbar" + ["foo" "bar"] "foo-bar" + ["foo" "Bar"] "fooBar" + ["Foo" "Bar"] "FooBar" + ["foo" "bar"] "foo_bar" + ["FOO" "BAR"] "FOO_BAR" + + ["räksmörgås"] "räksmörgås" + + ["IP" "Address"] "IPAddress" + + ["Adler" "32"] "Adler32" + ["Inet" "4" "Address"] "Inet4Address" + ["Arc" "2" "D"] "Arc2D" + ["a" "123b"] "a123b" + ["A" "123" "B"] "A123B"))) diff --git a/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs b/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs new file mode 100644 index 00000000..20b094bd --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs @@ -0,0 +1,10 @@ +(ns camel-snake-kebab.test-runner + (:require [cljs.test :as test] + [doo.runner :refer-macros [doo-all-tests doo-tests]] + [camel-snake-kebab.core-test] + [camel-snake-kebab.extras-test] + [camel-snake-kebab.internals.string-separator-test])) + +(doo-tests 'camel-snake-kebab.core-test + 'camel-snake-kebab.extras-test + 'camel-snake-kebab.internals.string-separator-test) diff --git a/test-resources/lib_tests/clj_http/lite/client_test.clj b/test-resources/lib_tests/clj_http/lite/client_test.clj index d6a2ba89..86407b69 100644 --- a/test-resources/lib_tests/clj_http/lite/client_test.clj +++ b/test-resources/lib_tests/clj_http/lite/client_test.clj @@ -24,11 +24,12 @@ :accept :json :throw-exceptions false}))))) -(deftest insecure-test - (is (= 200 (:status (client/get "https://self-signed.badssl.com/" {:insecure? true}))))) - (deftest exception-test (try (client/get "https://site.com/broken") (is false "should not reach here") (catch Exception e (is (:headers (ex-data e)))))) + +;; BB-TEST-PATCH: Added test +(deftest insecure-test + (is (= 200 (:status (client/get "https://self-signed.badssl.com/" {:insecure? true}))))) diff --git a/test-resources/lib_tests/clj_http/lite/test_runner.clj b/test-resources/lib_tests/clj_http/lite/test_runner.clj new file mode 100644 index 00000000..b793c578 --- /dev/null +++ b/test-resources/lib_tests/clj_http/lite/test_runner.clj @@ -0,0 +1,10 @@ +(ns clj-http.lite.test-runner + (:require [clj-http.lite.client-test] + [clojure.test :as t])) + +(defn -main [& _] + (let [{:keys [fail error]} (t/run-tests 'clj-http.lite.client-test)] + (System/exit (if (or (pos? fail) + (pos? error)) + 1 0)))) + diff --git a/test-resources/lib_tests/clj_yaml/core_test.clj b/test-resources/lib_tests/clj_yaml/core_test.clj index 0e75a4d6..cf705ece 100644 --- a/test-resources/lib_tests/clj_yaml/core_test.clj +++ b/test-resources/lib_tests/clj_yaml/core_test.clj @@ -1,8 +1,15 @@ (ns clj-yaml.core-test (:require [clojure.test :refer (deftest testing is)] [clojure.string :as string] - [clj-yaml.core :refer [parse-string unmark generate-string]]) - (:import [java.util Date])) + [clojure.java.io :as io] + [clj-yaml.core :refer [parse-string unmark generate-string + parse-stream generate-stream]]) + (:import [java.util Date] + (java.io ByteArrayOutputStream OutputStreamWriter ByteArrayInputStream) + java.nio.charset.StandardCharsets + (org.yaml.snakeyaml.error YAMLException) + ;; BB-TEST-PATCH: bb doesn't have these classes + #_(org.yaml.snakeyaml.constructor DuplicateKeyException))) (def nested-hash-yaml "root:\n childa: a\n childb: \n grandchild: \n greatgrandchild: bar\n") @@ -27,7 +34,7 @@ items: ") (def inline-list-yaml -"--- # Shopping list + "--- # Shopping list [milk, pumpkin pie, eggs, juice] ") @@ -160,8 +167,8 @@ the-bin: !!binary 0101") ;; This test ensures that generate-string uses the older behavior by default, for the sake ;; of stability, i.e. backwards compatibility. (is - (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" - (generate-string data)))))) + (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" + (generate-string data)))))) (deftest dump-opts (let [data [{:age 33 :name "jon"} {:age 44 :name "boo"}]] @@ -170,9 +177,7 @@ the-bin: !!binary 0101") (is (= "[{age: 33, name: jon}, {age: 44, name: boo}]\n" (generate-string data :dumper-options {:flow-style :flow}))))) -;; TODO: this test is failing in GraalVM -;; Could be related to https://github.com/oracle/graal/issues/2234 -#_(deftest parse-time +(deftest parse-time (testing "clj-time parses timestamps with more than millisecond precision correctly." (let [timestamp "2001-11-23 15:02:31.123456 -04:00" expected 1006542151123] @@ -182,7 +187,7 @@ the-bin: !!binary 0101") (let [parsed (parse-string hashes-lists-yaml) [first second] (:items parsed)] (is (= (keys first) '(:part_no :descrip :price :quantity))) - (is (= (keys second)'(:part_no :descrip :price :quantity :owners))))) + (is (= (keys second) '(:part_no :descrip :price :quantity :owners))))) (deftest nulls-are-fine @@ -201,3 +206,90 @@ the-bin: !!binary 0101") (testing "emoji in comments are OK too" (let [yaml "# 💣 emoji in a comment\n42"] (is (= 42 (parse-string yaml)))))) + +(def too-many-aliases + (->> (range 51) + (map #(str "b" % ": *a")) + (cons "a: &a [\"a\",\"a\"]") + (string/join "\n"))) + +(deftest max-aliases-for-collections-works + (is (thrown-with-msg? YAMLException #"Number of aliases" (parse-string too-many-aliases))) + (is (parse-string too-many-aliases :max-aliases-for-collections 51))) + +(def recursive-yaml " +--- +&A +- *A: *A +") + +(deftest allow-recursive-works + (is (thrown-with-msg? YAMLException #"Recursive" (parse-string recursive-yaml))) + (is (parse-string recursive-yaml :allow-recursive-keys true))) + +(def duplicate-keys-yaml " +a: 1 +a: 1 +") + +#_(deftest duplicate-keys-works + (is (parse-string duplicate-keys-yaml)) + (is (thrown-with-msg? DuplicateKeyException #"found duplicate key" (parse-string duplicate-keys-yaml :allow-duplicate-keys false)))) + +(def namespaced-keys-yaml " +foo/bar: 42 +") + +(deftest namespaced-keys-works + (testing "namespaced keys in yaml can round trip through parse and generate" + (is (= {:foo/bar 42} (-> namespaced-keys-yaml + parse-string + generate-string + parse-string))))) + +(defn to-bytes + "Converts a string to a byte array." + [data] + (.getBytes ^String data StandardCharsets/UTF_8)) + +(defn roundtrip + "Testing roundtrip of string and stream parser, and checking their equivalence." + [data-as-string] + (let [data (parse-string data-as-string) + data-stream (parse-stream (io/reader (ByteArrayInputStream. (to-bytes data-as-string)))) + output-stream (ByteArrayOutputStream.) + writer (OutputStreamWriter. output-stream) + _ (generate-stream writer data) + reader (ByteArrayInputStream. (.toByteArray output-stream))] + (= data ;; string -> edn + (parse-string (generate-string data)) ;; edn -> string -> edn + (parse-stream (io/reader reader)) ;; edn -> stream -> edn + ;; stream -> edn + data-stream))) + +(deftest roundtrip-test + (testing "Roundtrip test" + (is (roundtrip duplicate-keys-yaml)) + (is (roundtrip hashes-of-lists-yaml)) + (is (roundtrip inline-hash-yaml)) + (is (roundtrip inline-list-yaml)) + (is (roundtrip list-of-hashes-yaml)) + (is (roundtrip list-yaml)) + (is (roundtrip nested-hash-yaml)))) + +(def indented-yaml "todo: + - name: Fix issue + responsible: + name: Rita +") + +;; BB-TEST-PATCH - bb generates different indents +#_(deftest indentation-test + (testing "Can use indicator-indent and indent to achieve desired indentation" + (is (not= indented-yaml (generate-string (parse-string indented-yaml) + :dumper-options {:flow-style :block}))) + (is (= indented-yaml + (generate-string (parse-string indented-yaml) + :dumper-options {:indent 5 + :indicator-indent 2 + :flow-style :block}))))) diff --git a/test-resources/lib_tests/clojure/data/generators_test.clj b/test-resources/lib_tests/clojure/data/generators_test.clj index 8fa89e88..00628d83 100644 --- a/test-resources/lib_tests/clojure/data/generators_test.clj +++ b/test-resources/lib_tests/clojure/data/generators_test.clj @@ -32,4 +32,4 @@ (gen/reservoir-sample 10 coll)) sample-2 (binding [gen/*rnd* (java.util.Random. n)] (gen/reservoir-sample 10 coll))] - (is (= sample-1 sample-2))))) \ No newline at end of file + (is (= sample-1 sample-2))))) diff --git a/test-resources/lib_tests/clojure/data/json_test.clj b/test-resources/lib_tests/clojure/data/json_test.clj index 61ac8380..0bed8eb4 100644 --- a/test-resources/lib_tests/clojure/data/json_test.clj +++ b/test-resources/lib_tests/clojure/data/json_test.clj @@ -414,6 +414,7 @@ (is (= x (json/read-str (with-out-str (json/pprint x))))))) (deftest pretty-print-nonescaped-unicode + ;; BB-TEST-PATCH: Windows compatability (is (= (str "\"\u1234\u4567\"" (System/lineSeparator)) (with-out-str (json/pprint "\u1234\u4567" :escape-unicode false))))) diff --git a/test-resources/lib_tests/clojure/data/zip_test.clj b/test-resources/lib_tests/clojure/data/zip_test.clj new file mode 100644 index 00000000..7b494678 --- /dev/null +++ b/test-resources/lib_tests/clojure/data/zip_test.clj @@ -0,0 +1,17 @@ +(ns clojure.data.zip-test + (:require [clojure.test :as t :refer [deftest is]] + [clojure.data.xml :as xml] + [clojure.zip :as zip] + [clojure.data.zip.xml :refer [attr attr= xml1->]])) + +(def data (str "" + " " + " " + "")) + +(deftest xml1-test + (let [xml (zip/xml-zip (xml/parse (java.io.StringReader. data)))] + (is (= "person" + (xml1-> xml :character [(attr= :name "alice")] (attr :type)))) + (is (= "march hare" + (xml1-> xml :character [(attr= :type "animal")] (attr :name)))))) 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/clojure/test_clojure/instr.clj b/test-resources/lib_tests/clojure/test_clojure/instr.clj index e6b1e238..670a1e3c 100644 --- a/test-resources/lib_tests/clojure/test_clojure/instr.clj +++ b/test-resources/lib_tests/clojure/test_clojure/instr.clj @@ -95,6 +95,7 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 2 :not-num 3))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" (try (fail-no-kwargs 1 :not-num) (catch Exception ei @@ -151,14 +152,15 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 2 :a 1 {:b :not-num}))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" - (try (fail-kwargs 1 :not-num) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) + (try (fail-kwargs 1 :not-num) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) - (try (fail-kwargs 1 2 :a 1 {:b :not-num}) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) + (try (fail-kwargs 1 2 :a 1 {:b :not-num}) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) (testing "that the uninstrumented kwargs function operates as the raw function" (stest/unstrument `kwargs-fn) diff --git a/test-resources/lib_tests/clojure/test_clojure/spec.clj b/test-resources/lib_tests/clojure/test_clojure/spec.clj index 290ad43d..8c6fb7e6 100644 --- a/test-resources/lib_tests/clojure/test_clojure/spec.clj +++ b/test-resources/lib_tests/clojure/test_clojure/spec.clj @@ -1,11 +1,3 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - (ns clojure.test-clojure.spec (:require [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] @@ -167,6 +159,7 @@ (is (= (s/describe odd?) 'odd?)) (is (= (s/form odd?) 'clojure.core/odd?)) + ;; BB-TEST-PATCH: Returns sci internal #_(is (= (s/describe #(odd? %)) ::s/unknown)) #_(is (= (s/form #(odd? %)) ::s/unknown))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj new file mode 100644 index 00000000..5aedb27f --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj @@ -0,0 +1,315 @@ +(ns clojure.tools.namespace.dependency-test + (:use clojure.test + clojure.tools.namespace.dependency)) + +;; building a graph like: +;; +;; :a +;; / | +;; :b | +;; \ | +;; :c +;; | +;; :d +;; +(def g1 (-> (graph) + (depend :b :a) ; "B depends on A" + (depend :c :b) ; "C depends on B" + (depend :c :a) ; "C depends on A" + (depend :d :c))) ; "D depends on C" + +;; 'one 'five +;; | | +;; 'two | +;; / \ | +;; / \ | +;; / \ / +;; 'three 'four +;; | / +;; 'six / +;; | / +;; | / +;; | / +;; 'seven +;; +(def g2 (-> (graph) + (depend 'two 'one) + (depend 'three 'two) + (depend 'four 'two) + (depend 'four 'five) + (depend 'six 'three) + (depend 'seven 'six) + (depend 'seven 'four))) + +;; :level0 +;; / | | \ +;; ----- | | ----- +;; / | | \ +;; :level1a :level1b :level1c :level1d +;; \ | | / +;; ----- | | ----- +;; \ | | / +;; :level2 +;; / | | \ +;; ----- | | ----- +;; / | | \ +;; :level3a :level3b :level3c :level3d +;; \ | | / +;; ----- | | ----- +;; \ | | / +;; :level4 +;; +;; ... and so on in a repeating pattern like that, up to :level26 + +(def g3 (-> (graph) + (depend :level1a :level0) + (depend :level1b :level0) + (depend :level1c :level0) + (depend :level1d :level0) + (depend :level2 :level1a) + (depend :level2 :level1b) + (depend :level2 :level1c) + (depend :level2 :level1d) + + (depend :level3a :level2) + (depend :level3b :level2) + (depend :level3c :level2) + (depend :level3d :level2) + (depend :level4 :level3a) + (depend :level4 :level3b) + (depend :level4 :level3c) + (depend :level4 :level3d) + + (depend :level5a :level4) + (depend :level5b :level4) + (depend :level5c :level4) + (depend :level5d :level4) + (depend :level6 :level5a) + (depend :level6 :level5b) + (depend :level6 :level5c) + (depend :level6 :level5d) + + (depend :level7a :level6) + (depend :level7b :level6) + (depend :level7c :level6) + (depend :level7d :level6) + (depend :level8 :level7a) + (depend :level8 :level7b) + (depend :level8 :level7c) + (depend :level8 :level7d) + + (depend :level9a :level8) + (depend :level9b :level8) + (depend :level9c :level8) + (depend :level9d :level8) + (depend :level10 :level9a) + (depend :level10 :level9b) + (depend :level10 :level9c) + (depend :level10 :level9d) + + (depend :level11a :level10) + (depend :level11b :level10) + (depend :level11c :level10) + (depend :level11d :level10) + (depend :level12 :level11a) + (depend :level12 :level11b) + (depend :level12 :level11c) + (depend :level12 :level11d) + + (depend :level13a :level12) + (depend :level13b :level12) + (depend :level13c :level12) + (depend :level13d :level12) + (depend :level14 :level13a) + (depend :level14 :level13b) + (depend :level14 :level13c) + (depend :level14 :level13d) + + (depend :level15a :level14) + (depend :level15b :level14) + (depend :level15c :level14) + (depend :level15d :level14) + (depend :level16 :level15a) + (depend :level16 :level15b) + (depend :level16 :level15c) + (depend :level16 :level15d) + + (depend :level17a :level16) + (depend :level17b :level16) + (depend :level17c :level16) + (depend :level17d :level16) + (depend :level18 :level17a) + (depend :level18 :level17b) + (depend :level18 :level17c) + (depend :level18 :level17d) + + (depend :level19a :level18) + (depend :level19b :level18) + (depend :level19c :level18) + (depend :level19d :level18) + (depend :level20 :level19a) + (depend :level20 :level19b) + (depend :level20 :level19c) + (depend :level20 :level19d) + + (depend :level21a :level20) + (depend :level21b :level20) + (depend :level21c :level20) + (depend :level21d :level20) + (depend :level22 :level21a) + (depend :level22 :level21b) + (depend :level22 :level21c) + (depend :level22 :level21d) + + (depend :level23a :level22) + (depend :level23b :level22) + (depend :level23c :level22) + (depend :level23d :level22) + (depend :level24 :level23a) + (depend :level24 :level23b) + (depend :level24 :level23c) + (depend :level24 :level23d) + + (depend :level25a :level24) + (depend :level25b :level24) + (depend :level25c :level24) + (depend :level25d :level24) + (depend :level26 :level25a) + (depend :level26 :level25b) + (depend :level26 :level25c) + (depend :level26 :level25d))) + +(deftest t-transitive-dependencies + (is (= #{:a :c :b} + (transitive-dependencies g1 :d))) + (is (= '#{two four six one five three} + (transitive-dependencies g2 'seven)))) + +(deftest t-transitive-dependencies-deep + (is (= #{:level0 + :level1a :level1b :level1c :level1d + :level2 + :level3a :level3b :level3c :level3d + :level4 + :level5a :level5b :level5c :level5d + :level6 + :level7a :level7b :level7c :level7d + :level8 + :level9a :level9b :level9c :level9d + :level10 + :level11a :level11b :level11c :level11d + :level12 + :level13a :level13b :level13c :level13d + :level14 + :level15a :level15b :level15c :level15d + :level16 + :level17a :level17b :level17c :level17d + :level18 + :level19a :level19b :level19c :level19d + :level20 + :level21a :level21b :level21c :level21d + :level22 + :level23a :level23b :level23c :level23d} + (transitive-dependencies g3 :level24))) + (is (= #{:level0 + :level1a :level1b :level1c :level1d + :level2 + :level3a :level3b :level3c :level3d + :level4 + :level5a :level5b :level5c :level5d + :level6 + :level7a :level7b :level7c :level7d + :level8 + :level9a :level9b :level9c :level9d + :level10 + :level11a :level11b :level11c :level11d + :level12 + :level13a :level13b :level13c :level13d + :level14 + :level15a :level15b :level15c :level15d + :level16 + :level17a :level17b :level17c :level17d + :level18 + :level19a :level19b :level19c :level19d + :level20 + :level21a :level21b :level21c :level21d + :level22 + :level23a :level23b :level23c :level23d + :level24 + :level25a :level25b :level25c :level25d} + (transitive-dependencies g3 :level26)))) + + +(deftest t-transitive-dependents + (is (= '#{four seven} + (transitive-dependents g2 'five))) + (is (= '#{four seven six three} + (transitive-dependents g2 'two)))) + +(defn- before? + "True if x comes before y in an ordered collection." + [coll x y] + (loop [[item & more] (seq coll)] + (cond (nil? item) true ; end of the seq + (= x item) true ; x comes first + (= y item) false + :else (recur more)))) + +(deftest t-before + (is (true? (before? [:a :b :c :d] :a :b))) + (is (true? (before? [:a :b :c :d] :b :c))) + (is (false? (before? [:a :b :c :d] :d :c))) + (is (false? (before? [:a :b :c :d] :c :a)))) + +(deftest t-topo-comparator-1 + (let [sorted (sort (topo-comparator g1) [:d :a :b :foo])] + (are [x y] (before? sorted x y) + :a :b + :a :d + :a :foo + :b :d + :b :foo + :d :foo))) + +(deftest t-topo-comparator-2 + (let [sorted (sort (topo-comparator g2) '[three seven nine eight five])] + (are [x y] (before? sorted x y) + 'three 'seven + 'three 'eight + 'three 'nine + 'five 'eight + 'five 'nine + 'seven 'eight + 'seven 'nine))) + +(deftest t-topo-sort + (let [sorted (topo-sort g2)] + (are [x y] (before? sorted x y) + 'one 'two + 'one 'three + 'one 'four + 'one 'six + 'one 'seven + 'two 'three + 'two 'four + 'two 'six + 'two 'seven + 'three 'six + 'three 'seven + 'four 'seven + 'five 'four + 'five 'seven + 'six 'seven))) + +(deftest t-no-cycles + (is (thrown? Exception + (-> (graph) + (depend :a :b) + (depend :b :c) + (depend :c :a))))) + +(deftest t-no-self-cycles + (is (thrown? Exception + (-> (graph) + (depend :a :b) + (depend :a :a))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj new file mode 100644 index 00000000..60e56427 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj @@ -0,0 +1,20 @@ +(ns clojure.tools.namespace.dir-test + (:require [clojure.test :refer [deftest is]] + [clojure.tools.namespace.test-helpers :as help] + [clojure.tools.namespace.dir :as dir]) + (:import + (java.io File))) + +;; Only run this test on Java 1.7+, where java.nio.file.Files is available. +(when (try (Class/forName "java.nio.file.Files") + (catch ClassNotFoundException _ false)) + (deftest t-scan-by-canonical-path + (let [dir (help/create-temp-dir "t-scan-by-canonical-path") + main-clj (help/create-source dir 'example.main :clj '[example.one]) + one-cljc (help/create-source dir 'example.one :clj) + other-dir (help/create-temp-dir "t-scan-by-canonical-path-other") + link (File. other-dir "link")] + (java.nio.file.Files/createSymbolicLink (.toPath link) (.toPath dir) + (make-array java.nio.file.attribute.FileAttribute 0)) + (is (= (::dir/files (dir/scan-dirs {} [dir])) + (::dir/files (dir/scan-dirs {} [link]))))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/find_test.clj b/test-resources/lib_tests/clojure/tools/namespace/find_test.clj new file mode 100644 index 00000000..d081e84a --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/find_test.clj @@ -0,0 +1,29 @@ +(ns clojure.tools.namespace.find-test + (:require [clojure.test :refer [deftest is]] + [clojure.tools.namespace.test-helpers :as help] + [clojure.tools.namespace.find :as find]) + (:import (java.io File))) + +(deftest t-find-clj-and-cljc-files + "main.clj depends on one.cljc which depends on two.clj. + two.cljs also exists but should not be returned" + (let [dir (help/create-temp-dir "t-find-clj-and-cljc-files") + main-clj (help/create-source dir 'example.main :clj '[example.one]) + one-cljc (help/create-source dir 'example.one :cljc '[example.two]) + two-clj (help/create-source dir 'example.two :clj) + two-cljs (help/create-source dir 'example.two :cljs)] + (is (help/same-files? + [main-clj one-cljc two-clj] + (find/find-sources-in-dir dir))))) + +(deftest t-find-cljs-and-cljc-files + "main.cljs depends on one.cljc which depends on two.cljs. + two.clj also exists but should not be returned" + (let [dir (help/create-temp-dir "t-find-cljs-and-cljc-files") + main-cljs (help/create-source dir 'example.main :cljs '[example.one]) + one-cljc (help/create-source dir 'example.one :cljc '[example.two]) + two-clj (help/create-source dir 'example.two :clj) + two-cljs (help/create-source dir 'example.two :cljs)] + (is (help/same-files? + [main-cljs one-cljc two-cljs] + (find/find-sources-in-dir dir find/cljs))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/move_test.clj b/test-resources/lib_tests/clojure/tools/namespace/move_test.clj new file mode 100644 index 00000000..47de7ac4 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/move_test.clj @@ -0,0 +1,52 @@ +(ns clojure.tools.namespace.move-test + (:require [clojure.java.io :as io] + [clojure.test :refer [deftest is]] + [clojure.tools.namespace.move :refer [move-ns]] + [clojure.tools.namespace.test-helpers :as help]) + (:import (java.io File))) + +(defn- create-file-one [dir] + (help/create-source dir 'example.one :clj + '[example.two example.three] + '[(defn foo [] + (example.a.four/foo))])) + +(defn- create-file-two [dir] + (help/create-source dir 'example.two :clj + '[example.three example.a.four])) + +(defn- create-file-three [dir] + (help/create-source dir 'example.three :clj + '[example.five])) + +(defn- create-file-four [dir] + (help/create-source dir 'example.a.four :clj)) + +(deftest t-move-ns + (let [temp-dir (help/create-temp-dir "tools-namespace-t-move-ns") + src-dir (io/file temp-dir "src") + example-dir (io/file temp-dir "src" "example") + file-one (create-file-one src-dir) + file-two (create-file-two src-dir) + file-three (create-file-three src-dir) + old-file-four (create-file-four src-dir) + new-file-four (io/file example-dir "b" "four.clj")] + + (let [file-three-last-modified (.lastModified file-three)] + + (Thread/sleep 1500) ;; ensure file timestamps are different + + (move-ns 'example.a.four 'example.b.four src-dir [src-dir]) + + (is (.exists new-file-four) + "new file should exist") + (is (not (.exists old-file-four)) + "old file should not exist") + (is (not (.exists (.getParentFile old-file-four))) + "old empty directory should not exist") + (is (= file-three-last-modified (.lastModified file-three)) + "unaffected file should not have been modified") + (is (not-any? #(.contains (slurp %) "example.a.four") + [file-one file-two file-three new-file-four])) + (is (every? #(.contains (slurp %) "example.b.four") + [file-one file-two new-file-four]))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj b/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj new file mode 100644 index 00000000..b6ac6aaa --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj @@ -0,0 +1,210 @@ +(ns clojure.tools.namespace.parse-test + (:use [clojure.test :only (deftest is)] + [clojure.tools.namespace.parse :only (deps-from-ns-decl + read-ns-decl)])) + +(def ns-decl-prefix-list + '(ns com.example.one + (:require (com.example two + [three :as three] + [four :refer (a b)]) + (com.example.sub [five :as five] + six)) + (:use (com.example seven + [eight :as eight] + (nine :only (c d)) + [ten])))) + +;; Some people like to write prefix lists as vectors, not lists. The +;; use/require functions accept this form. +(def ns-decl-prefix-list-as-vector + '(ns com.example.one + (:require [com.example + two + [three :as three] + [four :refer (a b)]] + [com.example.sub + [five :as five] + six]) + (:use [com.example + seven + [eight :as eight] + (nine :only (c d)) + [ten]]))) + +(def ns-decl-prefix-list-clauses-as-vectors + "Sometimes people even write the clauses inside ns as vectors, which + clojure.core/ns allows. See TNS-21." + '(ns com.example.one + [:require [com.example + two + [three :as three] + [four :refer (a b)]] + [com.example.sub + [five :as five] + six]] + [:use [com.example + seven + [eight :as eight] + (nine :only (c d)) + [ten]]])) + +(def deps-from-prefix-list + '#{com.example.two + com.example.three + com.example.four + com.example.sub.five + com.example.sub.six + com.example.seven + com.example.eight + com.example.nine + com.example.ten}) + +(deftest t-prefix-list + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list)))) + +(deftest t-prefix-list-as-vector + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list-as-vector)))) + +(deftest t-prefix-list-clauses-as-vectors + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list-clauses-as-vectors)))) + +(deftest t-no-deps-returns-empty-set + (is (= #{} (deps-from-ns-decl '(ns com.example.one))))) + +(def multiple-ns-decls + '((ns one) + (ns two (:require one)) + (ns three (:require [one :as o] [two :as t])))) + +(def multiple-ns-decls-string +" (println \"Code before first ns\") + (ns one) + (println \"Some code\") + (defn hello-world [] \"Hello, World!\") + (ns two (:require one)) + (println \"Some more code\") + (ns three (:require [one :as o] [two :as t]))") + +(deftest t-read-multiple-ns-decls + (with-open [rdr (clojure.lang.LineNumberingPushbackReader. + (java.io.PushbackReader. + (java.io.StringReader. multiple-ns-decls-string)))] + (is (= multiple-ns-decls + (take-while identity (repeatedly #(read-ns-decl rdr))))))) + +(def ns-docstring-example + "The example ns declaration used in the docstring of clojure.core/ns" + '(ns foo.bar + (:refer-clojure :exclude [ancestors printf]) + (:require (clojure.contrib sql combinatorics)) + (:use (my.lib this that)) + (:import (java.util Date Timer Random) + (java.sql Connection Statement)))) + +(def deps-from-ns-docstring-example + '#{clojure.contrib.sql + clojure.contrib.combinatorics + my.lib.this + my.lib.that}) + +(deftest t-ns-docstring-example + (is (= deps-from-ns-docstring-example + (deps-from-ns-decl ns-docstring-example)))) + +(def require-docstring-example + "The example ns declaration used in the docstring of + clojure.core/require" + '(ns (:require (clojure zip [set :as s])))) + +(def deps-from-require-docstring-example + '#{clojure.zip + clojure.set}) + +(deftest t-require-docstring-example + (is (= deps-from-require-docstring-example + (deps-from-ns-decl require-docstring-example)))) + +(def multiple-clauses + "Example showing more than one :require or :use clause in one ns + declaration, which clojure.core/ns allows." + '(ns foo.bar + (:require com.example.one) + (:import java.io.File) + (:require (com.example two three)) + (:use (com.example [four :only [x]])) + (:use (com.example (five :only [x]))))) + +(def deps-from-multiple-clauses + '#{com.example.one + com.example.two + com.example.three + com.example.four + com.example.five}) + +(deftest t-deps-from-multiple-clauses + (is (= deps-from-multiple-clauses + (deps-from-ns-decl multiple-clauses)))) + +(def clauses-without-keywords + "Example of require/use clauses with symbols instead of keywords, + which clojure.core/ns allows." + '(ns foo.bar + (require com.example.one) + (import java.io.File) + (use (com.example (prefixes (two :only [x]) + three))))) + +(def deps-from-clauses-without-keywords + '#{com.example.one + com.example.prefixes.two + com.example.prefixes.three}) + +(deftest t-clauses-without-keywords + (is (= deps-from-clauses-without-keywords + (deps-from-ns-decl clauses-without-keywords)))) + +(def reader-conditionals-string + "(ns com.examples.one + (:require #?(:clj clojure.string + :cljs goog.string)))") + +(deftest t-reader-conditionals + ;; TODO: the predicate wasn't added to bb yet, will come in version after 0.6.7 + (when true #_(resolve 'clojure.core/reader-conditional?) + (let [actual (-> reader-conditionals-string + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'clojure.string} actual))))) + +(def ns-with-npm-dependency + "(ns com.examples.one + (:require [\"foobar\"] [baz]))") + +(deftest npm-dependency + (let [actual (-> ns-with-npm-dependency + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'baz} actual)))) + +(def ns-with-require-macros + "(ns com.examples.one + (:require-macros [foo :refer [bar]]))") + +(deftest require-macros + (let [actual (-> ns-with-require-macros + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'foo} actual)))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj b/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj new file mode 100644 index 00000000..62679e69 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj @@ -0,0 +1,82 @@ +(ns clojure.tools.namespace.test-helpers + "Utilities to help with testing files and namespaces." + (:require [clojure.java.io :as io] + [clojure.string :as string]) + (:import (java.io Closeable File Writer PrintWriter))) + +(defn create-temp-dir + "Creates and returns a new temporary directory java.io.File." + [name] + (let [temp-file (File/createTempFile name nil)] + (.delete temp-file) + (.mkdirs temp-file) + (println "Temporary directory" (.getAbsolutePath temp-file)) + temp-file)) + +(defn- write-contents + "Writes contents into writer. Strings are written as-is via println, + other types written as by prn." + [^Writer writer contents] + {:pre [(sequential? contents)]} + (binding [*out* (PrintWriter. writer)] + (doseq [content contents] + (if (string? content) + (println content) + (prn content)) + (newline)))) + +(defn create-file + "Creates a file from a vector of path elements. Writes contents into + the file. Elements of contents may be data, written via prn, or + strings, written directly." + [path contents] + {:pre [(vector? path)]} + (let [^File file (apply io/file path)] + (when-let [parent (.getParentFile file)] + (.mkdirs parent)) + (with-open [wtr (io/writer file)] + (write-contents wtr contents)) + file)) + +(defn- sym->path + "Converts a symbol name into a vector of path parts, not including + file extension." + [symbol] + {:pre [(symbol? symbol)] + :post [(vector? %)]} + (-> (name symbol) + (string/replace \- \_) + (string/split #"\."))) + +(defn- source-path + "Returns a vector of path components for namespace named sym, + with given file extension (keyword)." + [sym extension] + (let [path (sym->path sym) + basename (peek path) + filename (str basename \. (name extension))] + (conj (pop path) filename))) + +(defn create-source + "Creates a file at the correct path under base-dir for a namespace + named sym, with file extension (keyword), containing a ns + declaration which :require's the dependencies (symbols). Optional + contents written after the ns declaration as by write-contents." + ([base-dir sym extension] + (create-source base-dir sym extension nil nil)) + ([base-dir sym extension dependencies] + (create-source base-dir sym extension dependencies nil)) + ([base-dir sym extension dependencies contents] + (let [full-path (into [base-dir] (source-path sym extension)) + ns-decl (if (seq dependencies) + (list 'ns sym (list* :require dependencies)) + (list 'ns sym))] + (create-file full-path (into [ns-decl] contents))))) + +(defn same-files? + "True if files-a and files-b contain the same canonical File's, + regardless of order." + [files-a files-b] + (= (sort (map #(.getCanonicalPath ^File %) files-a)) + (sort (map #(.getCanonicalPath ^File %) files-b)))) + 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/com/stuartsierra/component_test.clj b/test-resources/lib_tests/com/stuartsierra/component_test.clj new file mode 100644 index 00000000..00602462 --- /dev/null +++ b/test-resources/lib_tests/com/stuartsierra/component_test.clj @@ -0,0 +1,307 @@ +(ns com.stuartsierra.component-test + (:require [clojure.test :refer (deftest is are)] + [clojure.set :refer (map-invert)] + [com.stuartsierra.component :as component])) + +(def ^:dynamic *log* nil) + +(defn- log [& args] + (when (thread-bound? #'*log*) + (set! *log* (conj *log* args)))) + +(defn- ordering + "Given an ordered collection of messages, returns a map from the + head of each message to its index position in the collection." + [log] + (into {} (map-indexed (fn [i [message & _]] [message i]) log))) + +(defn before? + "In the collection of messages, does the message beginning with + symbol a come before the message begging with symbol b?" + [log sym-a sym-b] + (let [order (ordering log)] + (< (get order sym-a) (get order sym-b)))) + +(defn started? [component] + (true? (::started? component))) + +(defn stopped? [component] + (false? (::started? component))) + +(defrecord ComponentA [state] + component/Lifecycle + (start [this] + (log 'ComponentA.start this) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentA.stop this) + (assoc this ::started? false))) + +(defn component-a [] + (->ComponentA (rand-int Integer/MAX_VALUE))) + +(defrecord ComponentB [state a] + component/Lifecycle + (start [this] + (log 'ComponentB.start this) + (assert (started? a)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentB.stop this) + (assert (started? a)) + (assoc this ::started? false))) + +(defn component-b [] + (component/using + (map->ComponentB {:state (rand-int Integer/MAX_VALUE)}) + [:a])) + +(defrecord ComponentC [state a b] + component/Lifecycle + (start [this] + (log 'ComponentC.start this) + (assert (started? a)) + (assert (started? b)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentC.stop this) + (assert (started? a)) + (assert (started? b)) + (assoc this ::started? false))) + +(defn component-c [] + (component/using + (map->ComponentC {:state (rand-int Integer/MAX_VALUE)}) + [:a :b])) + +(defrecord ComponentD [state my-c b] + component/Lifecycle + (start [this] + (log 'ComponentD.start this) + (assert (started? b)) + (assert (started? my-c)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentD.stop this) + (assert (started? b)) + (assert (started? my-c)) + (assoc this ::started? false))) + +(defn component-d [] + (map->ComponentD {:state (rand-int Integer/MAX_VALUE)})) + +(defrecord ComponentE [state] + component/Lifecycle + (start [this] + (log 'ComponentE.start this) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentE.stop this) + (assoc this ::started? false))) + +(defn component-e [] + (map->ComponentE {:state (rand-int Integer/MAX_VALUE)})) + +(defrecord System1 [d a e c b] ; deliberately scrambled order + component/Lifecycle + (start [this] + (log 'System1.start this) + (component/start-system this)) + (stop [this] + (log 'System1.stop this) + (component/stop-system this))) + +(defn system-1 [] + (map->System1 {:a (component-a) + :b (component-b) + :c (component-c) + :d (component/using (component-d) + {:b :b + :my-c :c}) + :e (component-e)})) + +(defmacro with-log [& body] + `(binding [*log* []] + ~@body + *log*)) + +(deftest components-start-in-order + (let [log (with-log (component/start (system-1)))] + (are [k1 k2] (before? log k1 k2) + 'ComponentA.start 'ComponentB.start + 'ComponentA.start 'ComponentC.start + 'ComponentB.start 'ComponentC.start + 'ComponentC.start 'ComponentD.start + 'ComponentB.start 'ComponentD.start))) + +(deftest all-components-started + (let [system (component/start (system-1))] + (doseq [component (vals system)] + (is (started? component))))) + +(deftest all-components-stopped + (let [system (component/stop (component/start (system-1)))] + (doseq [component (vals system)] + (is (stopped? component))))) + +(deftest dependencies-satisfied + (let [system (component/start (component/start (system-1)))] + (are [keys] (started? (get-in system keys)) + [:b :a] + [:c :a] + [:c :b] + [:d :my-c]))) + +(defrecord ErrorStartComponentC [state error a b] + component/Lifecycle + (start [this] + (throw error)) + (stop [this] + this)) + +(defn error-start-c [error] + (component/using + (map->ErrorStartComponentC {:error error}) + [:a :b])) + +(defn setup-error + ([] + (setup-error (ex-info "Boom!" {}))) + ([error] + (try (component/start + (assoc (system-1) :c (error-start-c error))) + (catch Exception e e)))) + +(deftest error-thrown-with-partial-system + (let [ex (setup-error)] + (is (started? (-> ex ex-data :system :b :a))))) + +(deftest error-thrown-with-component-dependencies + (let [ex (setup-error)] + (is (started? (-> ex ex-data :component :a))) + (is (started? (-> ex ex-data :component :b))))) + +(deftest error-thrown-with-cause + (let [error (ex-info "Boom!" {}) + ex (setup-error error)] + (is (identical? error (.getCause ^Exception ex))))) + +(deftest error-is-from-component + (let [error (ex-info "Boom!" {}) + ex (setup-error error)] + (is (component/ex-component? ex)))) + +(deftest error-is-not-from-component + (is (not (component/ex-component? (ex-info "Boom!" {}))))) + +(deftest remove-components-from-error + (let [error (ex-info (str (rand-int Integer/MAX_VALUE)) {}) + ^Exception ex (setup-error error) + ^Exception ex-without (component/ex-without-components ex)] + (is (contains? (ex-data ex) :component)) + (is (contains? (ex-data ex) :system)) + (is (not (contains? (ex-data ex-without) :component))) + (is (not (contains? (ex-data ex-without) :system))) + (is (= (.getMessage ex) + (.getMessage ex-without))) + (is (= (.getCause ex) + (.getCause ex-without))) + (is (java.util.Arrays/equals + (.getStackTrace ex) + (.getStackTrace ex-without))))) + +(defrecord System2b [one] + component/Lifecycle + (start [this] + (assert (started? (get-in one [:b :a]))) + this) + (stop [this] + (assert (started? (get-in one [:b :a]))) + this)) + +(defn system-2 [] + (component/system-map :alpha (system-1) + :beta (component/using (->System2b nil) + {:one :alpha}))) + +(deftest composed-systems + (let [system (component/start (system-2))] + (is (started? (get-in system [:beta :one :d :my-c]))))) + +(defn increment-all-components [system] + (component/update-system + system (keys system) update-in [:n] inc)) + +(defn assert-increments [system] + (are [n keys] (= n (get-in system keys)) + 11 [:a :n] + 11 [:b :a :n] + 11 [:c :a :n] + 11 [:c :b :a :n] + 11 [:e :d :b :a :n] + 21 [:b :n] + 21 [:c :b :n] + 21 [:d :b :n] + 31 [:c :n] + 41 [:d :n] + 51 [:e :n])) + +(deftest update-with-custom-function-on-maps + (let [system {:a {:n 10} + :b (component/using {:n 20} [:a]) + :c (component/using {:n 30} [:a :b]) + :d (component/using {:n 40} [:a :b]) + :e (component/using {:n 50} [:b :c :d])}] + (assert-increments (increment-all-components system)))) + +(deftest t-system-using + (let [dependency-map {:b [:a] + :c [:a :b] + :d {:a :a :b :b} + :e [:b :c :d]} + system {:a {:n 10} + :b {:n 20} + :c {:n 30} + :d {:n 40} + :e {:n 50}} + system (component/system-using system dependency-map)] + (assert-increments (increment-all-components system)))) + +(defrecord ComponentWithoutLifecycle [state]) + +;; BB-TEST-PATCH: No implementation of method errors for start and stop +#_(deftest component-without-lifecycle + (let [c (->ComponentWithoutLifecycle nil)] + (is (= c (component/start c))) + (is (= c (component/stop c))))) + +(defrecord ComponentReturningNil [state] + component/Lifecycle + (start [this] + nil) + (stop [this] + nil)) + +(deftest component-returning-nil + (let [a (->ComponentReturningNil nil) + s (component/system-map :a a :b (component-b)) + e (try (component/start s) + false + (catch Exception e e))] + (is (= ::component/nil-component (:reason (ex-data e)))))) + +(deftest missing-dependency-error + (let [system-key ::system-b + local-key ::local-b + a (component/using (component-a) {local-key system-key}) + system (component/system-map + :a a) + e (try (component/start system) + false + (catch Exception e e)) + data (ex-data e)] + (is (= ::component/missing-dependency (:reason data))) + (is (= system-key (:system-key data))) + (is (= local-key (:dependency-key data))) + (is (= a (:component data))) + (is (= system (:system data))))) diff --git a/test-resources/lib_tests/component/component_test.clj b/test-resources/lib_tests/component/component_test.clj deleted file mode 100644 index 32b715f8..00000000 --- a/test-resources/lib_tests/component/component_test.clj +++ /dev/null @@ -1,41 +0,0 @@ -(ns component.component-test - (:require [clojure.test :refer [deftest is testing]] - [com.stuartsierra.component :as component])) - - -(def syslog (atom [])) - -(defn log [msg] - (swap! syslog conj msg)) - -(defrecord FakeDB [state] - component/Lifecycle - (start [_] - (log "start DB")) - (stop [_] - (log "stop DB"))) - -(defrecord FakeApp [db] - component/Lifecycle - (start [_] - (log "start app")) - (stop [_] - (log "stop app"))) - -(defn base-app [] - (map->FakeApp {})) - -(def sm - (component/system-map - :db (->FakeDB :foo) - :app (component/using (base-app) [:db]))) - -(component/start sm) - -;; do useful stuff here - -(component/stop sm) - -(deftest ordering-test - (testing "components are started and stopped in expected order" - (is (= ["start DB" "start app" "stop app" "stop DB"] @syslog)))) 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/cprop/smoke_test.clj b/test-resources/lib_tests/cprop/smoke_test.clj new file mode 100644 index 00000000..9f97d66a --- /dev/null +++ b/test-resources/lib_tests/cprop/smoke_test.clj @@ -0,0 +1,7 @@ +(ns cprop.smoke-test + (:require [clojure.test :as t :refer [deftest is]] + [cprop.core] + [cprop.source :refer [from-env]])) + +(deftest from-env-test + (println (:cprop-env (from-env)))) 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/doric/test/core.clj b/test-resources/lib_tests/doric/test/core.clj index 21a327aa..777d2c28 100644 --- a/test-resources/lib_tests/doric/test/core.clj +++ b/test-resources/lib_tests/doric/test/core.clj @@ -2,8 +2,7 @@ (:refer-clojure :exclude [format name when]) (:use [doric.core] [clojure.test] - [doric.org :only [th td render]]) - (:require [clojure.string :as str])) + [doric.org :only [th td render]])) (deftest test-title-case (is (= "Foo" (title-case "foo"))) @@ -73,6 +72,7 @@ ;; TODO (deftest test-body) (deftest test-render + ;; BB-TEST-PATCH: Switch to set as .contains isn't supported in bb as it's atypical Clojure (let [rendered (set (render [["1" "2"]["3" "4"]]))] (is (contains? rendered "| 1 | 2 |")) (is (contains? rendered "| 3 | 4 |")) diff --git a/test-resources/lib_tests/doric/test/doctest.clj b/test-resources/lib_tests/doric/test/doctest.clj new file mode 100644 index 00000000..f05f1c0f --- /dev/null +++ b/test-resources/lib_tests/doric/test/doctest.clj @@ -0,0 +1,93 @@ +(ns doric.test.doctest + (:use [clojure.java.io :only [file]] + [clojure.test]) + (:import (java.io PushbackReader StringReader))) + +(defn fenced-blocks + "detect and extract github-style fenced blocks in a file" + [s] + (map second + (re-seq #"(?m)(?s)^```clojure\n(.*?)\n^```" s))) + +(def prompt + ;; regex for finding 'foo.bar>' repl prompts + "(?m)\n*^\\S*>\\s*") + +(defn skip? + "is a result skippable?" + ;; if it's a comment, the answer is yes + [s] + (.startsWith s ";")) + +(defn reps + "given a string of read-eval-print sequences, separate the different + 'r-e-p's from each other" + [prompt s] + (rest (.split s prompt))) + +(defn markdown-tests + "extract all the tests from a markdown file" + [f] + (->> f + slurp + fenced-blocks + (mapcat (partial reps prompt)))) + +(defn repl-tests + "extract all the tests from a repl-session-like file" + [f] + (->> f + slurp + (reps prompt))) + +(defn temp-ns + "create a temporary ns, and return its name" + [] + (binding [*ns* *ns*] + (in-ns (gensym)) + (use 'clojure.core) + ;; BB-TEST-PATCH: bb can't .getName on ns + (str *ns*))) + +(defn eval-in-ns + "evaluate a form inside the given ns-name" + [ns form] + (binding [*ns* *ns*] + (in-ns ns) + (eval form))) + +(defn run-doctest + "run a single doctest, reporting success or failure" + [file idx ns test] + (let [r (PushbackReader. (StringReader. test)) + form (read r) + expected (.trim (slurp r)) + actual (when-not (skip? expected) + (.trim (try + (with-out-str + (pr (eval-in-ns ns form)) + (flush)) + (catch Exception _ + (println _) + (.toString (gensym))))))] + (if (or (skip? expected) + (= actual expected)) + (report {:type :pass}) + (report {:type :fail + :file file :line idx + :expected expected :actual actual})))) + +(defn run-doctests + "use text-extract-fn to get all the tests out of file, and run them + all, reporting success or failure" + [test-extract-fn file] + (let [ns (temp-ns)] + (doseq [[idx t] (map-indexed vector (test-extract-fn file))] + (run-doctest file idx ns t)) + (remove-ns ns))) + + +(comment + ;; example usage + (deftest bar-repl + (run-doctests repl-tests "test/bar.repl"))) diff --git a/test-resources/lib_tests/doric/test/readme.clj b/test-resources/lib_tests/doric/test/readme.clj new file mode 100644 index 00000000..615459ed --- /dev/null +++ b/test-resources/lib_tests/doric/test/readme.clj @@ -0,0 +1,6 @@ +(ns doric.test.readme + (:use [clojure.test] + [doric.test.doctest])) + +(deftest readme + (run-doctests markdown-tests "README.md")) 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/failjure/runner.cljs b/test-resources/lib_tests/failjure/runner.cljs new file mode 100644 index 00000000..5b334cbc --- /dev/null +++ b/test-resources/lib_tests/failjure/runner.cljs @@ -0,0 +1,5 @@ +(ns failjure.runner + (:require [doo.runner :refer-macros [doo-tests]] + [failjure.test-core])) + +(doo-tests 'failjure.test-core) diff --git a/test-resources/lib_tests/gaka/core_test.clj b/test-resources/lib_tests/gaka/core_test.clj index 622c4756..7305fdbc 100644 --- a/test-resources/lib_tests/gaka/core_test.clj +++ b/test-resources/lib_tests/gaka/core_test.clj @@ -1,7 +1,6 @@ (ns gaka.core-test - (:require [clojure.test :refer [deftest is are]] - [gaka.core :refer [css compile* inline-css render-rule]] - )) + (:use gaka.core + clojure.test)) (defmacro =? [& body] `(are [x# y#] (= x# y#) @@ -194,3 +193,4 @@ (is (re-find #"^(color: red; border: 1;|border: 1; color: red;)$" (inline-css {:color :red :border 1})))) + diff --git a/test-resources/lib_tests/honey/sql/helpers_test.cljc b/test-resources/lib_tests/honey/sql/helpers_test.cljc index 33ea68c5..76fa2f88 100644 --- a/test-resources/lib_tests/honey/sql/helpers_test.cljc +++ b/test-resources/lib_tests/honey/sql/helpers_test.cljc @@ -2,8 +2,7 @@ (ns honey.sql.helpers-test (:refer-clojure :exclude [filter for group-by partition-by set update]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] [honey.sql :as sql] [honey.sql.helpers :as h :refer [add-column add-index alter-table columns create-table create-table-as create-view diff --git a/test-resources/lib_tests/honey/sql/postgres_test.cljc b/test-resources/lib_tests/honey/sql/postgres_test.cljc index ad173596..9649a665 100644 --- a/test-resources/lib_tests/honey/sql/postgres_test.cljc +++ b/test-resources/lib_tests/honey/sql/postgres_test.cljc @@ -9,8 +9,7 @@ (ns honey.sql.postgres-test (:refer-clojure :exclude [update partition-by set]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] ;; pull in all the PostgreSQL helpers that the nilenso ;; library provided (as well as the regular HoneySQL ones): [honey.sql.helpers :as sqlh :refer @@ -320,7 +319,7 @@ (deftest values-except-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT SELECT id FROM images" 4 5 6] (sql/format {:except [{:values [[4] [5] [6]]} @@ -328,7 +327,7 @@ (deftest select-except-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT SELECT ip FROM ip_location"] (sql/format {:except [{:select [:ip]} @@ -336,7 +335,7 @@ (deftest values-except-all-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT ALL (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT ALL SELECT id FROM images" 4 5 6] (sql/format {:except-all [{:values [[4] [5] [6]]} @@ -344,7 +343,7 @@ (deftest select-except-all-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT ALL (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT ALL SELECT ip FROM ip_location"] (sql/format {:except-all [{:select [:ip]} diff --git a/test-resources/lib_tests/honey/sql_test.cljc b/test-resources/lib_tests/honey/sql_test.cljc index d1043ed7..3c93cac4 100644 --- a/test-resources/lib_tests/honey/sql_test.cljc +++ b/test-resources/lib_tests/honey/sql_test.cljc @@ -3,8 +3,7 @@ (ns honey.sql-test (:refer-clojure :exclude [format]) (:require [clojure.string :as str] - #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + [clojure.test :refer [deftest is testing]] [honey.sql :as sut :refer [format]] [honey.sql.helpers :as h]) #?(:clj (:import (clojure.lang ExceptionInfo)))) @@ -15,17 +14,39 @@ {:dialect :mysql})))) (deftest expr-tests + ;; special-cased = nil: (is (= ["id IS NULL"] (sut/format-expr [:= :id nil]))) (is (= ["id IS NULL"] (sut/format-expr [:is :id nil]))) + (is (= ["id = TRUE"] + (sut/format-expr [:= :id true]))) + (is (= ["id IS TRUE"] + (sut/format-expr [:is :id true]))) + (is (= ["id <> TRUE"] + (sut/format-expr [:<> :id true]))) + (is (= ["id IS NOT TRUE"] + (sut/format-expr [:is-not :id true]))) + (is (= ["id = FALSE"] + (sut/format-expr [:= :id false]))) + (is (= ["id IS FALSE"] + (sut/format-expr [:is :id false]))) + (is (= ["id <> FALSE"] + (sut/format-expr [:<> :id false]))) + (is (= ["id IS NOT FALSE"] + (sut/format-expr [:is-not :id false]))) + ;; special-cased <> nil: (is (= ["id IS NOT NULL"] (sut/format-expr [:<> :id nil]))) + ;; legacy alias: (is (= ["id IS NOT NULL"] (sut/format-expr [:!= :id nil]))) + ;; legacy alias: + (is (= ["id IS NOT NULL"] + (sut/format-expr [:not= :id nil]))) (is (= ["id IS NOT NULL"] (sut/format-expr [:is-not :id nil]))) - ;; degenerate cases: + ;; degenerate (special) cases: (is (= ["NULL IS NULL"] (sut/format-expr [:= nil nil]))) (is (= ["NULL IS NOT NULL"] @@ -185,30 +206,30 @@ ;; ORDER BY foo ASC (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])) + ["SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])) (testing "union complex values" (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6])))) (deftest union-all-test (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2"]))) (deftest intersect-test (is (= (format {:intersect [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) INTERSECT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 INTERSECT SELECT foo FROM bar2"]))) (deftest except-test (is (= (format {:except [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) EXCEPT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 EXCEPT SELECT foo FROM bar2"]))) (deftest inner-parts-test (testing "The correct way to apply ORDER BY to various parts of a UNION" @@ -222,7 +243,7 @@ :order-by [[:amount :desc]] :limit 5}]}] :order-by [[:amount :asc]]}) - ["(SELECT amount, id, created_on FROM transactions) UNION (SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?)) ORDER BY amount ASC" 5])))) + ["SELECT amount, id, created_on FROM transactions UNION SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?) ORDER BY amount ASC" 5])))) (deftest compare-expressions-test (testing "Sequences should be fns when in value/comparison spots" @@ -254,14 +275,14 @@ {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest union-all-with-cte (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest parameterizer-none (testing "array parameter" @@ -277,7 +298,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]} {:inline true}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest inline-was-parameterizer-none (testing "array parameter" @@ -294,7 +315,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values (mapv #(mapv vector (repeat :inline) %) [[1 2] [3 4] [5 6]])}]]}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest similar-regex-tests (testing "basic similar to" @@ -379,11 +400,21 @@ (is (= ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `a` = ? WHERE `bar`.`b` = ?" 1 42] (-> - {:update :foo - :join [:bar [:= :bar.id :foo.bar_id]] - :set {:a 1} - :where [:= :bar.b 42]} - (format {:dialect :mysql}))))) + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + :set {:a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql})))) + ;; issue 344 + (is (= + ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `f`.`a` = ? WHERE `bar`.`b` = ?" 1 42] + (-> + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + ;; do not drop ns in set clause for MySQL: + :set {:f/a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql}))))) (deftest format-arity-test (testing "format can be called with no options" @@ -401,7 +432,8 @@ (-> {:delete-from :foo :where [:= :foo.id 42]} (format :dialect :mysql :pretty true))))) - (when (str/starts-with? #?(:bb "1.11" + ;; BB-TEST-PATCH: bb doesn't have clojure-version + (when (str/starts-with? #?(:bb "1.11" :clj (clojure-version) :cljs *clojurescript-version*) "1.11") (testing "format can be called with mixed arguments" @@ -439,7 +471,7 @@ (format {:dialect :mysql}))))) (deftest inlined-values-are-stringified-correctly - (is (= ["SELECT 'foo', 'It''s a quote!', BAR, NULL"] + (is (= ["SELECT 'foo', 'It''s a quote!', bar, NULL"] (format {:select [[[:inline "foo"]] [[:inline "It's a quote!"]] [[:inline :bar]] @@ -784,3 +816,31 @@ ORDER BY id = ? DESC :from :bar :join [[{:select :a :from :b :where [:= :id 123]} :x] :y] :where [:= :id 456]}))))) + +(deftest fetch-offset-issue-338 + (testing "default offset (with and without limit)" + (is (= ["SELECT foo FROM bar LIMIT ? OFFSET ?" 10 20] + (format {:select :foo :from :bar + :limit 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ?" 20] + (format {:select :foo :from :bar + :offset 20})))) + (testing "default offset / fetch" + (is (= ["SELECT foo FROM bar OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ? ROW FETCH NEXT ? ROW ONLY" 1 1] + (format {:select :foo :from :bar + :fetch 1 :offset 1}))) + (is (= ["SELECT foo FROM bar FETCH FIRST ? ROWS ONLY" 2] + (format {:select :foo :from :bar + :fetch 2})))) + (testing "SQL Server offset" + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20} + {:dialect :sqlserver}))) + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS" 20] + (format {:select :foo :from :bar + :offset 20} + {:dialect :sqlserver}))))) diff --git a/test-resources/lib_tests/honeysql/core_test.cljc b/test-resources/lib_tests/honeysql/core_test.cljc index 4247f1bc..d1fc2f8b 100644 --- a/test-resources/lib_tests/honeysql/core_test.cljc +++ b/test-resources/lib_tests/honeysql/core_test.cljc @@ -3,11 +3,12 @@ (:require [#?@(:clj [clojure.test :refer] :cljs [cljs.test :refer-macros]) [deftest testing is]] [honeysql.core :as sql] + [honeysql.format :as sql-f] [honeysql.helpers :refer [select modifiers from join left-join right-join full-join cross-join where group having order-by limit offset values columns - insert-into with merge-where]] + insert-into with merge-where merge-having]] honeysql.format-test)) ;; TODO: more tests @@ -90,7 +91,7 @@ (-> (insert-into :foo) (columns :bar) - (values [[(honeysql.format/value {:baz "my-val"})]]) + (values [[(sql-f/value {:baz "my-val"})]]) sql/format))) (is (= ["INSERT INTO foo (a, b, c) VALUES (?, ?, ?), (?, ?, ?)" "a" "b" "c" "a" "b" "c"] @@ -217,43 +218,113 @@ sql/format)))) (deftest merge-where-no-params-test - (testing "merge-where called with just the map as parameter - see #228" - (let [sqlmap (-> (select :*) - (from :table) - (where [:= :foo :bar]))] - (is (= ["SELECT * FROM table WHERE foo = bar"] - (sql/format (apply merge-where sqlmap []))))))) + (doseq [[k [f merge-f]] {"WHERE" [where merge-where] + "HAVING" [having merge-having]}] + (testing "merge-where called with just the map as parameter - see #228" + (let [sqlmap (-> (select :*) + (from :table) + (f [:= :foo :bar]))] + (is (= [(str "SELECT * FROM table " k " foo = bar")] + (sql/format (apply merge-f sqlmap [])))))))) (deftest merge-where-test - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar] [:= :quuz :xyzzy]) - sql/format))) - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar]) - (merge-where [:= :quuz :xyzzy]) - sql/format)))) + (doseq [[k sql-keyword f merge-f] [[:where "WHERE" where merge-where] + [:having "HAVING" having merge-having]]] + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar] [:= :quuz :xyzzy]) + sql/format))) + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar]) + (merge-f [:= :quuz :xyzzy]) + sql/format))) + (testing "Should work when first arg isn't a map" + (is (= {k [:and [:x] [:y]]} + (merge-f [:x] [:y])))) + (testing "Shouldn't use conjunction if there is only one clause in the result" + (is (= {k [:x]} + (merge-f {} [:x])))) + (testing "Should be able to specify the conjunction type" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] [:y])))) + (testing "Should ignore nil clauses" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] nil [:y])))))) + +(deftest merge-where-build-clause-test + (doseq [k [:where :having]] + (testing (str "Should be able to build a " k " clause with sql/build") + (is (= {k [:and [:a] [:x] [:y]]} + (sql/build + k [:a] + (keyword (str "merge-" (name k))) [:and [:x] [:y]])))))) + +(deftest merge-where-combine-clauses-test + (doseq [[k f] {:where merge-where + :having merge-having}] + (testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)") + (testing "No existing clause" + (is (= {k [:and [:x] [:y]]} + (f {} + [:x] [:y])))) + (testing "Existing clause is not a conjunction." + (is (= {k [:and [:a] [:x] [:y]]} + (f {k [:a]} + [:x] [:y])))) + (testing "Existing clause IS a conjunction." + (testing "New clause(s) are not conjunctions" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:x] [:y])))) + (testing "New clauses(s) ARE conjunction(s)" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x] [:y]]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:y]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:and [:y]]))))) + (testing "if existing clause isn't the same conjunction, don't merge into it" + (testing "existing conjunction is `:or`" + (is (= {k [:and [:or [:a] [:b]] [:x] [:y]]} + (f {k [:or [:a] [:b]]} + [:x] [:y])))) + (testing "pass conjunction type as a param (override default of :and)" + (is (= {k [:or [:and [:a] [:b]] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + :or + [:x] [:y])))))))) (deftest where-nil-params-test - (testing "where called with nil parameters - see #246" - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where nil nil nil nil) - sql/format))))) + (doseq [[_ sql-keyword f] [[:where "WHERE" where] + [:having "HAVING" having]]] + (testing (str sql-keyword " called with nil parameters - see #246") + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f nil nil nil nil) + sql/format)))))) (deftest cross-join-test (is (= ["SELECT * FROM foo CROSS JOIN bar"] diff --git a/test-resources/lib_tests/honeysql/format_test.cljc b/test-resources/lib_tests/honeysql/format_test.cljc index d7fa8c7b..7ddea793 100644 --- a/test-resources/lib_tests/honeysql/format_test.cljc +++ b/test-resources/lib_tests/honeysql/format_test.cljc @@ -320,3 +320,17 @@ (format {:select [:*] :from [[:foo :f]] :cross-join [[:bar :b]]})))) + +(deftest issue-299-test + (let [name "test field" + ;; this was being rendered inline into the SQL + ;; creating an injection vulnerability (v1 only) + ;; the context for seq->sql here seems to be the + ;; 'regular' one so it tries to treat this as an + ;; alias: 'value alias' -- the fix was to make it + ;; a function context so it becomes (TRUE, ?): + enabled [true, "); SELECT case when (SELECT current_setting('is_superuser'))='off' then pg_sleep(0.2) end; -- "]] + (is (= ["INSERT INTO table (name, enabled) VALUES (?, (TRUE, ?))" name (second enabled)] + (format {:insert-into :table + :values [{:name name + :enabled enabled}]}))))) \ No newline at end of file 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/lambdaisland/regal/malli_test.cljc b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc new file mode 100644 index 00000000..5b3072e3 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc @@ -0,0 +1,19 @@ +(ns lambdaisland.regal.malli-test + (:require [clojure.test :refer [deftest is ]] + [malli.core :as m] + [malli.error :as me] + [lambdaisland.regal.malli :as regal-malli])) + +(def malli-opts {:registry {:regal regal-malli/regal-schema}}) + +(def form [:+ "y"]) + +(def schema (m/schema [:regal form] malli-opts)) + +(deftest regal-malli-test + (is (= [:regal [:+ "y"]] (m/form schema))) + (is (= :regal (m/type schema))) + (is (= true (m/validate schema "yyy"))) + (is (= ["Pattern does not match"] (me/humanize (m/explain schema "xxx"))))) + + diff --git a/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc new file mode 100644 index 00000000..2a169516 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc @@ -0,0 +1,29 @@ +(ns lambdaisland.regal.parse-test + (:require [clojure.test :refer [deftest testing is are]] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse])) + +(deftest parse-whitespace-test + (is (= [:class " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\s")))) + + (is (= :whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\s")))) + + (is (= [:not " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\S")))) + + (is (= :non-whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\S"))))) + +(deftest ^{:kaocha/pending + "Needs a special case in the regex generation code"} + whitespace-round-trip + (is (= "\\s" + (regal/with-flavor :java + (regal/pattern + (parse/parse-pattern "\\s")))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/re2_test.clj b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj new file mode 100644 index 00000000..6f26c84c --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj @@ -0,0 +1,45 @@ +(ns lambdaisland.regal.re2-test + (:require [clojure.spec.alpha :as s] + [clojure.test :refer [is]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [com.gfredericks.test.chuck.properties :as prop'] + [lambdaisland.regal :as regal] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :refer [re2-find re2-compile]] + [lambdaisland.regal.spec-alpha :as regal-spec])) + +(defn gen-carefully [fgen else-gen] + (try + (let [gen (fgen)] + (gen/->Generator + (fn [rnd size] + (try + (gen/call-gen gen rnd size) + (catch Exception _ + (gen/call-gen else-gen rnd size)))))) + (catch Exception _ + else-gen))) + +(defn can-generate? [regal] + (try + (gen/sample (regal-gen/gen regal)) + true + (catch Exception _ + false))) + +(defspec re2-matches-like-java 10 + (with-redefs [regal-spec/token-gen #(s/gen (disj regal-spec/known-tokens :line-break :start :end))] + (prop'/for-all [regal (s/gen ::regal/form) + :when (can-generate? regal) + s (gen-carefully #(regal-gen/gen regal) + gen/string) + :let [java-result + (try (re-find (regal/regex regal) s) + (catch Exception _ + :fail))] + :when (not= :fail java-result)] + (is (= java-result + (re2-find (regal/with-flavor :re2 + (re2-compile (regal/pattern regal))) + s)))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj new file mode 100644 index 00000000..20b14f16 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj @@ -0,0 +1,39 @@ +(ns lambdaisland.regal.spec-gen-test + (:require [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as spec-gen] + [clojure.test :refer [deftest is are testing run-tests]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse] + [lambdaisland.regal.spec-alpha])) + +(def form-gen (s/gen ::regal/form)) +(def canonical-form-gen (gen/fmap regal/normalize (s/gen ::regal/form))) + +(defspec generated-forms-can-be-converted 100 + (prop/for-all [regal form-gen] + (try + (regal/regex regal) + (catch Exception _ + false)))) + +(defn- round-trip? [form] + (try + (= form (parse/parse (regal/regex form))) + (catch Exception _ false))) + +(defspec round-trip-property 100 + (prop/for-all* [canonical-form-gen] round-trip?)) + +(deftest round-trip-test + (is (round-trip? [:cat " " [:class "&& "]])) + (is (round-trip? [:class " " [" " "["]])) + (is (round-trip? [:ctrl "A"])) + (is (round-trip? [:class " - "])) + (is (round-trip? [:alt " " [:capture " " :escape]])) + (is (round-trip? :whitespace)) + (is (round-trip? [:? [:? "x"]])) + (is (round-trip? [:cat " " [:class " " :non-whitespace]])) + (is (round-trip? [:cat "-" [:repeat [:repeat "x" 0] 0]]))) diff --git a/test-resources/lib_tests/lambdaisland/regal/test_util.cljc b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc new file mode 100644 index 00000000..04c1d659 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc @@ -0,0 +1,146 @@ +(ns lambdaisland.regal.test-util + (:require [lambdaisland.regal :as regal]) + #?(:cljs (:require-macros [lambdaisland.regal.test-util :refer [inline-resource]]) + :clj (:require [clojure.java.io :as io] + [clojure.test.check.generators :as gen] + [lambdaisland.regal.generator :as regal-gen] + ;; BB-TEST-PATCH: Don't have this dependency + #_[com.gfredericks.test.chuck.regexes.charsets :as charsets]))) + +#?(:clj + (defmacro inline-resource [resource-path] + (read-string (slurp (io/resource resource-path))))) + +(defn read-test-cases [] + #? (:clj (read-string (slurp (io/resource "lambdaisland/regal/test_cases.edn"))) + :cljs (inline-resource "lambdaisland/regal/test_cases.edn"))) + +(defn flavor-parents [flavor] + (->> flavor + (iterate (comp first (partial parents regal/flavor-hierarchy))) + (take-while identity))) + +(defn format-cases [cases] + (for [[form pattern & tests :as case] cases + :let [[props tests] (if (map? (first tests)) + [(first tests) (rest tests)] + [{} tests])]] + (with-meta (merge + {:pattern pattern + :form form + :tests tests} + props) + (meta case)))) + +(defn test-cases + ([] + (let [cases (read-test-cases)] + (loop [[id & cases] cases + result []] + (if id + (recur (drop-while vector? cases) + (conj result + {:id id + :cases (format-cases (take-while vector? cases))})) + result))))) + +;; BB-TEST-PATCH: bb doesn't have Pattern class +#_(:clj + (do + (defn re2-compile ^com.google.re2j.Pattern [s] + (com.google.re2j.Pattern/compile s)) + (defn re2-groups + [^com.google.re2j.Matcher m] + (let [gc (. m (groupCount))] + (if (zero? gc) + (. m (group)) + (loop [ret [] c 0] + (if (<= c gc) + (recur (conj ret (. m (group c))) (inc c)) + ret))))) + (defn re2-find + ([^com.google.re2j.Matcher m] + (when (. m (find)) + (re2-groups m))) + ([^com.google.re2j.Pattern re s] + (let [m (.matcher re s)] + (re2-find m)))))) +;; BB-TEST-PATCH: Uses ns that can't load +#_(:clj + (do + ;; Implementation for generating classes using test.chuck's charsets. + ;; This should eventually be moved to lambdaisland.regal.generator + ;; when we have our own charset implementation + (def token->charset-map + (let [whitespace-charset (apply charsets/union + (map (comp charsets/singleton str char) regal/whitespace-char-codes))] + {:any charsets/all-unicode-but-line-terminators + :digit (charsets/predefined-regex-classes \d) + :non-digit (charsets/predefined-regex-classes \D) + :word (charsets/predefined-regex-classes \w) + :non-word (charsets/predefined-regex-classes \W) + :whitespace whitespace-charset + :non-whitespace (charsets/difference + (charsets/intersection charsets/all-unicode + (charsets/range "\u0000" "\uFFFF")) + whitespace-charset) + :newline (charsets/singleton "\n") + :return (charsets/singleton "\r") + :tab (charsets/singleton "\t") + :form-feed (charsets/singleton "\f") + :alert (charsets/singleton "\u0007") + :escape (charsets/singleton "\u001B") + :vertical-whitespace (charsets/predefined-regex-classes \v) + :vertical-tab (charsets/singleton "\u000B") + :null (charsets/singleton "\u0000")})) + + (defn token->charset [token] + (or (get token->charset-map token) + (throw (ex-info "Unknown token type" {:token token})))) + + (defn class->charset [cls] + (reduce charsets/union* + charsets/empty + (for [c cls] + (try + (cond + (vector? c) + (let [[start end] (map str c)] + (assert (>= 0 (compare start end))) + (charsets/range start end)) + + (simple-keyword? c) + (token->charset c) + + (string? c) + (reduce charsets/union* + (map (comp charsets/singleton str) c)) + + (char? c) + (charsets/singleton (str c))) + (catch Exception e + (throw (ex-info "Failed to translate class element into charset" + {:cls cls + :element c} + e))))))) + + (defn class->gen [[op & elts :as expr]] + (let [cls (class->charset elts) + cls (case op + :not (charsets/difference charsets/all-unicode cls) + :class cls + + (throw (ex-info "Unknown character class op" {:op op})))] + (if (nat-int? (charsets/size cls)) + (gen/fmap #(charsets/nth cls %) (gen/choose 0 (dec (charsets/size cls)))) + (throw (ex-info "Can't generate empty class" {:expr expr}))))) + + (defmethod regal-gen/-generator :not + [r _opts] + (class->gen r)) + + (defmethod regal-gen/-generator :class + [r _opts] + (class->gen r)))) +#_ +(test-cases) diff --git a/test-resources/lib_tests/lambdaisland/regal_test.cljc b/test-resources/lib_tests/lambdaisland/regal_test.cljc new file mode 100644 index 00000000..cdc14b74 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal_test.cljc @@ -0,0 +1,174 @@ +(ns lambdaisland.regal-test + (:require [lambdaisland.regal :as regal] + [lambdaisland.regal.spec-alpha] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :as test-util] + ;; BB-TEST-PATCH: bb can't load ns + #_[lambdaisland.regal.parse :as parse] + [clojure.spec.test.alpha :as stest] + [clojure.test :refer [deftest testing is are]] + [clojure.spec.alpha :as s])) + +(stest/instrument `regal/regex) + +(deftest regex-test + (is (= "abc" + (regal/pattern [:cat "a" "b" "c"]))) + + (is (= "a|b|c" + (regal/pattern [:alt "a" "b" "c"]))) + + (is (= "a*" + (regal/pattern [:* "a"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "ab"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "a" "b"]))) + + (is (= "(?:a|b)*" + (regal/pattern [:* [:alt "a" "b"]]))) + + (is (= "a*?" + (regal/pattern [:*? "a"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "ab"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "a" "b"]))) + + (is (= "(?:a|b)*?" + (regal/pattern [:*? [:alt "a" "b"]]))) + + (is (= "a+" + (regal/pattern [:+ "a"]))) + + (is (= "a+?" + (regal/pattern [:+? "a"]))) + + (is (= "a?" + (regal/pattern [:? "a"]))) + + (is (= "a??" + (regal/pattern [:?? "a"]))) + + (is (= "[a-z0-9_\\-]" + (regal/pattern [:class [\a \z] [\0 \9] \_ \-]))) + + (is (= "[^a-z0-9_\\-]" + (regal/pattern [:not [\a \z] [\0 \9] \_ \-]))) + + (is (= "a{3,5}" + (regal/pattern [:repeat \a 3 5]))) + + (regal/with-flavor :ecma + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (regal/with-flavor :java + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (is (= "a(?:b|c)" + (regal/pattern [:cat "a" [:alt "b" "c"]]))) + + (is (= "(abc)" + (regal/pattern [:capture "abc"]))) + + (is (= "a(b|c)" + (regal/pattern [:cat "a" [:capture [:alt "b" "c"]]])))) + +(deftest escape-test + (are [in out] (= out (regal/escape in)) + "$" "\\$" + "(" "\\(" + ")" "\\)" + "*" "\\*" + "+" "\\+" + "." "\\." + "?" "\\?" + "[" "\\[" + "]" "\\]" + "\\" "\\\\" + "^" "\\^" + "{" "\\{" + "|" "\\|" + "}" "\\}")) + + +(def flavors [:java8 :java9 :ecma :re2]) + +(def parseable-flavor? #{:java8 :java9 :ecma}) + +(deftest data-based-tests + (doseq [{:keys [id cases]} (test-util/test-cases) + {:keys [form pattern equivalent tests] :as test-case} cases + :let [skip? (set (when (map? pattern) + (for [flavor flavors + :when (= (get pattern flavor :skip) :skip)] + flavor))) + throws? (set (when (map? pattern) + (for [[flavor p] pattern + :when (and (vector? p) (= (first p) :throws))] + flavor)))]] + + (testing (str (pr-str form) " -> " (pr-str pattern)) + (is (s/valid? ::regal/form form)) + + (doseq [flavor flavors + :when (not (skip? flavor)) + :let [pattern (if (map? pattern) + (some pattern (test-util/flavor-parents flavor)) + pattern)]] + (if (throws? flavor) + (testing (str "Generating pattern throws (" (name id) ") " (pr-str form) " (" flavor ")") + (if-some [msg (second pattern)] + (is (thrown-with-msg? #?(:clj Exception + :cljs js/Error) (re-pattern msg) + (regal/with-flavor flavor + (regal/pattern form)))) + (is (thrown? #?(:clj Exception + :cljs js/Error) + (regal/with-flavor flavor + (regal/pattern form)))))) + (testing (str "Generated pattern is correct (" (name id) ") " (pr-str form) " (" flavor ")") + (regal/with-flavor flavor + (is (= pattern (regal/pattern form)))))) + + ;; BB-TEST-PATCH: Uses ns that can't load + #_(when (and (parseable-flavor? flavor) + (not-any? (comp :no-parse meta) [test-case cases])) + (testing (str "Pattern parses correctly (" (name id) ") " (pr-str pattern) " (" flavor ")") + (regal/with-flavor flavor + (is (= form (parse/parse-pattern pattern))))))) + + (doseq [[input match] tests] + (testing (str "Test case " (pr-str form) " matches " (pr-str input)) + + (testing "Generated pattern matches" + (is (= match (re-find (regal/regex form) input)))) + ;; BB-TEST-PATCH: Uses ns that can't load + #_(:clj + (when-not (or (skip? :re2) (throws? :re2)) + (testing "Generated pattern matches (re2)" + (is (= match (test-util/re2-find (regal/with-flavor :re2 + (test-util/re2-compile + (regal/pattern form))) + input)))))) + + (doseq [pattern (if (map? equivalent) + (some equivalent (test-util/flavor-parents (regal/runtime-flavor))) + equivalent)] + (testing (str "Alternative equivalent pattern " (pr-str pattern) " matches") + (is (= match (re-find (regal/compile pattern) input))))))) + + (testing (str "creating a generator does not throw exception " (pr-str form)) + (is (regal-gen/gen form))) + + ;; We should do this with proper properties so we get shrinking, just a + ;; basic check for now + (testing (str "generated strings match the given pattern " (pr-str form)) + (doseq [s (regal-gen/sample form)] + (is (re-find (regal/regex form) s))))))) diff --git a/test-resources/lib_tests/markdown/md_test.cljc b/test-resources/lib_tests/markdown/md_test.cljc new file mode 100644 index 00000000..b2279d00 --- /dev/null +++ b/test-resources/lib_tests/markdown/md_test.cljc @@ -0,0 +1,450 @@ +(ns markdown.md-test + (:require #?(:cljs [goog.string]) + [clojure.test :refer [deftest is]] + [markdown.core :as markdown] + [markdown.tables :as tables])) + +(def entry-function + #?(:clj markdown/md-to-html-string + :cljs markdown/md->html)) + +(deftest heading1 + (is (= "

Ticket #123

" (entry-function "# Ticket #123"))) + (is (= "

Foo

" (entry-function " # Foo"))) + (is (= "

foo

" (entry-function "#foo"))) + (is (= "

foo

" (entry-function "foo\n==="))) + (is (= "

foo

" (entry-function "#foo#"))) + (is (= "

foo

" (entry-function "#foo#\n"))) + (is (= "

some header with_an_underscore

" + (entry-function "# some header `with_an_underscore`"))) + (is (= "
  • one

heading1

" + (entry-function "* one\n\nheading1\n========\n")))) + +(deftest heading2 + (is (= "

foo

" (entry-function "##foo"))) + (is (= "

foo

" (entry-function "foo\n---"))) + (is (= "

foo

" (entry-function "##foo##"))) + (is (= "

foo

" (entry-function "##foo##\n")))) + +(deftest heading-with-complex-anchor + (is (= + "

foo bar BAz

some text

" + (entry-function "###foo bar BAz\nsome text" :heading-anchors true))) + (is (= + "

foo bar BAz

some text

" + (entry-function "###foo bar BAz##\nsome text" :heading-anchors true)))) + +(deftest br + (is (= "

foo

" (entry-function "foo ")))) + +(deftest hr + (is (= "
" (entry-function "***"))) + (is (= "
" (entry-function " * * * "))) + (is (= "
" (entry-function " *****"))) + (is (= "
" (entry-function "- - - ")))) + +(deftest em + (is (= "

foo

" (entry-function "*foo*")))) + +(deftest italics + (is (= "

foo

" (entry-function "_foo_")))) + +(deftest strong + (is (= "

foo

" (entry-function "**foo**")))) + +(deftest bold-italics + (is (= "

foo

" (entry-function "***foo***")))) + +(deftest bold + (is (= "

foo

" (entry-function "__foo__")))) + +(deftest strong-inside-em + (is (= "

foobarbaz

" (entry-function "*foo**bar**baz*")))) + +(deftest bold-inside-a-list + (is (= "
  1. chickens.

See more: Cluck Cluck

" + (entry-function "1. chickens. \n\n **See more: [Cluck Cluck](http://cluck.cluck.com)** \n\n")))) + +(deftest em-inside-strong + (is (= "

foobarbaz

" (entry-function "**foo*bar*baz**")))) + +(deftest paragraph + (is (= "

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore

" + (entry-function "\nLorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore")))) + +(deftest paragraph-multiline + (is (= "

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore

" + (entry-function "\nLorem ipsum dolor\nsit amet, consectetur adipisicing elit,\nsed do eiusmod tempor incididunt ut labore")))) + +(deftest paragraph-before-codeblock + (is (= "

foo

bar\n

baz

" + (entry-function "foo\n```\nbar\n```\nbaz"))) + (is (= "
foo  \nbar
" (entry-function "```\nfoo \nbar```"))) + (is (= "

" (entry-function "```\n```"))) + (is (= "

" (entry-function "```go\n```"))) + (is (= "
<html>\n</html>\n
" (entry-function "```\n\n\n``` ")))) + +(deftest paragraph-after-codeblock + (is (= "
foo\n

bar baz

" + (entry-function "```\nfoo\n```\nbar\nbaz")))) + +(deftest mulitple-paragraphs + (is (= "

foo bar baz

foo bar baz

" + (entry-function "\nfoo bar baz\n\n\nfoo bar baz")))) + +(deftest ul + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "* foo\n* bar\n* baz"))) + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "- foo\n- bar\n- baz"))) + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "+ foo\n+ bar\n+ baz")))) + +(deftest list-in-a-codeblock + (is + (= "
list:\n- 1\n- 2\n
" + (entry-function "```yaml\nlist:\n- 1\n- 2\n```")))) + +(deftest ul-followed-by-paragraph + (is (= "
  • foo
  • bar
  • baz

paragraph next line

" + (entry-function "* foo\n* bar\n* baz\n\nparagraph\nnext line")))) + +(deftest ul-with-codeblock + (is (= "
  • foo
  • bar
      (defn foo []\n  bar)\n
  • baz
  • more text
" + (entry-function + "\n* foo\n* bar\n ```\n (defn foo []\n bar)\n ```\n* baz\n* more text\n"))) + (is (= "
  • foo
  • bar
      (defn foo []\n  bar)\n
    text
  • baz
  • more text
" + (entry-function + "\n* foo\n* bar\n ```\n (defn foo []\n bar)\n ```\n text\n* baz\n* more text\n")))) + +(deftest ul-followed-by-multiline-paragraph + (is (= "
  • foo
  • bar
  • baz

paragraph

" + (entry-function "* foo\n* bar\n* baz\n\nparagraph")))) + +(deftest ul-nested + (is (= "
  • first item
    • first sub-item
      • second sub-item
    • third sub-item
  • second item
    • first sub-item
    • second sub-item
  • third item
" + (entry-function "* first item\n * first sub-item\n * second sub-item\n * third sub-item\n* second item\n * first sub-item\n * second sub-item\n* third item"))) + (is (= "
  • first item
    • first sub-item
      • second sub-item
    • third sub-item
  • second item
    • first sub-item
    • second sub-item
  • third item
" + (entry-function "* first item\n - first sub-item\n - second sub-item\n - third sub-item\n* second item\n + first sub-item\n + second sub-item\n* third item"))) + (is (= "
  • abc
  • def
" (entry-function " * abc\n\n+ def")))) + +(deftest ol + (is (= "
  1. Foo
  2. Bar
  3. Baz
" + (entry-function "1. Foo\n2. Bar\n3. Baz")))) + +(deftest ul-in-ol + (is (= "
  1. Bar
    1. Subbar
      • foo
      • bar
      • baz
  2. Baz
" + (entry-function "1. Bar\n 2. Subbar\n * foo\n * bar\n * baz\n3. Baz")))) + +(deftest ol-in-ul + (is (= "
  • Foo
    1. Bar
      1. Subbar
  • Baz
" + (entry-function "* Foo\n 1. Bar\n 1. Subbar\n* Baz"))) + (is (= "
  • Foo
    1. Bar
" + (entry-function "* Foo\n 1. Bar")))) + +(deftest multilist + (is (= + "
  • foo
  • bar
    • baz
      1. foo
      2. bar
    • fuzz
      • blah
      • blue
  • brass
" + (entry-function + "* foo +* bar + + * baz + 1. foo + 2. bar + + * fuzz + + * blah + * blue +* brass")))) + +(deftest code + (is (= "

foo bar baz x = y + z; foo

" + (entry-function "foo bar baz `x = y + z;` foo"))) + (is (= "

bar foo --- -- bar foo

" + (entry-function "bar `foo --- -- bar` foo"))) + (is (= "

<?xml version='1.0' encoding='UTF-8'?><channel></channel>

" + (entry-function "``"))) + (is (= "

foo bar baz (fn [x & xs] (str "x:" x)) foo

" + (entry-function "foo bar baz `(fn [x & xs] (str \"x:\" x))` foo"))) + (is (= "
```\nfoo\n```
" + (entry-function " ```\n foo\n ```")))) + +(deftest multiline-code + (is (= "
x = 5\ny = 6\nz = x + y
" + (entry-function " x = 5\n y = 6\n z = x + y"))) + (is (= "
x = 5\ny = 6\nz = x + y\n(fn [x & xs] (str "x"))
" + (entry-function " x = 5\n y = 6\n z = x + y\n (fn [x & xs] (str \"x\"))")))) + +(deftest codeblock + (is (= "
(defn- write^ [writer text]\n  (doseq [c text]\n    (.write writer (int c))))\n
" + (entry-function "```\n(defn- write^ [writer text]\n (doseq [c text]\n (.write writer (int c))))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```clojure\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
------------\n============\n    ------------\n    ============\n
" + (entry-function + " +```nohighlight +------------ +============ + ------------ + ============ +``` +")))) + +(deftest indented-codeblock + (is (= "
foo
" + (entry-function " foo"))) + (is (= "
foo

bar

" + (entry-function " foo\n\nbar"))) + (is (= "
foo
bar" + (entry-function " foo\nbar"))) + (is (= "

baz foo

bar

" + (entry-function "baz\n foo\n\nbar"))) + (is (= "

Element #1

" + (entry-function "
\n
\n

Element #1

\n
\n
")))) + +(deftest strikethrough + (is (= "

foo

" + (entry-function "~~foo~~")))) + +(deftest superscript + (is (= "

foobar baz

" + (entry-function "foo^bar baz")))) + +(deftest link + (is (= "

underscoresarefine

" + (entry-function "underscores_are_fine"))) + (is (= "

github

" + (entry-function "[github](http://github.com)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/~)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/^)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/*)"))) + (is (= "" + (entry-function "* [github](http://github.com/*)"))) + (is (= "
  • hi

a link

" + (entry-function "* hi\n\n[a link](https://see-here)"))) + (is (= "

>!

" + (entry-function "[>!](https://clojure.github.io/core.async/#clojure.core.async/>!)"))) + (is (= "

" + (entry-function "[github

" + (entry-function "[*github*](http://github.com)"))) + (is (= "

github

" + (entry-function "[_github_](http://github.com)"))) + (is (= "

github

" + (entry-function "[__github__](http://github.com)"))) + (is (= "

github

" + (entry-function "[**github**](http://github.com)"))) + (is (= "

github

" + (entry-function "[~~github~~](http://github.com)")))) + +(deftest img + (is (= "

\"Alt

" + (entry-function "![Alt text](/path/to/img.jpg)"))) + (is (= "

\"Alt

" + (entry-function "![Alt text](/path/to/_img_.jpg \"Optional Title\")")))) + +(deftest img-link + (is (= "

\"Continuous

" + (entry-function "[![Continuous Integration status](https://secure.travis-ci.org/yogthos/markdown-clj.png)](http://travis-ci.org/yogthos/markdown-clj)"))) + (is (= "

\"\"

" + (entry-function "![](https://secure.travis-ci.org/yogthos/markdown-clj.png)")))) + +(deftest bad-link + (is (= "

[github](http://github.comfooo

" + (entry-function "[github](http://github.comfooo"))) + (is (= "

[github] no way (http://github.com)

" + (entry-function "[github] no way (http://github.com)")))) + +(deftest bad-link-title + (is (= "

[github(http://github.comfooo)

" + (entry-function "[github(http://github.comfooo)")))) + +(deftest blockquote + (is (= "

Foo bar baz

" + (entry-function ">Foo bar baz")))) + +(deftest blockquote-footer + (is (= "

Foo bar baz

Leo Tolstoy
" + (entry-function "> Foo bar baz\n>- Leo Tolstoy")))) + +(deftest blockquote-empty-footer + (is (= "

Foo bar baz

" + (entry-function "> Foo bar baz\n>-")))) + +(deftest blockquote-multiline-without-leading-angle-bracket + (is (= "

Foo bar baz

" + (entry-function "> Foo bar\nbaz")))) + +(deftest blockquote-multiple-paragraphs + (is (= "

Foo bar

baz

" + (entry-function "> Foo bar\n>\n> baz")))) + +(deftest blockquote-bullets + (is (= "

list:

  • foo
  • bar

end.

" + (entry-function "> list:\n>* foo\n>* bar\n\nend."))) + (is (= "

  • foo
  • bar
  • baz

" + (entry-function ">* foo\n>* bar\n>* baz")))) + +(deftest blockquote-headings + (is (= "

Foo

bar baz

" + (entry-function "> ## Foo\n>bar baz"))) + (is (= "

Foo

bar

baz

" + (entry-function "> Foo\n>## bar\n> baz")))) + +(deftest escaped-characters + (is + (= "

^*‘_{}[]footestbar{x}[y]

" + (entry-function "\\^\\*\\`\\_\\{\\}\\[\\]*foo*`test`_bar_{x}[y]")))) + +(deftest paragraph-after-list + (is (= "
  1. a
  2. b

test bold and italic

" + (entry-function "1. a\n2. b\n\ntest **bold** and *italic*")))) + +(deftest paragraph-close-before-list + (is (= "

in paragraph

  • list
" + (entry-function "in paragraph\n- list")))) + +(deftest autourl + (is (= "

http://example.com/

" + (entry-function ""))) + + (is (= "

Some content with a http://www.google.com/abc__123__efg link it in

" + (entry-function "Some content with a link it in"))) + + (is (= "

http://foo https://bar/baz foo bar

" + (entry-function " foo bar"))) + + #?(:bb nil :org.babashka/nbb nil + :default + (is (= "

abc@google.com

" + (#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml + :cljs goog.string/unescapeEntities) + (entry-function ""))))) + + #?(:bb nil :org.babashka/nbb nil + :default + (is (= "

abc_def_ghi@google.com

" + (#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml + :cljs goog.string/unescapeEntities) + (entry-function "")))))) + +(deftest not-a-list + (is (= "

The fish was 192.8 lbs and was amazing to see.

" + (entry-function "The fish was\n192.8 lbs and was amazing to see.")))) + +(deftest dont-encode-chars-in-hrefs + (is (= "

example_link with tilde ~ and carat ^ and splat *

" + (entry-function "[example_link with tilde ~ and carat ^ and splat *](http://www.google.com/example_link_foo~_^*)")))) + +(deftest complex-link-with-terminal-encoding-inside-header + (is (= "

With a link the contents of the_link

" + (entry-function "##With a link [the contents of the_link](http://a.com/under_score_in_the_link/)")))) + +(deftest two-links-tests-link-processing + (is (= "

When you have a pair of links link1 and you want both Wow

" + (entry-function "## When you have a pair of links [link1](http://123.com/1) and you want both [Wow](That%27s%20crazy)")))) + +(deftest link-then-image-processing + (is (= "

You can have a link followed by an image \"\"

" + (entry-function "You can have a [link](github.com) followed by an image ![](img.png)")))) + +(deftest image-then-link-processing + (is (= "

You can have an image \"\" followed by a link

" + (entry-function "You can have an image ![](img.png) followed by a [link](github.com)")))) + +(deftest link-with-optional-title + (is (= "

Cryogens site

" + (entry-function "[Cryogens site](https://github.com/cryogen-project/cryogen \"Cryogen Github\")")))) + +(deftest parse-table-row + (is (= (tables/parse-table-row "| table cell contents |") [{:text "table cell contents"}])) + (is (= (tables/parse-table-row "| contents 1 | contents 2 | contents 3 | contents 4 |") + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}]))) + +(deftest table-row->str + (is (= (tables/table-row->str + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}] + true) + "contents 1contents 2contents 3contents 4")) + (is (= (tables/table-row->str + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}] + false) + "contents 1contents 2contents 3contents 4")) + (is (= (tables/table-row->str + [{:text "contents 1" :alignment :left} + {:text "contents 2" :alignment :center} + {:text "contents 3" :alignment :right} + {:text "contents 4"}] + false) + "contents 1contents 2contents 3contents 4"))) + +(deftest table->str + (is (= (tables/table->str + {:alignment-seq + [{:alignment :left} {:alignment :center} {:alignment :right} {:alignment nil}] + :data [[{:text "Header 1"} + {:text "Header 2"} + {:text "Header 3"} + {:text "Header 4"}] + [{:text "contents 1"} + {:text "contents 2"} + {:text "contents 3"} + {:text "contents 4"}]]}) + "
Header 1Header 2Header 3Header 4
contents 1contents 2contents 3contents 4
"))) + +(deftest divider-seq->alignment + (is (= (tables/divider-seq->alignment + [{:text "-----"} {:text ":-----"} {:text "-----:"} {:text ":-----:"}]) + [nil {:alignment :left} {:alignment :right} {:alignment :center}]))) + +(deftest n-dash + (is (= "

boo – bar

" (entry-function "boo -- bar")))) + +(deftest m-dash + (is (= "

boo — bar

" (entry-function "boo --- bar")))) + +(deftest inhibit-simple + (is (= "

_abc_

" (entry-function "$_abc_$" :inhibit-separator "$")))) + +(deftest inhibit-simple-seq + (is (= "

_abc_

" (entry-function "$_abc_$" :inhibit-separator [\$])))) + +(deftest inhibit-inline-code + (is (= "

`abc`

" (entry-function "$`abc`$" :inhibit-separator [\$])))) + +(deftest inhibit-inside-code + (is (= "

a*b* & dc

" (entry-function "`a$*b* & d$c`" :inhibit-separator "$")))) + +(deftest inhibit-across-backticks + (is (= "

one` `two

" (entry-function "`one$` `$two`" :inhibit-separator "$")))) + +(deftest inhibit-escape + (is (= "

$

" (entry-function "$$" :inhibit-separator [\$])))) + +(deftest inhibit-escape-twice + (is (= "

$$

" (entry-function "$$$$" :inhibit-separator "$")))) + +(deftest img-reprocess + (is (= "

\"Text\" and Edit

" + (entry-function "![Text](img.jpg) and [Edit](#)")))) + +(deftest dont-inhibit-text-within-escapes + (is (= "

$abc$

" (entry-function "$$*abc*$$" :inhibit-separator "$")))) + +(deftest inhibit-escape-inside-code + (is (= "

$

" (entry-function "`$$`" :inhibit-separator "$")))) + +(deftest whitespace-paragraphs + (is (= "

foo

bar

" (entry-function "foo\n \nbar")))) diff --git a/test-resources/lib_tests/markdown/nbb_runner.cljs b/test-resources/lib_tests/markdown/nbb_runner.cljs new file mode 100644 index 00000000..ec9bffa0 --- /dev/null +++ b/test-resources/lib_tests/markdown/nbb_runner.cljs @@ -0,0 +1,10 @@ +(ns nbb-runner + (:require [clojure.string :as str] + [clojure.test :refer [run-tests]] + [nbb.classpath :as cp])) + +(cp/add-classpath (str/join ":" ["src/cljs" "src/cljc" "test"])) + +(require '[markdown.md-test]) + +(run-tests 'markdown.md-test) diff --git a/test-resources/lib_tests/markdown/runner.cljs b/test-resources/lib_tests/markdown/runner.cljs new file mode 100644 index 00000000..aa2cf9f4 --- /dev/null +++ b/test-resources/lib_tests/markdown/runner.cljs @@ -0,0 +1,5 @@ +(ns markdown.runner + (:require [doo.runner :refer-macros [doo-tests]] + [markdown.md-test])) + +(doo-tests 'markdown.md-test) diff --git a/test-resources/lib_tests/medley/core_test.cljc b/test-resources/lib_tests/medley/core_test.cljc new file mode 100644 index 00000000..98f6c505 --- /dev/null +++ b/test-resources/lib_tests/medley/core_test.cljc @@ -0,0 +1,409 @@ +(ns medley.core-test + #?(:clj (:import [clojure.lang ArityException])) + (:require #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [medley.core :as m])) + +(deftest test-find-first + (testing "sequences" + (is (= (m/find-first even? [7 3 3 2 8]) 2)) + (is (nil? (m/find-first even? [7 3 3 7 3])))) + (testing "transducers" + (is (= (transduce (m/find-first even?) + 0 [7 3 3 2 8]) 2)) + (is (= (transduce (m/find-first even?) + 0 [7 3 3 7 3]) 0)))) + +(deftest test-dissoc-in + (is (= (m/dissoc-in {:a {:b {:c 1 :d 2}}} [:a :b :c]) + {:a {:b {:d 2}}})) + (is (= (m/dissoc-in {:a {:b {:c 1}}} [:a :b :c]) + {})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2}} [:a :b :c]) + {:a {:d 2}})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2} :b {:c {:d 2 :e 3}}} [:a :b :c] [:b :c :d]) + {:a {:d 2} :b {:c {:e 3}}})) + (is (= (m/dissoc-in {:a 1} []) + {:a 1}))) + +(deftest test-assoc-some + (is (= (m/assoc-some {:a 1} :b 2) {:a 1 :b 2})) + (is (= (m/assoc-some {:a 1} :b nil) {:a 1})) + (is (= (m/assoc-some {:a 1} :b 2 :c nil :d 3) {:a 1 :b 2 :d 3}))) + +(deftest test-update-existing + (is (= (m/update-existing {:a 1} :a inc) {:a 2})) + (is (= (m/update-existing {:a 1 :b 2} :a inc) {:a 2 :b 2})) + (is (= (m/update-existing {:b 2} :a inc) {:b 2})) + (is (= (m/update-existing {:a nil} :a str) {:a ""})) + (is (= (m/update-existing {} :a str) {}))) + +(deftest test-update-existing-in + (is (= (m/update-existing-in {:a 1} [:a] inc) {:a 2})) + (is (= (m/update-existing-in {:a 1 :b 2} [:a] inc) {:a 2 :b 2})) + (is (= (m/update-existing-in {:b 2} [:a] inc) {:b 2})) + (is (= (m/update-existing-in {:a nil} [:a] str) {:a ""})) + (is (= (m/update-existing-in {} [:a] str) {})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] inc) + {:a [:b {:c 43} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 7) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 4) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 3 1) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] vector 9 10 11 12 13 14) + {:a [:b {:c [42 9 10 11 12 13 14]} :d]}))) + +(deftest test-map-entry + (is (= (key (m/map-entry :a 1)) :a)) + (is (= (val (m/map-entry :a 1)) 1)) + (is (= (first (m/map-entry :a 1)) :a)) + (is (= (second (m/map-entry :a 1)) 1)) + (is (= (type (m/map-entry :a 1)) + (type (first {:a 1}))))) + +(defrecord MyRecord [x]) + +(deftest test-map-kv + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) (sorted-map :a 1 :b 2)) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (testing "map-kv with record" + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) (->MyRecord 1)) {"x" 2})))) + +(deftest test-map-keys + (is (= (m/map-keys name {:a 1 :b 2}) + {"a" 1 "b" 2})) + (is (= (m/map-keys name (sorted-map :a 1 :b 2)) + (sorted-map "a" 1 "b" 2))) + (testing "map-keys with record" + (is (= (m/map-keys name (->MyRecord 1)) {"x" 1})))) + +(deftest test-map-vals + (is (= (m/map-vals inc {:a 1 :b 2}) + {:a 2 :b 3})) + (is (= (m/map-vals inc (sorted-map :a 1 :b 2)) + (sorted-map :a 2 :b 3))) + (testing "map-vals with record" + (is (= (m/map-vals inc (->MyRecord 1)) {:x 2}))) + (testing "multiple collections" + (is (= (m/map-vals + {:a 1 :b 2 :c 3} {:a 4 :c 5 :d 6}) + {:a 5, :c 8})) + (is (= (m/map-vals min + (sorted-map :z 10 :y 8 :x 4) + {:x 7, :y 14, :z 13} + {:x 11, :y 6, :z 9} + {:x 19, :y 3, :z 2} + {:x 4, :y 0, :z 16} + {:x 17, :y 14, :z 13}) + (sorted-map :x 4 :y 0 :z 2))) + (is (= (m/map-vals #(%1 %2) {:a nil? :b some?} {:b nil}) + {:b false})))) + +(deftest test-map-kv-keys + (is (= (m/map-kv-keys + {1 2, 2 4}) + {3 2, 6 4})) + (is (= (m/map-kv-keys + (sorted-map 1 2, 2 4)) + (sorted-map 3 2, 6 4))) + (is (= (m/map-kv-keys str (->MyRecord 1)) + {":x1" 1}))) + +(deftest test-map-kv-vals + (is (= (m/map-kv-vals + {1 2, 2 4}) + {1 3, 2 6})) + (is (= (m/map-kv-vals + (sorted-map 1 2, 2 4)) + (sorted-map 1 3, 2 6))) + (is (= (m/map-kv-vals str (->MyRecord 1)) + {:x ":x1"}))) + +(deftest test-filter-kv + (is (= (m/filter-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {:b 2})) + (is (= (m/filter-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-keys + (is (= (m/filter-keys keyword? {"a" 1 :b 2}) + {:b 2})) + (is (= (m/filter-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-vals + (is (= (m/filter-vals even? {:a 1 :b 2}) + {:b 2})) + (is (= (m/filter-vals even? (sorted-map :a 1 :b 2)) + (sorted-map :b 2)))) + +(deftest test-remove-kv + (is (= (m/remove-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {"a" 1 :c "d"})) + (is (= (m/remove-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "a" 1)))) + +(deftest test-remove-keys + (is (= (m/remove-keys keyword? {"a" 1 :b 2}) + {"a" 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-remove-vals + (is (= (m/remove-vals even? {:a 1 :b 2}) + {:a 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-queue + (testing "empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue)))) + (is (empty? (m/queue)))) + (testing "not empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue [1 2 3]))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue [1 2 3])))) + (is (= (first (m/queue [1 2 3])) 1)))) + +(deftest test-queue? + #?(:clj (is (m/queue? clojure.lang.PersistentQueue/EMPTY)) + :cljs (is (m/queue? cljs.core.PersistentQueue.EMPTY))) + (is (not (m/queue? [])))) + +(deftest test-boolean? + (is (m/boolean? true)) + (is (m/boolean? false)) + (is (not (m/boolean? nil))) + (is (not (m/boolean? "foo"))) + (is (not (m/boolean? 1)))) + +(deftest test-least + (is (= (m/least) nil)) + (is (= (m/least "a") "a")) + (is (= (m/least "a" "b") "a")) + (is (= (m/least 3 2 5 -1 0 2) -1))) + +(deftest test-greatest + (is (= (m/greatest) nil)) + (is (= (m/greatest "a") "a")) + (is (= (m/greatest "a" "b") "b")) + (is (= (m/greatest 3 2 5 -1 0 2) 5))) + +(deftest test-join + (is (= (m/join [[1 2] [] [3] [4 5 6]]) [1 2 3 4 5 6])) + (is (= (m/join (sorted-map :x 1, :y 2, :z 3)) [:x 1 :y 2 :z 3])) + (let [a (atom 0) + s (m/join (iterate #(do (swap! a inc) (range (inc (count %)))) ()))] + (is (= (first s) 0)) + (is (= @a 1)) + (is (= (second s) 0)) + (is (= @a 2)))) + +(deftest test-deep-merge + (is (= (m/deep-merge) nil)) + (is (= (m/deep-merge {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} nil) {:a 1})) + (is (= (m/deep-merge {:a 1} {:a 2 :b 3}) {:a 2 :b 3})) + (is (= (m/deep-merge {:a {:b 1 :c 2}} {:a {:b 2 :d 3}}) {:a {:b 2 :c 2 :d 3}})) + (is (= (m/deep-merge {:a {:b 1}} {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} {:b 2} {:b 3 :c 4}) {:a 1 :b 3 :c 4})) + (is (= (m/deep-merge {:a {:b {:c {:d 1}}}} {:a {:b {:c {:e 2}}}}) {:a {:b {:c {:d 1 :e 2}}}})) + (is (= (m/deep-merge {:a {:b [1 2]}} {:a {:b [3 4]}}) {:a {:b [3 4]}})) + (is (= (m/deep-merge (->MyRecord 1) {:x 2}) (->MyRecord 2))) + (is (= (m/deep-merge {:a (->MyRecord 1)} {:a {:x 2 :y 3}}) {:a (map->MyRecord {:x 2 :y 3})}))) + +(deftest test-mapply + (letfn [(foo [& {:keys [bar]}] bar)] + (is (= (m/mapply foo {}) nil)) + (is (= (m/mapply foo {:baz 1}) nil)) + (is (= (m/mapply foo {:bar 1}) 1))) + (letfn [(foo [bar & {:keys [baz]}] [bar baz])] + (is (= (m/mapply foo 0 {}) [0 nil])) + (is (= (m/mapply foo 0 {:baz 1}) [0 1])) + (is (= (m/mapply foo 0 {:spam 1}) [0 nil])) + (is (= (m/mapply foo 0 nil) [0 nil])) + #?@(:clj [;; BB-TEST-PATCH: bb throws Exception + #_(is (thrown? ArityException (m/mapply foo {}))) + (is (thrown? IllegalArgumentException (m/mapply foo 0)))] + :cljs [(is (thrown? js/Error (m/mapply foo 0)))]))) + +(deftest test-index-by + (is (= (m/index-by identity [1 2 3]) {1 1, 2 2, 3 3})) + (is (= (m/index-by inc [1 2 3]) {2 1, 3 2, 4 3})) + (is (= (m/index-by first ["foo" "bar" "baz"]) {\f "foo", \b "baz"})) + (is (= (m/index-by first []) {}))) + +(deftest test-interleave-all + (is (= (m/interleave-all []) [])) + (is (= (m/interleave-all [1 2 3]) [1 2 3])) + (is (= (m/interleave-all [1 2 3] [4 5 6]) [1 4 2 5 3 6])) + (is (= (m/interleave-all [1 2 3] [4 5 6] [7 8 9]) [1 4 7 2 5 8 3 6 9])) + (is (= (m/interleave-all [1 2] [3]) [1 3 2])) + (is (= (m/interleave-all [1 2 3] [4 5]) [1 4 2 5 3])) + (is (= (m/interleave-all [1] [2 3] [4 5 6]) [1 2 4 3 5 6]))) + +(deftest test-distinct-by + (testing "sequences" + (is (= (m/distinct-by count ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (m/distinct-by count []) + [])) + (is (= (m/distinct-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/distinct-by count) ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (into [] (m/distinct-by count) []) + [])) + (is (= (into [] (m/distinct-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-dedupe-by + (testing "sequences" + (is (= (m/dedupe-by count ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (m/dedupe-by count []) + [])) + (is (= (m/dedupe-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/dedupe-by count) ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (into [] (m/dedupe-by count) []) + [])) + (is (= (into [] (m/dedupe-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-take-upto + (testing "sequences" + (is (= (m/take-upto zero? [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (m/take-upto zero? [0 1 2 3 4 5 6]) [0])) + (is (= (m/take-upto zero? [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7]))) + + (testing "tranducers" + (is (= (into [] (m/take-upto zero?) [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (into [] (m/take-upto zero?) [0 1 2 3 4 5 6]) [0])) + (is (= (into [] (m/take-upto zero?) [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7])) + (is (= (transduce (m/take-upto zero?) + (completing (fn [_ x] (reduced x))) + nil + [0 1 2]) + 0)))) + +(deftest test-drop-upto + (testing "sequences" + (is (= (m/drop-upto zero? [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (m/drop-upto zero? [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (m/drop-upto zero? [1 2 3 4 5 6 7]) []))) + + (testing "transducers" + (is (= (into [] (m/drop-upto zero?) [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (into [] (m/drop-upto zero?) [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (into [] (m/drop-upto zero?) [1 2 3 4 5 6 7]) [])))) + +(deftest test-indexed + (testing "sequences" + (is (= (m/indexed [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (m/indexed []) + []))) + + (testing "transducers" + (is (= (into [] (m/indexed) [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (into [] (m/indexed) []) + [])))) + +(deftest test-insert-nth + (testing "sequences" + (is (= (m/insert-nth 0 :a [1 2 3 4]) [:a 1 2 3 4])) + (is (= (m/insert-nth 1 :a [1 2 3 4]) [1 :a 2 3 4])) + (is (= (m/insert-nth 3 :a [1 2 3 4]) [1 2 3 :a 4])) + (is (= (m/insert-nth 4 :a [1 2 3 4]) [1 2 3 4 :a]))) + + (testing "transducers" + (is (= (into [] (m/insert-nth 0 :a) [1 2 3 4]) [:a 1 2 3 4])) + (is (= (into [] (m/insert-nth 1 :a) [1 2 3 4]) [1 :a 2 3 4])) + (is (= (into [] (m/insert-nth 3 :a) [1 2 3 4]) [1 2 3 :a 4])) + (is (= (into [] (m/insert-nth 4 :a) [1 2 3 4]) [1 2 3 4 :a])))) + +(deftest test-remove-nth + (testing "sequences" + (is (= (m/remove-nth 0 [1 2 3 4]) [2 3 4])) + (is (= (m/remove-nth 1 [1 2 3 4]) [1 3 4])) + (is (= (m/remove-nth 3 [1 2 3 4]) [1 2 3]))) + + (testing "transducers" + (is (= (into [] (m/remove-nth 0) [1 2 3 4]) [2 3 4])) + (is (= (into [] (m/remove-nth 1) [1 2 3 4]) [1 3 4])) + (is (= (into [] (m/remove-nth 3) [1 2 3 4]) [1 2 3])))) + +(deftest test-replace-nth + (testing "sequences" + (is (= (m/replace-nth 0 :a [1 2 3 4]) [:a 2 3 4])) + (is (= (m/replace-nth 1 :a [1 2 3 4]) [1 :a 3 4])) + (is (= (m/replace-nth 3 :a [1 2 3 4]) [1 2 3 :a]))) + + (testing "transducers" + (is (= (into [] (m/replace-nth 0 :a) [1 2 3 4]) [:a 2 3 4])) + (is (= (into [] (m/replace-nth 1 :a) [1 2 3 4]) [1 :a 3 4])) + (is (= (into [] (m/replace-nth 3 :a) [1 2 3 4]) [1 2 3 :a])))) + +(deftest test-abs + (is (= (m/abs -3) 3)) + (is (= (m/abs 2) 2)) + (is (= (m/abs -2.1) 2.1)) + (is (= (m/abs 1.8) 1.8)) + #?@(:clj [(is (= (m/abs -1/3) 1/3)) + (is (= (m/abs 1/2) 1/2)) + (is (= (m/abs 3N) 3N)) + (is (= (m/abs -4N) 4N))])) + +(deftest test-deref-swap! + (let [a (atom 0)] + (is (= (m/deref-swap! a inc) 0)) + (is (= @a 1)) + (is (= (m/deref-swap! a inc) 1)) + (is (= @a 2)))) + +(deftest test-deref-reset! + (let [a (atom 0)] + (is (= (m/deref-reset! a 3) 0)) + (is (= @a 3)) + (is (= (m/deref-reset! a 1) 3)) + (is (= @a 1)))) + +(deftest test-ex-message + (is (= (m/ex-message (ex-info "foo" {})) "foo")) + (is (= (m/ex-message (new #?(:clj Exception :cljs js/Error) "bar")) "bar"))) + +(deftest test-ex-cause + (let [cause (new #?(:clj Exception :cljs js/Error) "foo")] + (is (= (m/ex-cause (ex-info "foo" {} cause)) cause)) + #?(:clj (is (= (m/ex-cause (Exception. "foo" cause)) cause))))) + +(deftest test-uuid? + (let [x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6"] + (is (m/uuid? x)) + (is (not (m/uuid? 2))) + (is (not (m/uuid? (str x)))) + (is (not (m/uuid? nil))))) + +(deftest test-uuid + (let [x (m/uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (= x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")))) + +(deftest test-random-uuid + (let [x (m/random-uuid) + y (m/random-uuid)] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) y)) + (is (not= x y)))) + +;; BB-TEST-PATCH: Not available yet for latest maven release +#_(deftest test-regexp? + (is (m/regexp? #"x")) + (is (not (m/regexp? "x"))) + (is (not (m/regexp? nil)))) diff --git a/test-resources/lib_tests/medley/test_runner.cljs b/test-resources/lib_tests/medley/test_runner.cljs new file mode 100644 index 00000000..4cc95109 --- /dev/null +++ b/test-resources/lib_tests/medley/test_runner.cljs @@ -0,0 +1,5 @@ +(ns medley.test-runner + (:require [doo.runner :refer-macros [doo-tests]] + [medley.core-test])) + +(doo-tests 'medley.core-test) diff --git a/test-resources/lib_tests/minimallist/core_test.cljc b/test-resources/lib_tests/minimallist/core_test.cljc index d86176f1..1faaaa23 100644 --- a/test-resources/lib_tests/minimallist/core_test.cljc +++ b/test-resources/lib_tests/minimallist/core_test.cljc @@ -40,6 +40,16 @@ [1] [2] + (-> (h/fn int?) + (h/with-condition (h/fn odd?))) + [1] + [2] + + (-> (h/fn symbol?) + (h/with-condition (h/fn (complement #{'if 'val})))) + ['a] + ['if] + ;; enum (h/enum #{1 "2" :3}) [1 "2" :3] @@ -79,8 +89,7 @@ {:a 1, :b 'bar, [1 2 3] "soleil !"}] ;; map, keys and values - (h/map-of (h/fn keyword?) - (h/fn int?)) + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) [{} {:a 1, :b 2}] [{:a 1, :b "2"} [[:a 1] [:b 2]] {true 1, false 2}] @@ -89,6 +98,10 @@ ['(1 2 3) [1 2 3] `(1 2 ~3)] ['(1 :a) #{1 2 3} {:a 1, :b 2, :c 3}] + (h/sequence-of (h/fn char?)) + ["" "hi" "hello"] + [[1 2 3]] + ;; sequence, with condition (-> (h/sequence-of (h/fn int?)) (h/with-condition (h/fn (fn [coll] (= coll (reverse coll)))))) @@ -97,29 +110,38 @@ ;; sequence as a list (h/list-of (h/fn int?)) - ['(1 2 3)] - ['(1 :a) [1 2 3] #{1 2 3} - #_`(1 2 ~3)] ; this is not a list in cljs + ['(1 2 3) `(1 2 ~3)] + ['(1 :a) [1 2 3] #{1 2 3}] ;; sequence as a vector (h/vector-of (h/fn int?)) [[1 2 3]] [[1 :a] '(1 2 3) #{1 2 3} `(1 2 ~3)] + ;; sequence as a string + (h/string-of (h/enum (set "0123456789abcdef"))) + ["03ab4c" "cafe"] + ["coffee" [1 :a] '(1 2 3) #{1 2 3} `(1 2 ~3)] + ;; sequence with size specified using a model (-> (h/sequence-of (h/fn any?)) (h/with-count (h/enum #{2 3}))) - ['(1 2) [1 "2"] `(1 ~"2") [1 "2" :3]] - [#{1 "a"} [1 "2" :3 :4]] + ['(1 2) [1 "2"] `(1 ~"2") [1 "2" :3] "hi"] + [#{1 "a"} [1 "2" :3 :4] "hello"] ;; sequence with entries (fixed size is implied) (h/tuple (h/fn int?) (h/fn string?)) ['(1 "2") [1 "2"] `(1 ~"2")] [#{1 "a"} [1 "2" :3]] + ;; sequence with entries in a string + (h/string-tuple (h/val \a) (h/enum #{\b \c})) + ["ab" "ac"] + [[\a \b] #{\a \b}] + ;; alt (h/alt [:int (h/fn int?)] - [:strings (h/cat (h/fn string?))]) + [:strings (h/vector-of (h/fn string?))]) [1 ["1"]] [[1] "1" :1 [:1]] @@ -144,6 +166,12 @@ [[1 "2" 3] [1 :2 3] [1 ["a" :b] 3]] [[1 "a" :b 3]] + ;; cat & repeat - a color string + (-> (h/cat (h/val \#) + (h/repeat 6 6 (h/enum (set "0123456789abcdefABCDEF"))))) + ["#000000" "#af4Ea5"] + ["000000" "#cafe" "#coffee"] + ;; cat of cat, the inner cat is implicitly inlined (-> (h/cat (h/fn int?) (h/cat (h/fn int?))) @@ -163,15 +191,20 @@ [[] [1] [1 2] '() '(1) '(2 3)] [[1 2 3] '(1 2 3)] + ;; repeat - inside a list + (h/in-list (h/repeat 0 2 (h/fn int?))) + ['() '(1) '(2 3)] + [[] [1] [1 2] [1 2 3] '(1 2 3)] + ;; repeat - inside a vector (h/in-vector (h/repeat 0 2 (h/fn int?))) [[] [1] [1 2]] [[1 2 3] '() '(1) '(2 3) '(1 2 3)] - ;; repeat - inside a list - (h/in-list (h/repeat 0 2 (h/fn int?))) - ['() '(1) '(2 3)] - [[] [1] [1 2] [1 2 3] '(1 2 3)] + ;; repeat - inside a string + (h/in-string (h/repeat 4 6 (h/fn char?))) + ["hello"] + ["" "hi" [] [1] '(1 2 3)] ;; repeat - min > 0 (h/repeat 2 3 (h/fn int?)) @@ -196,6 +229,16 @@ [[[1 "a"]] [[1 "a"] [2 "b"]] ['(1 "a") [2 "b"]]] [[] [1] [1 2] [1 "a"] [1 "a" 2 "b"] [1 "a" 2 "b" 3 "c"]] + ;; char-cat & char-set + (-> (h/cat (h/char-cat "good") + (h/val \space) + (h/alt (h/char-cat "morning") + (h/char-cat "afternoon") + (h/repeat 3 10 (h/char-set "#?!@_*+%")))) + (h/in-string)) + ["good morning" "good afternoon" "good #@*+?!"] + ["good" "good " "good day"] + ;; let / ref (h/let ['pos-even? (h/and (h/fn pos-int?) (h/fn even?))] @@ -236,14 +279,24 @@ [1 1 1 "hi" "hi" "hi"]] [[1 1 "hi"] [1 "hi" "hi"] - [1 1 :no "hi" "hi"]]]] + [1 1 :no "hi" "hi"]] + ; let / ref - with shadowed local model + (h/let ['foo (h/ref 'bar) + 'bar (h/fn int?)] + (h/let ['bar (h/fn string?)] + (h/ref 'foo))) + [1] + ["hi"]]] (doseq [[model valid-coll invalid-coll] (partition 3 test-data)] (doseq [data valid-coll] (is (valid? model data))) (doseq [data invalid-coll] - (is (not (valid? model data))))))) + (is (not (valid? model data)))))) + + (is (thrown? #?(:clj Exception :cljs js/Object) + (valid? (h/let [] (h/ref 'foo)) 'bar)))) (deftest describe-test @@ -252,6 +305,16 @@ [1 1 2 :invalid] + (-> (h/fn int?) + (h/with-condition (h/fn odd?))) + [1 1 + 2 :invalid] + + (-> (h/fn symbol?) + (h/with-condition (h/fn (complement #{'if 'val})))) + ['a 'a + 'if :invalid] + ;; enum (h/enum #{1 "2" false nil}) [1 1 @@ -278,7 +341,7 @@ ;; set (h/set-of (h/fn int?)) - [#{1} #{1}] + [#{1 2} [1 2]] ;; map (h/map [:a {:optional true} (h/fn int?)] @@ -294,20 +357,29 @@ ; extra entry {:a 1, :b 2, :c 3} {:a 1, :b 2}] - ;; map-of - :keys - (h/map-of (h/fn keyword?) (h/fn any?)) - [{:a 1, :b 2} {:a 1, :b 2} + ;; map-of - entry-model + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + [{:a 1, :b 2} [[:a 1] [:b 2]] {"a" 1} :invalid] - ;; map-of - :values - (h/map-of (h/fn any?) (h/fn int?)) - [{:a 1, "b" 2} {:a 1, "b" 2} - {:a "1"} :invalid] + ;; map-of - real world use case + (h/map-of (h/alt [:symbol (h/vector (h/fn simple-symbol?) (h/fn keyword?))] + [:keys (h/vector (h/val :keys) (h/vector-of (h/fn symbol?)))] + [:as (h/vector (h/val :as) (h/fn simple-symbol?))])) + '[{first-name :first-name + last-name :last-name + :keys [foo bar] + :as foobar} + [[:symbol [first-name :first-name]] + [:symbol [last-name :last-name]] + [:keys [:keys [foo bar]]] + [:as [:as foobar]]]] ;; sequence - :elements-model (h/sequence-of (h/fn int?)) [[1 2 3] [1 2 3] '(1 2 3) '(1 2 3) + `(1 2 3) '(1 2 3) [1 "2" 3] :invalid] ;; sequence - :elements-model with condition @@ -319,7 +391,14 @@ ;; sequence - :coll-type vector (h/vector-of (h/fn any?)) [[1 2 3] [1 2 3] - '(1 2 3) :invalid] + '(1 2 3) :invalid + `(1 2 3) :invalid] + + ;; sequence - :coll-type list + (h/list-of (h/fn any?)) + [[1 2 3] :invalid + '(1 2 3) '(1 2 3) + `(1 2 3) '(1 2 3)] ;; sequence - :entries (h/tuple (h/fn int?) (h/fn string?)) @@ -327,16 +406,27 @@ [1 2] :invalid [1] :invalid] + (h/tuple (h/fn int?) + [:text (h/fn string?)]) + [[1 "a"] {:text "a"}] + + (h/tuple [:number (h/fn int?)] + [:text (h/fn string?)]) + [[1 "a"] {:number 1, :text "a"}] + ;; sequence - :count-model (-> (h/sequence-of (h/fn any?)) (h/with-count (h/val 3))) [[1 2] :invalid [1 2 3] [1 2 3] - [1 2 3 4] :invalid] + [1 2 3 4] :invalid + "12" :invalid + "123" (into [] "123") + "1234" :invalid] ;; alt - not inside a sequence (h/alt [:number (h/fn int?)] - [:sequence (h/cat (h/fn string?))]) + [:sequence (h/vector-of (h/fn string?))]) [1 [:number 1] ["1"] [:sequence ["1"]] [1] :invalid @@ -457,4 +547,7 @@ (doseq [[model data-description-pairs] (partition 2 test-data)] (doseq [[data description] (partition 2 data-description-pairs)] (is (= [data (describe model data)] - [data description])))))) + [data description]))))) + + (is (thrown? #?(:clj Exception :cljs js/Object) + (describe (h/let [] (h/ref 'foo)) 'bar)))) diff --git a/test-resources/lib_tests/minimallist/generator_test.cljc b/test-resources/lib_tests/minimallist/generator_test.cljc new file mode 100644 index 00000000..af9f8706 --- /dev/null +++ b/test-resources/lib_tests/minimallist/generator_test.cljc @@ -0,0 +1,546 @@ +(ns minimallist.generator-test + (:require [clojure.test :refer [deftest testing is are]] + [clojure.test.check.generators :as tcg] + [clojure.string :as str] + [minimallist.core :refer [valid?]] + [minimallist.helper :as h] + [minimallist.util :as util] + [minimallist.generator :as mg :refer [gen fn-any? fn-int? fn-string? fn-char? + fn-symbol? fn-simple-symbol? fn-qualified-symbol? + fn-keyword? fn-simple-keyword? fn-qualified-keyword?]])) + +(defn- path-test-visitor [] + ;; Testing using side effects. + ;; A little ugly, but good enough for tests. + (let [paths (atom [])] + (fn + ([] @paths) + ([model stack path] + (swap! paths conj path) + model)))) + +(deftest postwalk-visit-order-test + (are [model expected-paths] + (let [visitor (path-test-visitor)] + (mg/postwalk model visitor) ; Create side effects + (= (visitor) expected-paths)) ; Collect and compare the side effects + + (h/let ['leaf (h/fn int?) + 'tree (h/ref 'leaf)] + (h/ref 'tree)) + [[:bindings 'leaf] + [:bindings 'tree] + [:body] + []] + + (h/let ['root (h/let ['leaf (h/fn int?) + 'tree (h/ref 'leaf)] + (h/ref 'tree))] + (h/ref 'root)) + [[:bindings 'root :bindings 'leaf] + [:bindings 'root :bindings 'tree] + [:bindings 'root :body] + [:bindings 'root] + [:body] + []] + + (h/let ['leaf (h/fn int?) + 'root (h/let ['tree (h/ref 'leaf)] + (h/ref 'tree))] + (h/ref 'root)) + [[:bindings 'leaf] + [:bindings 'root :bindings 'tree] + [:bindings 'root :body] + [:bindings 'root] + [:body] + []] + + ; test of no visit more than once + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'leaf) (h/ref 'leaf))] + (h/ref 'tree)) + [[:bindings 'leaf] + [:bindings 'tree :entries 0 :model] + [:bindings 'tree :entries 1 :model] + [:bindings 'tree] + [:body] + []] + + ; test of no visit more than once, infinite loop otherwise + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + [[:bindings 'tree :entries 0 :model] + [:bindings 'leaf] + [:bindings 'tree :entries 1 :model] + [:bindings 'tree] + [:body] + []] + + #__)) + +(deftest assoc-leaf-distance-visitor-test + (are [model expected-walked-model] + (= (-> model + (mg/postwalk mg/assoc-leaf-distance-visitor) + (util/walk-map-dissoc :fn)) + expected-walked-model) + + ; Recursive data-structure impossible to generate + ; This one is trying to bring the generator function in an infinite loop. + (h/let ['loop (h/ref 'loop)] + (h/ref 'loop)) + {:type :let + :bindings {'loop {:type :ref + :key 'loop}} + :body {:type :ref + :key 'loop}} + + ; Recursive data-structure impossible to generate + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + {:type :let + :bindings {'leaf {:type :fn + ::mg/leaf-distance 0} + 'tree {:type :sequence + :entries [{:model {:type :ref + :key 'tree}} + {:model {:type :ref + :key 'leaf + ::mg/leaf-distance 1}}]}} + :body {:type :ref + :key 'tree}} + + ; Recursive data-structure impossible to generate + (h/let ['rec-map (h/map [:a (h/fn int?)] + [:b (h/ref 'rec-map)])] + (h/ref 'rec-map)) + {:type :let + :bindings {'rec-map {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/leaf-distance 0}} + {:key :b + :model {:type :ref + :key 'rec-map}}]}} + :body {:type :ref + :key 'rec-map}} + + ; Recursive data-structure which can be generated + (h/let ['leaf (h/fn int?) + 'tree (h/alt (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + {:type :let + :bindings {'leaf {:type :fn + ::mg/leaf-distance 0} + 'tree {:type :alt + :entries [{:model {:type :ref + :key 'tree}} + {:model {:type :ref + :key 'leaf + ::mg/leaf-distance 1}}] + ::mg/leaf-distance 2}} + :body {:type :ref + :key 'tree + ::mg/leaf-distance 3} + ::mg/leaf-distance 4} + + (h/let ['rec-map (h/map [:a (h/fn int?)] + [:b {:optional true} (h/ref 'rec-map)])] + (h/ref 'rec-map)) + {:type :let + :bindings {'rec-map {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/leaf-distance 0}} + {:key :b + :optional true + :model {:type :ref + :key 'rec-map}}] + ::mg/leaf-distance 1}} + :body {:type :ref + :key 'rec-map + ::mg/leaf-distance 2} + ::mg/leaf-distance 3} + + #__)) + + +(deftest assoc-min-cost-visitor-test + (are [model expected-walked-model] + (= (-> model + (mg/postwalk mg/assoc-min-cost-visitor) + (util/walk-map-dissoc :fn)) + expected-walked-model) + + (h/tuple (h/fn int?) (h/fn string?)) + {:type :sequence + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/cat (h/fn int?) (h/fn string?)) + {:type :cat + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/in-vector (h/cat (h/fn int?) (h/fn string?))) + {:type :cat + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/not-inlined (h/cat (h/fn int?) (h/fn string?))) + {:type :cat + :inlined false + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/map [:a (h/fn int?)] + [:b {:optional true} (h/fn int?)]) + {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/min-cost 1}} + {:key :b + :optional true + :model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 2} + + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + {:type :map-of + :entry-model {:type :sequence + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + ::mg/min-cost 1} + + (-> (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + (h/with-count (h/enum #{3 4}))) + {:type :map-of + :entry-model {:type :sequence + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + :count-model {:type :enum + :values #{3 4}} + ::mg/min-cost 7} + + (h/set-of (h/fn any?)) + {:type :set-of + :elements-model {:type :fn + ::mg/min-cost 1} + ::mg/min-cost 1} + + (-> (h/set-of (h/fn any?)) + (h/with-count (h/val 3))) + {:type :set-of + :elements-model {:type :fn + ::mg/min-cost 1} + :count-model {:type :enum + :values #{3}} + ::mg/min-cost 4} + + (h/let ['foo (-> (h/set-of (h/fn int?)) + (h/with-count (h/val 3)))] + (h/ref 'foo)) + {:type :let + :bindings {'foo {:type :set-of + :count-model {:type :enum + :values #{3}} + :elements-model {:type :fn + ::mg/min-cost 1} + ::mg/min-cost 4}} + :body {:type :ref + :key 'foo + ::mg/min-cost 4} + ::mg/min-cost 4} + + #__)) + +(deftest budget-split-gen-test + (is (every? (fn [[a b c]] + (and (<= 0 a 5) + (<= 5 b 10) + (<= 10 c 15))) + (-> (#'mg/budget-split-gen 20.0 [0 5 10]) + tcg/sample))) + (is (every? #(= % [5 10 10]) + (-> (#'mg/budget-split-gen 20.0 [5 10 10]) + tcg/sample))) + (is (every? empty? + (-> (#'mg/budget-split-gen 10.0 []) + tcg/sample)))) + +(comment + ;; For occasional hand testing + + (tcg/sample (gen (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count)))))) + + (tcg/sample (gen (h/map-of (h/vector fn-int? fn-simple-symbol?)))) + + (tcg/sample (gen (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?])))) + + (tcg/sample (gen (h/sequence-of fn-int?))) + + (tcg/sample (gen (h/tuple fn-int? fn-string?))) + + (tcg/sample (gen (h/cat fn-int? fn-string?))) + + (tcg/sample (gen (h/repeat 2 3 fn-int?))) + + (tcg/sample (gen (h/repeat 2 3 (h/cat fn-int? fn-string?)))) + + (tcg/sample (gen (h/let ['int? fn-int? + 'string? fn-string? + 'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))] + (h/repeat 2 3 (h/ref 'int-string?))))) + + (tcg/sample (gen (-> (h/set-of fn-int?) + (h/with-condition (h/fn (fn [coll] + (or (empty? coll) + (some even? coll)))))))) + + (tcg/sample (gen (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count)))))) + + (tcg/sample (gen (h/let ['node (h/set-of (h/ref 'node))] + (h/ref 'node)))) + + (tcg/sample (gen (h/let ['node (h/map-of (h/vector fn-int? (h/ref 'node)))] + (h/ref 'node)) 50)) + + (tcg/sample (gen (h/let ['node (h/map-of (h/vector fn-keyword? (h/ref 'node)))] + (h/ref 'node)) 100) 1) + + (tcg/sample (gen (h/map [:a fn-int?]))) + + (tcg/sample (gen (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?])))) + + (tcg/sample (gen (h/cat (h/vector-of fn-int?) + (h/vector-of fn-int?)) 20)) + + (tcg/sample (gen (h/repeat 5 10 fn-int?))) + + (tcg/sample (gen fn-symbol?)) + (tcg/sample (gen fn-simple-symbol?)) + (tcg/sample (gen fn-qualified-symbol?)) + + (tcg/sample (gen fn-keyword?)) + (tcg/sample (gen fn-simple-keyword?)) + (tcg/sample (gen fn-qualified-keyword?)) + + (tcg/sample (gen (-> (h/cat (h/char-cat "good") + (h/val \space) + (h/alt (h/char-cat "morning") + (h/char-cat "afternoon") + (h/repeat 3 10 (h/char-set "#?!@_*+%")))) + (h/in-string))) + 100) + + + #__) + +(deftest gen-test + (let [model fn-string?] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/enum #{:1 2 "3"})] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/set-of fn-int?) + (h/with-condition (h/fn (fn [coll] + (or (empty? coll) + (some even? coll))))))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count))))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/map-of (h/vector fn-int? fn-string?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?]) + (h/with-entries [:c fn-int?]) + (h/with-optional-entries [:d fn-string?])) + sample (tcg/sample (gen model) 100)] + (is (and (every? (partial valid? model) sample) + (every? (fn [element] (contains? element :a)) sample) + (some (fn [element] (contains? element :b)) sample) + (some (fn [element] (not (contains? element :b))) sample) + (every? (fn [element] (contains? element :c)) sample) + (some (fn [element] (contains? element :d)) sample) + (some (fn [element] (not (contains? element :d))) sample)))) + + (let [model (h/sequence-of fn-int?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/tuple fn-int? fn-string?) + sample (tcg/sample (gen model) 100)] + (is (and (every? (partial valid? model) sample) + (some list? sample) + (some vector? sample)))) + + (let [model (h/list fn-int? fn-string?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? list? sample)))) + + (let [model (h/vector fn-int? fn-string?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? vector? sample)))) + + (let [model (h/string-tuple fn-char? fn-char?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? string? sample)))) + + (let [model (h/in-list (h/cat fn-int? fn-string?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? list? sample)))) + + (let [model (h/in-vector (h/cat fn-int? fn-string?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? vector? sample)))) + + (let [model (h/in-string (h/cat fn-char? fn-char?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? string? sample)))) + + (let [model (h/alt fn-int? fn-string?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/cat fn-int? fn-string?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/repeat 2 3 fn-int?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/repeat 2 3 (h/cat fn-int? fn-string?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/not-inlined (h/cat fn-int?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/not-inlined (h/repeat 1 2 fn-int?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/let ['int? fn-int? + 'string? fn-string? + 'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))] + (h/repeat 2 3 (h/ref 'int-string?)))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on model choice. + (let [model (h/let ['tree (h/alt [:leaf fn-int?] + [:branch (h/vector (h/ref 'tree) + (h/ref 'tree))])] + (h/ref 'tree))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable set size. + (let [model (h/let ['node (h/set-of (h/ref 'node))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable sequence size. + (let [model (h/let ['node (h/vector-of (h/ref 'node))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable map size. + (let [model (h/let ['node (h/map-of (h/vector fn-int? (h/ref 'node)))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on optional entries in a map. + (let [model (h/let ['node (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:x (h/ref 'node)] + [:y (h/ref 'node)] + [:z (h/ref 'node)]))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;;; Budget-based limit on number of occurrences in a repeat. + ;(let [model (h/let ['node (h/repeat 0 1 (h/ref 'node))] + ; (h/ref 'node))] + ; (is (every? (partial valid? model) + ; (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/map [:a (h/ref 'node)])] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/tuple (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/cat (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/cat (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + (let [model (h/let ['node (h/repeat 1 2 (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model)))))) + +;; TODO: [later] reuse the cat-ipsum model for parsing the output. + +;; TODO: in the :alt node, introduce a property :occurrence for the generator. +;; TODO: generate models, use them to generate data, should not stack overflow. diff --git a/test-resources/lib_tests/minimallist/util_test.cljc b/test-resources/lib_tests/minimallist/util_test.cljc new file mode 100644 index 00000000..3a0fbd0f --- /dev/null +++ b/test-resources/lib_tests/minimallist/util_test.cljc @@ -0,0 +1,53 @@ +(ns minimallist.util-test + (:require [clojure.test :refer [deftest testing is are]] + [minimallist.util :as util] + [minimallist.helper :as h])) + +(deftest reduce-update-test + (let [m {:a 1 + :b 5} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (-> [[] m] + (util/reduce-update :a f) + (util/reduce-update :b f)) + [[10 50] {:a 10, :b 50}])))) + +(deftest reduce-update-in-test + (let [m {:a {:x 1, :y 2} + :b [3 4 5]} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (-> [[] m] + (util/reduce-update-in [:a :x] f) + (util/reduce-update-in [:b 2] f)) + [[10 50] {:a {:x 10, :y 2}, :b [3 4 50]}])))) + +(deftest reduce-mapv + (let [m {:a {:x 1, :y 2} + :b [3 4 5]} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (util/reduce-update [[] m] :b (partial util/reduce-mapv f)) + [[30 40 50] {:a {:x 1, :y 2}, :b [30 40 50]}])))) + +(deftest iterate-while-different-test + (let [inc-up-to-10 (fn [x] (cond-> x (< x 10) inc))] + (is (= (util/iterate-while-different inc-up-to-10 0 0) 0)) + (is (= (util/iterate-while-different inc-up-to-10 0 5) 5)) + (is (= (util/iterate-while-different inc-up-to-10 0 10) 10)) + (is (= (util/iterate-while-different inc-up-to-10 0 15) 10)) + + (is (= (util/iterate-while-different inc-up-to-10 7 2) 9)) + (is (= (util/iterate-while-different inc-up-to-10 7 3) 10)) + (is (= (util/iterate-while-different inc-up-to-10 7 4) 10)) + + (is (= (util/iterate-while-different inc-up-to-10 12 0) 12)) + (is (= (util/iterate-while-different inc-up-to-10 12 3) 12)) + + (is (= (util/iterate-while-different inc-up-to-10 0 ##Inf) 10)) + (is (= (util/iterate-while-different inc-up-to-10 10 ##Inf) 10)) + (is (= (util/iterate-while-different inc-up-to-10 15 ##Inf) 15)))) 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..4b12f6ac --- /dev/null +++ b/test-resources/lib_tests/progrock/core_test.clj @@ -0,0 +1,43 @@ +(ns progrock.core-test + (:require [clojure.test :refer :all] + [clojure.string :as str] + [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: --:--")) + ;; BB-TEST-PATCH: Make windows compatible + (is (= (str/trim (with-out-str (pr/print (pr/done bar) {:length 10}))) + "0/50 0% [ ] ETA: --:--")))) diff --git a/test-resources/lib_tests/slingshot/slingshot_test.clj b/test-resources/lib_tests/slingshot/slingshot_test.clj index 09938332..f787a862 100644 --- a/test-resources/lib_tests/slingshot/slingshot_test.clj +++ b/test-resources/lib_tests/slingshot/slingshot_test.clj @@ -74,18 +74,19 @@ (mega-try (throw+ exception-1)) (mega-try (throw exception-1)) (try (throw+ exception-1) - (catch Exception e [:class-exception e])) + (catch Exception e [:class-exception e])) (try (throw exception-1) - (catch Exception e [:class-exception e]))))) + (catch Exception e [:class-exception e]))))) (testing "IllegalArgumentException thrown by clojure/core" (is (= :class-iae (first (mega-try (str/replace "foo" 1 1))))))) (testing "catch by java class generically" (is (= [:class-string "fail"] (mega-try (throw+ "fail"))))) + ;; BB-TEST-PATCH: bb has different record internals #_(testing "catch by clojure record type" - (is (= [:class-exception-record exception-record-1] - (mega-try (throw+ exception-record-1))))) + (is (= [:class-exception-record exception-record-1] + (mega-try (throw+ exception-record-1))))) (testing "catch by key is present" (is (= [:key-is-present #{:a-key}] (mega-try (throw+ #{:a-key}))))) diff --git a/test-resources/lib_tests/slingshot/support_test.clj b/test-resources/lib_tests/slingshot/support_test.clj index 12d2c142..9618bd73 100644 --- a/test-resources/lib_tests/slingshot/support_test.clj +++ b/test-resources/lib_tests/slingshot/support_test.clj @@ -46,9 +46,11 @@ (defn stack-trace-fn [] (stack-trace)) +;; BB-TEST-PATCH: Returns jdk.internal.reflect.DelegatingMethodAccessorImpl +;; instead of what's expected #_(deftest test-stack-trace (let [{:keys [methodName className]} (-> (stack-trace-fn) first bean)] - (is (= methodName "invoke")) + (is (.startsWith ^String methodName "invoke")) (is (re-find #"stack_trace_fn" className)))) (deftest test-resolve-local diff --git a/test-resources/lib_tests/table/core_test.clj b/test-resources/lib_tests/table/core_test.clj index c2e609bf..336f85e1 100644 --- a/test-resources/lib_tests/table/core_test.clj +++ b/test-resources/lib_tests/table/core_test.clj @@ -310,7 +310,7 @@ ") (table-str [[1 2] [:c :d] [:a :b]] :sort true)))) -;; BB-TEST-PATCH: Intermittent failing test +;; TODO: Intermittent failing test #_(deftest test-table-with-sort-option-as-field-name (is (= (unindent 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))))) diff --git a/test-resources/lib_tests/version_clj/compare_test.cljc b/test-resources/lib_tests/version_clj/compare_test.cljc index c7ac75df..3eb0222f 100644 --- a/test-resources/lib_tests/version_clj/compare_test.cljc +++ b/test-resources/lib_tests/version_clj/compare_test.cljc @@ -70,4 +70,13 @@ ;; Some more zero-extension Tests "1-SNAPSHOT" "1.0-SNAPSHOT" 0 "1-alpha" "1-alpha0" 0 + + ;; Prefixed versions + "v1" "v1" 0 + "v1" "v2" -1 + "v1" "v1.1" -1 + "v1.1" "v1.2" -1 + "v1.1" "v2" -1 + "alpaca1.0" "bermuda1.0" -1 )) + diff --git a/test-resources/lib_tests/version_clj/split_test.cljc b/test-resources/lib_tests/version_clj/split_test.cljc index 51cac090..54ae6ab2 100644 --- a/test-resources/lib_tests/version_clj/split_test.cljc +++ b/test-resources/lib_tests/version_clj/split_test.cljc @@ -35,6 +35,10 @@ "0.5.0-alpha.1" [[0 5 0] ["alpha" 1]] "0.5.0-alpha.1" [[0 5 0] ["alpha" 1]] "0.0.3-alpha.8+oryOS.15" [[0 0 3] ["alpha" [8 "+oryos"] 15]] + "v1" [["v" 1]] + "v1.1" [["v" [1 1]]] + "ver1" [["ver" 1]] + "ver1.1" [["ver" [1 1]]] )) (deftest t-split-without-qualifiers diff --git a/test-resources/lib_tests/version_clj/via_use_test.clj b/test-resources/lib_tests/version_clj/via_use_test.clj index f75fa6bd..0d4e7526 100644 --- a/test-resources/lib_tests/version_clj/via_use_test.clj +++ b/test-resources/lib_tests/version_clj/via_use_test.clj @@ -6,6 +6,7 @@ (use 'version-clj.core) +;; BB-TEST-PATCH: This test doesn't exist upstream (deftest sanity-test (is (= [[1 0 0] ["snapshot"]] (version->seq "1.0.0-SNAPSHOT"))) (is (= 0 (version-compare "1.0" "1.0.0")))