luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Finish up library tests (#1120)

Browse source 
* 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 c663ab8368.

* Fix and disable failing tests

Disabled tests that fail consistently and fixed windows one
This commit is contained in:
Gabriel Horner 2021-12-29 10:35:14 -05:00 committed by GitHub
parent 367cf7bf26
commit 665ae4dd97
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
100 changed files with 11043 additions and 459 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
deps.edn
View file

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

8
doc/dev.md
View file

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

72
doc/libraries.csv Normal file
View file

@ -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
1 maven-name git-url
2 aero/aero http://github.com/juxt/aero
3 amperity/vault-clj https://github.com/amperity/vault-clj
4 babashka/babashka.curl https://github.com/babashka/babashka.curl
5 better-cond/better-cond https://github.com/Engelberg/better-cond
6 borkdude/deps https://github.com/borkdude/deps.clj
7 borkdude/missing.test.assertions https://github.com/borkdude/missing.test.assertions
8 borkdude/rewrite-edn https://github.com/borkdude/rewrite-edn
9 camel-snake-kebab/camel-snake-kebab https://github.com/clj-commons/camel-snake-kebab
10 circleci/bond https://github.com/circleci/bond
11 clj-commons/clj-yaml https://github.com/clj-commons/clj-yaml
12 clj-commons/multigrep https://github.com/clj-commons/multigrep
13 clojure-csv/clojure-csv https://github.com/davidsantiago/clojure-csv
14 clojure-term-colors/clojure-term-colors https://github.com/trhura/clojure-term-colors
15 com.github.seancorfield/honeysql https://github.com/seancorfield/honeysql
16 com.grammarly/omniconf https://github.com/grammarly/omniconf
17 com.stuartsierra/component https://github.com/stuartsierra/component
18 com.stuartsierra/dependency https://github.com/stuartsierra/dependency
19 comb/comb https://github.com/weavejester/comb
20 cprop/cprop https://github.com/tolitius/cprop
21 crispin/crispin https://github.com/dunaj-project/crispin
22 dev.nubank/docopt https://github.com/nubank/docopt.clj
23 djblue/portal https://github.com/djblue/portal
24 doric/doric https://github.com/joegallo/doric
25 douglass/clj-psql https://github.com/DarinDouglass/clj-psql
26 environ/environ https://github.com/weavejester/environ
27 exoscale/coax https://github.com/exoscale/coax
28 expound/expound https://github.com/bhb/expound
29 failjure/failjure https://github.com/adambard/failjure
30 ffclj/ffclj https://github.com/luissantos/ffclj
31 gaka/gaka https://github.com/cdaddr/gaka
32 hato/hato https://github.com/gnarroway/hato
33 henryw374/cljc.java-time https://github.com/henryw374/cljc.java-time
34 hiccup/hiccup http://github.com/weavejester/hiccup
35 honeysql/honeysql https://github.com/seancorfield/honeysql
36 http-kit/http-kit https://github.com/http-kit/http-kit
37 io.aviso/pretty https://github.com/AvisoNovate/pretty
38 io.github.cognitect-labs/test-runner https://github.com/cognitect-labs/test-runner
39 io.github.technomancy/limit-break https://github.com/technomancy/limit-break
40 io.helins/binf https://github.com/helins/binf.cljc
41 io.replikativ/hasch https://github.com/replikativ/hasch
42 java-http-clj/java-http-clj http://www.github.com/schmee/java-http-clj
43 lambdaisland/regal https://github.com/lambdaisland/regal
44 listora/again https://github.com/liwp/again
45 markdown-clj/markdown-clj https://github.com/yogthos/markdown-clj
46 medley/medley https://github.com/weavejester/medley
47 minimallist/minimallist https://github.com/green-coder/minimallist
48 mvxcvi/arrangement https://github.com/greglook/clj-arrangement
49 orchestra/orchestra https://github.com/jeaye/orchestra
50 org.babashka/spec.alpha https://github.com/babashka/spec.alpha
51 org.clj-commons/clj-http-lite https://github.com/clj-commons/clj-http-lite
52 org.clj-commons/digest https://github.com/clj-commons/clj-digest
53 org.clojars.askonomm/ruuter https://github.com/askonomm/ruuter
54 org.clojars.lispyclouds/contajners https://github.com/lispyclouds/contajners
55 org.clojure/core.match https://github.com/clojure/core.match
56 org.clojure/data.csv https://github.com/clojure/data.csv
57 org.clojure/data.generators https://github.com/clojure/data.generators
58 org.clojure/data.json https://github.com/clojure/data.json
59 org.clojure/data.zip https://github.com/clojure/data.zip
60 org.clojure/math.combinatorics https://github.com/clojure/math.combinatorics
61 org.clojure/test.check https://github.com/clojure/test.check
62 org.clojure/tools.gitlibs https://github.com/clojure/tools.gitlibs
63 org.clojure/tools.namespace https://github.com/babashka/tools.namespace
64 progrock/progrock https://github.com/weavejester/progrock
65 reifyhealth/specmonstah https://github.com/reifyhealth/specmonstah
66 rewrite-clj/rewrite-clj https://github.com/clj-commons/rewrite-clj
67 rm-hull/jasentaa https://github.com/rm-hull/jasentaa
68 selmer/selmer https://github.com/yogthos/Selmer
69 slingshot/slingshot https://github.com/scgilardi/slingshot
70 table/table https://github.com/cldwalker/table
71 testdoc/testdoc https://github.com/liquidz/testdoc
72 version-clj/version-clj https://github.com/xsc/version-clj

36
doc/projects.md
View file

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

162
script/add-libtest.clj
View file

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

4
test-resources/lib_tests/aero/core_test.cljc
View file

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

23
test-resources/lib_tests/aero/lumo_test.cljs Normal file
View file

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

15
test-resources/lib_tests/babashka/lambdaisland/regal_test.clj
View file

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

196
test-resources/lib_tests/babashka/run_all_libtests.clj
View file

@ -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 "<root>"
" <character type=\"person\" name=\"alice\" />"
" <character type=\"animal\" name=\"march hare\" />"
"</root>"))
;; 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]

84
test-resources/lib_tests/bb-tested-libs.edn
View file

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

121
test-resources/lib_tests/bond/assertions_test.clj Normal file
View file

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

109
test-resources/lib_tests/bond/james_test.clj Normal file
View file

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

35
test-resources/lib_tests/bond/target_data.clj Normal file
View file

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

20
test-resources/lib_tests/borkdude/deps/smoke_test.clj Normal file
View file

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

133
test-resources/lib_tests/borkdude/rewrite_edn_test.cljc Normal file
View file

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

6
test-resources/lib_tests/camel_snake_kebab/core_test.cljc
View file

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

16
test-resources/lib_tests/camel_snake_kebab/extras_test.cljc Normal file
View file

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

41
test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc Normal file
View file

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

10
test-resources/lib_tests/camel_snake_kebab/test_runner.cljs Normal file
View file

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

7
test-resources/lib_tests/clj_http/lite/client_test.clj
View file

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

10
test-resources/lib_tests/clj_http/lite/test_runner.clj Normal file
View file

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

110
test-resources/lib_tests/clj_yaml/core_test.clj
View file

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

2
test-resources/lib_tests/clojure/data/generators_test.clj
View file

@ -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)))))
(is (= sample-1 sample-2)))))

1
test-resources/lib_tests/clojure/data/json_test.clj
View file

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

17
test-resources/lib_tests/clojure/data/zip_test.clj Normal file
View file

@ -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 "<root>"
" <character type=\"person\" name=\"alice\" />"
" <character type=\"animal\" name=\"march hare\" />"
"</root>"))
(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))))))

29
test-resources/lib_tests/clojure/term/colors_test.clj Normal file
View file

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

14
test-resources/lib_tests/clojure/test_clojure/instr.clj
View file

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

9
test-resources/lib_tests/clojure/test_clojure/spec.clj
View file

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

315
test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj Normal file
View file

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

20
test-resources/lib_tests/clojure/tools/namespace/dir_test.clj Normal file
View file

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

29
test-resources/lib_tests/clojure/tools/namespace/find_test.clj Normal file
View file

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

52
test-resources/lib_tests/clojure/tools/namespace/move_test.clj Normal file
View file

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

210
test-resources/lib_tests/clojure/tools/namespace/parse_test.clj Normal file
View file

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

82
test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj Normal file
View file

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

10
test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj Normal file
View file

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

14
test-resources/lib_tests/cognitect/test_runner/samples_test.clj Normal file
View file

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

23
test-resources/lib_tests/cognitect/test_runner_test.clj Normal file
View file

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

307
test-resources/lib_tests/com/stuartsierra/component_test.clj Normal file
View file

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

41
test-resources/lib_tests/component/component_test.clj
View file

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

22
test-resources/lib_tests/contajners/core_test.clj Normal file
View file

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

45
test-resources/lib_tests/contajners/impl_test.clj Normal file
View file

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

7
test-resources/lib_tests/cprop/smoke_test.clj Normal file
View file

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

88
test-resources/lib_tests/docopt/core_test.clj Normal file
View file

@ -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 (= {"<foo>" "a"}
(d/docopt "usage: prog <foo>" ["a"]))))
(testing "3-arity version"
(is (= "a"
(d/docopt "usage: prog <foo>" ["a"] #(get % "<foo>")))))
(testing "4-arity version"
(is (= "usage: prog <foo>"
(d/docopt "usage: prog <foo>" [] 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 <foo>" ["-f" "a b"])))
(is (= {"--foo" "a\nb"}
(d/docopt "usage: prog [options]\noptions: --foo <foo>" ["--foo" "a\nb"])))
(is (= {"<foo>" "a b c "}
(d/docopt "usage: prog <foo>" ["a b c "])))
(is (= {"<foo>" "a\tb\nc"}
(d/docopt "usage: prog <foo>" ["a\tb\nc"])))
(binding [docopt.match/*sep-table* {\ "FOO"
\newline "BAR"
\tab "QUX"
\backspace "QUZ"}]
(is (= {"<foo>" "a b\nc\td\b"}
(d/docopt "usage: prog <foo>" ["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")))

57
test-resources/lib_tests/docopt/extra_testcases.docopt Normal file
View file

@ -0,0 +1,57 @@
# Should output the same things as docopt/docopt for language agnostic tests
# Testing `--`
r"""Usage: prog foo -- <extra-opts>...
"""
$ prog foo
"user-error"
$ prog foo -- --bar
{"--":true, "<extra-opts>": ["--bar"], "foo":true}
r"""Usage: prog foo [--] <extra-opts>...
"""
$ prog foo
"user-error"
# Wrong, should be
# {"foo": true, "--": false, "<extra-opts>": []}
$ prog foo -- --bar
{"foo": true, "--": true, "<extra-opts>": ["--bar"]}
r"""Complex command
Usage:
prog [options] <param-x> <param-y> -- <extra>...
prog [options] <param-a> <param-b> <param-c> <param-d> -- <extra>...
prog [options] <param-x> <param-y>
prog [options] <param-a> <param-b> <param-c> <param-d>
Options:
-f --foo Foo
--bar <bar> Bar
"""
$ prog x y --foo
{"--":false,"--bar":null,"--foo":true,"<extra>":[],"<param-a>":null,"<param-b>":null,"<param-c>":null,"<param-d>":null,"<param-x>":"x","<param-y>":"y"}
$ prog a b c d
{"--":false,"--bar":null,"--foo":false,"<extra>":[],"<param-a>":"a","<param-b>":"b","<param-c>":"c","<param-d>":"d","<param-x>":null,"<param-y>":null}
$ prog a b c d --foo --bar bar
{"--":false,"--bar":"bar","--foo":true,"<extra>":[],"<param-a>":"a","<param-b>":"b","<param-c>":"c","<param-d>":"d","<param-x>":null,"<param-y>":null}
$ prog x y --bar bar -- extra
{"--bar": "bar", "--foo": false, "<param-x>": "x", "<param-y>": "y", "--": true, "<extra>": ["extra"], "<param-a>": null, "<param-b>": null, "<param-c>": null, "<param-d>": null}
$ prog a b c d --foo --bar bar -- extra
{"--foo": true, "--bar": "bar", "<param-x>": null, "<param-y>": null, "--": true, "<extra>": ["extra"], "<param-a>": "a", "<param-b>": "b", "<param-c>": "c", "<param-d>": "d"}
$ prog x y -- e1 e2 e3 e4
{"--bar": null, "--foo": false, "<param-x>": "x", "<param-y>": "y", "--": true, "<extra>": ["e1", "e2", "e3", "e4"], "<param-a>": null, "<param-b>": null, "<param-c>": null, "<param-d>": null}

4
test-resources/lib_tests/doric/test/core.clj
View file

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

93
test-resources/lib_tests/doric/test/doctest.clj Normal file
View file

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

6
test-resources/lib_tests/doric/test/readme.clj Normal file
View file

@ -0,0 +1,6 @@
(ns doric.test.readme
(:use [clojure.test]
[doric.test.doctest]))
(deftest readme
(run-doctests markdown-tests "README.md"))

4350
test-resources/lib_tests/expound/alpha_test.cljc Normal file
View file

File diff suppressed because it is too large Load diff

39
test-resources/lib_tests/expound/paths_test.cljc Normal file
View file

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

23
test-resources/lib_tests/expound/print_length_test.cljc Normal file
View file

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

428
test-resources/lib_tests/expound/printer_test.cljc Normal file
View file

@ -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 (= "<anonymous function>"
(printer/pprint-fn #(inc (inc %)))))
(is (= "<anonymous function>"
(printer/pprint-fn (constantly true))))
(is (= "<anonymous function>"
(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}))))))))

30
test-resources/lib_tests/expound/problems_test.cljc Normal file
View file

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

97
test-resources/lib_tests/expound/spec_gen.cljc Normal file
View file

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

26
test-resources/lib_tests/expound/specs_test.cljc Normal file
View file

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

115
test-resources/lib_tests/expound/spell_spec_test.cljc Normal file
View file

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

28
test-resources/lib_tests/expound/test_runner.cljs Normal file
View file

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

41
test-resources/lib_tests/expound/test_utils.cljc Normal file
View file

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

5
test-resources/lib_tests/failjure/runner.cljs Normal file
View file

@ -0,0 +1,5 @@
(ns failjure.runner
(:require [doo.runner :refer-macros [doo-tests]]
[failjure.test-core]))
(doo-tests 'failjure.test-core)

6
test-resources/lib_tests/gaka/core_test.clj
View file

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

3
test-resources/lib_tests/honey/sql/helpers_test.cljc
View file

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

11
test-resources/lib_tests/honey/sql/postgres_test.cljc
View file

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

100
test-resources/lib_tests/honey/sql_test.cljc
View file

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

141
test-resources/lib_tests/honeysql/core_test.cljc
View file

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

14
test-resources/lib_tests/honeysql/format_test.cljc
View file

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

52
test-resources/lib_tests/io/aviso/binary_test.clj Normal file
View file

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

583
test-resources/lib_tests/io/aviso/exception_test.clj Normal file
View file

@ -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 "<init>"
:name ""
:formatted-name "com.datastax.driver.core.Connection.<init>"
:file "Connection.java"
:line 104
:class "com.datastax.driver.core.Connection"
:names []}
{:simple-class "PooledConnection"
:package "com.datastax.driver.core"
:is-clojure? false
:method "<init>"
:name ""
:formatted-name "com.datastax.driver.core.PooledConnection.<init>"
: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 "<init>"
:name ""
:formatted-name "com.datastax.driver.core.DynamicConnectionPool.<init>"
: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.<init>(Connection.java:104) ~store-service.jar:na"
"\tat com.datastax.driver.core.PooledConnection.<init>(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.<init>(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: #<SystemMap>" sys-exception)))
(reporting {comp-exception (str/split-lines comp-exception)}
(is (re-find #"component: #<Component io.aviso.exception_test.MyComponent>" 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}))))))

19
test-resources/lib_tests/lambdaisland/regal/malli_test.cljc Normal file
View file

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

29
test-resources/lib_tests/lambdaisland/regal/parse_test.cljc Normal file
View file

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

45
test-resources/lib_tests/lambdaisland/regal/re2_test.clj Normal file
View file

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

39
test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj Normal file
View file

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

146
test-resources/lib_tests/lambdaisland/regal/test_util.cljc Normal file
View file

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

174
test-resources/lib_tests/lambdaisland/regal_test.cljc Normal file
View file

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

450
test-resources/lib_tests/markdown/md_test.cljc Normal file
View file

@ -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 (= "<h1>Ticket #123</h1>" (entry-function "# Ticket #123")))
(is (= "<h1>Foo</h1>" (entry-function " # Foo")))
(is (= "<h1>foo</h1>" (entry-function "#foo")))
(is (= "<h1>foo</h1>" (entry-function "foo\n===")))
(is (= "<h1>foo</h1>" (entry-function "#foo#")))
(is (= "<h1>foo</h1>" (entry-function "#foo#\n")))
(is (= "<h1>some header <code>with&#95;an&#95;underscore</code></h1>"
(entry-function "# some header `with_an_underscore`")))
(is (= "<ul><li>one</li></ul><h1>heading1</h1>"
(entry-function "* one\n\nheading1\n========\n"))))
(deftest heading2
(is (= "<h2>foo</h2>" (entry-function "##foo")))
(is (= "<h2>foo</h2>" (entry-function "foo\n---")))
(is (= "<h2>foo</h2>" (entry-function "##foo##")))
(is (= "<h2>foo</h2>" (entry-function "##foo##\n"))))
(deftest heading-with-complex-anchor
(is (=
"<h3 id=\"foo&#95;bar&#95;baz\">foo bar BAz</h3><p>some text</p>"
(entry-function "###foo bar BAz\nsome text" :heading-anchors true)))
(is (=
"<h3 id=\"foo&#95;bar&#95;baz\">foo bar BAz</h3><p>some text</p>"
(entry-function "###foo bar BAz##\nsome text" :heading-anchors true))))
(deftest br
(is (= "<p>foo<br /></p>" (entry-function "foo "))))
(deftest hr
(is (= "<hr/>" (entry-function "***")))
(is (= "<hr/>" (entry-function " * * * ")))
(is (= "<hr/>" (entry-function " *****")))
(is (= "<hr/>" (entry-function "- - - "))))
(deftest em
(is (= "<p><em>foo</em></p>" (entry-function "*foo*"))))
(deftest italics
(is (= "<p><i>foo</i></p>" (entry-function "_foo_"))))
(deftest strong
(is (= "<p><strong>foo</strong></p>" (entry-function "**foo**"))))
(deftest bold-italics
(is (= "<p><b><i>foo</i></b></p>" (entry-function "***foo***"))))
(deftest bold
(is (= "<p><b>foo</b></p>" (entry-function "__foo__"))))
(deftest strong-inside-em
(is (= "<p><em>foo<strong>bar</strong>baz</em></p>" (entry-function "*foo**bar**baz*"))))
(deftest bold-inside-a-list
(is (= "<ol><li>chickens.</li></ol><p> <strong>See more: <a href='http://cluck.cluck.com'>Cluck Cluck</a></strong> </p>"
(entry-function "1. chickens. \n\n **See more: [Cluck Cluck](http://cluck.cluck.com)** \n\n"))))
(deftest em-inside-strong
(is (= "<p><strong>foo<em>bar</em>baz</strong></p>" (entry-function "**foo*bar*baz**"))))
(deftest paragraph
(is (= "<p>Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore</p>"
(entry-function "\nLorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore"))))
(deftest paragraph-multiline
(is (= "<p>Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore</p>"
(entry-function "\nLorem ipsum dolor\nsit amet, consectetur adipisicing elit,\nsed do eiusmod tempor incididunt ut labore"))))
(deftest paragraph-before-codeblock
(is (= "<p>foo</p><pre><code>bar\n</code></pre><p>baz</p>"
(entry-function "foo\n```\nbar\n```\nbaz")))
(is (= "<pre><code>foo \nbar</code></pre>" (entry-function "```\nfoo \nbar```")))
(is (= "<p><pre><code></code></pre></p>" (entry-function "```\n```")))
(is (= "<p><pre><code class=\"go\"></code></pre></p>" (entry-function "```go\n```")))
(is (= "<pre><code>&lt;html&gt;\n&lt;/html&gt;\n</code></pre>" (entry-function "```\n<html>\n</html>\n``` "))))
(deftest paragraph-after-codeblock
(is (= "<pre><code>foo\n</code></pre><p>bar baz</p>"
(entry-function "```\nfoo\n```\nbar\nbaz"))))
(deftest mulitple-paragraphs
(is (= "<p>foo bar baz</p><p>foo bar baz</p>"
(entry-function "\nfoo bar baz\n\n\nfoo bar baz"))))
(deftest ul
(is (= "<ul><li>foo</li><li>bar</li><li>baz</li></ul>"
(entry-function "* foo\n* bar\n* baz")))
(is (= "<ul><li>foo</li><li>bar</li><li>baz</li></ul>"
(entry-function "- foo\n- bar\n- baz")))
(is (= "<ul><li>foo</li><li>bar</li><li>baz</li></ul>"
(entry-function "+ foo\n+ bar\n+ baz"))))
(deftest list-in-a-codeblock
(is
(= "<pre><code class=\"yaml\">list:\n- 1\n- 2\n</code></pre>"
(entry-function "```yaml\nlist:\n- 1\n- 2\n```"))))
(deftest ul-followed-by-paragraph
(is (= "<ul><li>foo</li><li>bar</li><li>baz</li></ul><p>paragraph next line</p>"
(entry-function "* foo\n* bar\n* baz\n\nparagraph\nnext line"))))
(deftest ul-with-codeblock
(is (= "<ul><li>foo</li><li>bar<pre><code> &#40;defn foo &#91;&#93;\n bar&#41;\n </code></pre></li><li>baz</li><li>more text</li></ul>"
(entry-function
"\n* foo\n* bar\n ```\n (defn foo []\n bar)\n ```\n* baz\n* more text\n")))
(is (= "<ul><li>foo</li><li>bar<pre><code> &#40;defn foo &#91;&#93;\n bar&#41;\n </code></pre> text</li><li>baz</li><li>more text</li></ul>"
(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 (= "<ul><li>foo</li><li>bar</li><li>baz</li></ul><p>paragraph</p>"
(entry-function "* foo\n* bar\n* baz\n\nparagraph"))))
(deftest ul-nested
(is (= "<ul><li>first item<ul><li>first sub-item<ul><li>second sub-item</li></ul></li><li>third sub-item</li></ul></li><li>second item<ul><li>first sub-item</li><li>second sub-item</li></ul></li><li>third item</li></ul>"
(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 (= "<ul><li>first item<ul><li>first sub-item<ul><li>second sub-item</li></ul></li><li>third sub-item</li></ul></li><li>second item<ul><li>first sub-item</li><li>second sub-item</li></ul></li><li>third item</li></ul>"
(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 (= "<ul><li>abc</li><li>def</li></ul>" (entry-function " * abc\n\n+ def"))))
(deftest ol
(is (= "<ol><li>Foo</li><li>Bar</li><li>Baz</li></ol>"
(entry-function "1. Foo\n2. Bar\n3. Baz"))))
(deftest ul-in-ol
(is (= "<ol><li>Bar<ol><li>Subbar<ul><li>foo</li><li>bar</li><li>baz</li></ul></li></ol></li><li>Baz</li></ol>"
(entry-function "1. Bar\n 2. Subbar\n * foo\n * bar\n * baz\n3. Baz"))))
(deftest ol-in-ul
(is (= "<ul><li>Foo<ol><li>Bar<ol><li>Subbar</li></ol></li></ol></li><li>Baz</li></ul>"
(entry-function "* Foo\n 1. Bar\n 1. Subbar\n* Baz")))
(is (= "<ul><li>Foo<ol><li>Bar</li></ol></li></ul>"
(entry-function "* Foo\n 1. Bar"))))
(deftest multilist
(is (=
"<ul><li>foo</li><li>bar<ul><li>baz<ol><li>foo</li><li>bar</li></ol></li><li>fuzz<ul><li>blah</li><li>blue</li></ul></li></ul></li><li>brass</li></ul>"
(entry-function
"* foo
* bar
* baz
1. foo
2. bar
* fuzz
* blah
* blue
* brass"))))
(deftest code
(is (= "<p>foo bar baz <code>x = y + z;</code> foo</p>"
(entry-function "foo bar baz `x = y + z;` foo")))
(is (= "<p>bar <code>foo --- -- bar</code> foo</p>"
(entry-function "bar `foo --- -- bar` foo")))
(is (= "<p><code>&lt;?xml version='1.0' encoding='UTF-8'?&gt;&lt;channel&gt;&lt;/channel&gt;</code></p>"
(entry-function "`<?xml version='1.0' encoding='UTF-8'?><channel></channel>`")))
(is (= "<p>foo bar baz <code>&#40;fn &#91;x &amp; xs&#93; &#40;str &quot;x:&quot; x&#41;&#41;</code> foo</p>"
(entry-function "foo bar baz `(fn [x & xs] (str \"x:\" x))` foo")))
(is (= "<pre><code>```\nfoo\n```</code></pre>"
(entry-function " ```\n foo\n ```"))))
(deftest multiline-code
(is (= "<pre><code>x = 5\ny = 6\nz = x + y</code></pre>"
(entry-function " x = 5\n y = 6\n z = x + y")))
(is (= "<pre><code>x = 5\ny = 6\nz = x + y\n&#40;fn &#91;x &amp; xs&#93; &#40;str &quot;x&quot;&#41;&#41;</code></pre>"
(entry-function " x = 5\n y = 6\n z = x + y\n (fn [x & xs] (str \"x\"))"))))
(deftest codeblock
(is (= "<pre><code>&#40;defn- write&#94; &#91;writer text&#93;\n &#40;doseq &#91;c text&#93;\n &#40;.write writer &#40;int c&#41;&#41;&#41;&#41;\n</code></pre>"
(entry-function "```\n(defn- write^ [writer text]\n (doseq [c text]\n (.write writer (int c))))\n```")))
(is (= "<pre><code>&#40;fn &#91;x &amp; xs&#93;\n &#40;str &quot;x&quot;&#41;&#41;\n</code></pre>"
(entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```")))
(is (= "<pre><code>&#40;fn &#91;x &amp; xs&#93;\n &#40;str &quot;x&quot;&#41;&#41;\n</code></pre>"
(entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```")))
(is (= "<pre><code class=\"clojure\">&#40;fn &#91;x &amp; xs&#93;\n &#40;str &quot;x&quot;&#41;&#41;\n</code></pre>"
(entry-function "```clojure\n(fn [x & xs]\n (str \"x\"))\n```")))
(is (= "<pre><code class=\"nohighlight\">------------\n============\n ------------\n ============\n</code></pre>"
(entry-function
"
```nohighlight
------------
============
------------
============
```
"))))
(deftest indented-codeblock
(is (= "<pre><code>foo</code></pre>"
(entry-function " foo")))
(is (= "<pre><code>foo</code></pre><p>bar</p>"
(entry-function " foo\n\nbar")))
(is (= "<pre><code>foo</code></pre>bar"
(entry-function " foo\nbar")))
(is (= "<p>baz foo</p><p>bar</p>"
(entry-function "baz\n foo\n\nbar")))
(is (= "<p><div class=\"grid-container\"> <div class=\"child1\"> <p>Element #1</p> </div> </div></p>"
(entry-function "<div class=\"grid-container\">\n <div class=\"child1\">\n <p>Element #1</p>\n </div>\n</div>"))))
(deftest strikethrough
(is (= "<p><del>foo</del></p>"
(entry-function "~~foo~~"))))
(deftest superscript
(is (= "<p>foo<sup>bar</sup> baz</p>"
(entry-function "foo^bar baz"))))
(deftest link
(is (= "<p><a href='http://underscores_are_fine.com'>underscores<i>are</i>fine</a></p>"
(entry-function "<a href='http://underscores_are_fine.com'>underscores_are_fine</a>")))
(is (= "<p><a href='http://github.com'>github</a></p>"
(entry-function "[github](http://github.com)")))
(is (= "<p><a href='http://github.com/~'>github</a></p>"
(entry-function "[github](http://github.com/~)")))
(is (= "<p><a href='http://github.com/^'>github</a></p>"
(entry-function "[github](http://github.com/^)")))
(is (= "<p><a href='http://github.com/*'>github</a></p>"
(entry-function "[github](http://github.com/*)")))
(is (= "<ul><li><a href='http://github.com/*'>github</a></li></ul>"
(entry-function "* [github](http://github.com/*)")))
(is (= "<ul><li>hi</li></ul><p><a href='https://see-here'>a link</a></p>"
(entry-function "* hi\n\n[a link](https://see-here)")))
(is (= "<p><a href='https://clojure.github.io/core.async/#clojure.core.async/>!'>>!</a></p>"
(entry-function "[>!](https://clojure.github.io/core.async/#clojure.core.async/>!)")))
(is (= "<p><a href='https://clojure.github.io/core.async/#clojure.core.async/<!'><!</a></p>"
(entry-function "[<!](https://clojure.github.io/core.async/#clojure.core.async/<!)"))))
(deftest styled-link
(is (= "<p><a href='http://github.com'><em>github</em></a></p>"
(entry-function "[*github*](http://github.com)")))
(is (= "<p><a href='http://github.com'><i>github</i></a></p>"
(entry-function "[_github_](http://github.com)")))
(is (= "<p><a href='http://github.com'><b>github</b></a></p>"
(entry-function "[__github__](http://github.com)")))
(is (= "<p><a href='http://github.com'><strong>github</strong></a></p>"
(entry-function "[**github**](http://github.com)")))
(is (= "<p><a href='http://github.com'><del>github</del></a></p>"
(entry-function "[~~github~~](http://github.com)"))))
(deftest img
(is (= "<p><img src=\"/path/to/img.jpg\" alt=\"Alt text\" /></p>"
(entry-function "![Alt text](/path/to/img.jpg)")))
(is (= "<p><img src=\"/path/to/_img_.jpg\" alt=\"Alt text\" title=\"Optional Title\" /></p>"
(entry-function "![Alt text](/path/to/_img_.jpg \"Optional Title\")"))))
(deftest img-link
(is (= "<p><a href='http://travis-ci.org/yogthos/markdown-clj'><img src=\"https://secure.travis-ci.org/yogthos/markdown-clj.png\" alt=\"Continuous Integration status\" /></a></p>"
(entry-function "[![Continuous Integration status](https://secure.travis-ci.org/yogthos/markdown-clj.png)](http://travis-ci.org/yogthos/markdown-clj)")))
(is (= "<p><img src=\"https://secure.travis-ci.org/yogthos/markdown-clj.png\" alt=\"\" /></p>"
(entry-function "![](https://secure.travis-ci.org/yogthos/markdown-clj.png)"))))
(deftest bad-link
(is (= "<p>[github](http://github.comfooo</p>"
(entry-function "[github](http://github.comfooo")))
(is (= "<p>[github] no way (http://github.com)</p>"
(entry-function "[github] no way (http://github.com)"))))
(deftest bad-link-title
(is (= "<p>[github(http://github.comfooo)</p>"
(entry-function "[github(http://github.comfooo)"))))
(deftest blockquote
(is (= "<blockquote><p>Foo bar baz </p></blockquote>"
(entry-function ">Foo bar baz"))))
(deftest blockquote-footer
(is (= "<blockquote><p> Foo bar baz </p><footer> Leo Tolstoy</footer></blockquote>"
(entry-function "> Foo bar baz\n>- Leo Tolstoy"))))
(deftest blockquote-empty-footer
(is (= "<blockquote><p> Foo bar baz </p><footer></footer></blockquote>"
(entry-function "> Foo bar baz\n>-"))))
(deftest blockquote-multiline-without-leading-angle-bracket
(is (= "<blockquote><p> Foo bar baz </p></blockquote>"
(entry-function "> Foo bar\nbaz"))))
(deftest blockquote-multiple-paragraphs
(is (= "<blockquote><p> Foo bar </p><p> baz </p></blockquote>"
(entry-function "> Foo bar\n>\n> baz"))))
(deftest blockquote-bullets
(is (= "<blockquote><p> list: <ul><li>foo</li><li>bar</li></ul></p></blockquote><p>end.</p>"
(entry-function "> list:\n>* foo\n>* bar\n\nend.")))
(is (= "<blockquote><p><ul><li>foo</li><li>bar</li><li>baz</li></ul></p></blockquote>"
(entry-function ">* foo\n>* bar\n>* baz"))))
(deftest blockquote-headings
(is (= "<blockquote><p><h2>Foo</h2>bar baz </p></blockquote>"
(entry-function "> ## Foo\n>bar baz")))
(is (= "<blockquote><p> Foo <h2>bar</h2> baz </p></blockquote>"
(entry-function "> Foo\n>## bar\n> baz"))))
(deftest escaped-characters
(is
(= "<p>&#94;&#42;&#8216;&#95;&#123;&#125;&#91;&#93;<em>foo</em><code>test</code><i>bar</i>{x}[y]</p>"
(entry-function "\\^\\*\\`\\_\\{\\}\\[\\]*foo*`test`_bar_{x}[y]"))))
(deftest paragraph-after-list
(is (= "<ol><li>a</li><li>b</li></ol><p>test <strong>bold</strong> and <em>italic</em></p>"
(entry-function "1. a\n2. b\n\ntest **bold** and *italic*"))))
(deftest paragraph-close-before-list
(is (= "<p>in paragraph</p><ul><li>list</li></ul>"
(entry-function "in paragraph\n- list"))))
(deftest autourl
(is (= "<p><a href=\"http://example.com/\">http://example.com/</a></p>"
(entry-function "<http://example.com/>")))
(is (= "<p>Some content with a <a href=\"http://www.google.com/abc__123__efg\">http://www.google.com/abc__123__efg</a> link it in</p>"
(entry-function "Some content with a <http://www.google.com/abc__123__efg> link it in")))
(is (= "<p><a href=\"http://foo\">http://foo</a> <a href=\"https://bar/baz\">https://bar/baz</a> <a href=\"http://foo/bar\">foo bar</a></p>"
(entry-function "<http://foo> <https://bar/baz> <a href=\"http://foo/bar\">foo bar</a>")))
#?(:bb nil :org.babashka/nbb nil
:default
(is (= "<p><a href=\"mailto:abc@google.com\">abc@google.com</a></p>"
(#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml
:cljs goog.string/unescapeEntities)
(entry-function "<abc@google.com>")))))
#?(:bb nil :org.babashka/nbb nil
:default
(is (= "<p><a href=\"mailto:abc_def_ghi@google.com\">abc_def_ghi@google.com</a></p>"
(#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml
:cljs goog.string/unescapeEntities)
(entry-function "<abc_def_ghi@google.com>"))))))
(deftest not-a-list
(is (= "<p>The fish was 192.8 lbs and was amazing to see.</p>"
(entry-function "The fish was\n192.8 lbs and was amazing to see."))))
(deftest dont-encode-chars-in-hrefs
(is (= "<p><a href='http://www.google.com/example_link_foo~_^*'>example_link with tilde ~ and carat ^ and splat *</a></p>"
(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 (= "<h2>With a link <a href='http://a.com/under_score_in_the_link/'>the contents of the_link</a></h2>"
(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 (= "<h2>When you have a pair of links <a href='http://123.com/1'>link1</a> and you want both <a href='That%27s%20crazy'>Wow</a></h2>"
(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 (= "<p>You can have a <a href='github.com'>link</a> followed by an image <img src=\"img.png\" alt=\"\" /></p>"
(entry-function "You can have a [link](github.com) followed by an image ![](img.png)"))))
(deftest image-then-link-processing
(is (= "<p>You can have an image <img src=\"img.png\" alt=\"\" /> followed by a <a href='github.com'>link</a></p>"
(entry-function "You can have an image ![](img.png) followed by a [link](github.com)"))))
(deftest link-with-optional-title
(is (= "<p><a href='https://github.com/cryogen-project/cryogen' title=\"Cryogen Github\">Cryogens site</a></p>"
(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)
"<th>contents 1</th><th>contents 2</th><th>contents 3</th><th>contents 4</th>"))
(is (= (tables/table-row->str
[{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}]
false)
"<td>contents 1</td><td>contents 2</td><td>contents 3</td><td>contents 4</td>"))
(is (= (tables/table-row->str
[{:text "contents 1" :alignment :left}
{:text "contents 2" :alignment :center}
{:text "contents 3" :alignment :right}
{:text "contents 4"}]
false)
"<td style='text-align:left'>contents 1</td><td style='text-align:center'>contents 2</td><td style='text-align:right'>contents 3</td><td>contents 4</td>")))
(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"}]]})
"<table><thead><tr><th style='text-align:left'>Header 1</th><th style='text-align:center'>Header 2</th><th style='text-align:right'>Header 3</th><th>Header 4</th></tr></thead><tbody><tr><td style='text-align:left'>contents 1</td><td style='text-align:center'>contents 2</td><td style='text-align:right'>contents 3</td><td>contents 4</td></tr></tbody></table>")))
(deftest divider-seq->alignment
(is (= (tables/divider-seq->alignment
[{:text "-----"} {:text ":-----"} {:text "-----:"} {:text ":-----:"}])
[nil {:alignment :left} {:alignment :right} {:alignment :center}])))
(deftest n-dash
(is (= "<p>boo &ndash; bar</p>" (entry-function "boo -- bar"))))
(deftest m-dash
(is (= "<p>boo &mdash; bar</p>" (entry-function "boo --- bar"))))
(deftest inhibit-simple
(is (= "<p>_abc_</p>" (entry-function "$_abc_$" :inhibit-separator "$"))))
(deftest inhibit-simple-seq
(is (= "<p>_abc_</p>" (entry-function "$_abc_$" :inhibit-separator [\$]))))
(deftest inhibit-inline-code
(is (= "<p>`abc`</p>" (entry-function "$`abc`$" :inhibit-separator [\$]))))
(deftest inhibit-inside-code
(is (= "<p><code>a*b* & dc</code></p>" (entry-function "`a$*b* & d$c`" :inhibit-separator "$"))))
(deftest inhibit-across-backticks
(is (= "<p><code>one` `two</code></p>" (entry-function "`one$` `$two`" :inhibit-separator "$"))))
(deftest inhibit-escape
(is (= "<p>$</p>" (entry-function "$$" :inhibit-separator [\$]))))
(deftest inhibit-escape-twice
(is (= "<p>$$</p>" (entry-function "$$$$" :inhibit-separator "$"))))
(deftest img-reprocess
(is (= "<p><img src=\"img.jpg\" alt=\"Text\" /> and <a href='#'>Edit</a></p>"
(entry-function "![Text](img.jpg) and [Edit](#)"))))
(deftest dont-inhibit-text-within-escapes
(is (= "<p>$<em>abc</em>$</p>" (entry-function "$$*abc*$$" :inhibit-separator "$"))))
(deftest inhibit-escape-inside-code
(is (= "<p><code>$</code></p>" (entry-function "`$$`" :inhibit-separator "$"))))
(deftest whitespace-paragraphs
(is (= "<p>foo </p><p>bar</p>" (entry-function "foo\n \nbar"))))

10
test-resources/lib_tests/markdown/nbb_runner.cljs Normal file
View file

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

5
test-resources/lib_tests/markdown/runner.cljs Normal file
View file

@ -0,0 +1,5 @@
(ns markdown.runner
(:require [doo.runner :refer-macros [doo-tests]]
[markdown.md-test]))
(doo-tests 'markdown.md-test)

409
test-resources/lib_tests/medley/core_test.cljc Normal file
View file

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

5
test-resources/lib_tests/medley/test_runner.cljs Normal file
View file

@ -0,0 +1,5 @@
(ns medley.test-runner
(:require [doo.runner :refer-macros [doo-tests]]
[medley.core-test]))
(doo-tests 'medley.core-test)

145
test-resources/lib_tests/minimallist/core_test.cljc
View file

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

546
test-resources/lib_tests/minimallist/generator_test.cljc Normal file
View file

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

53
test-resources/lib_tests/minimallist/util_test.cljc Normal file
View file

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

12
test-resources/lib_tests/missing/test/assertions_test.cljc Normal file
View file

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

13
test-resources/lib_tests/missing/test/old_methods.cljc Normal file
View file

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

18
test-resources/lib_tests/portal/bench.cljc Normal file
View file

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

32
test-resources/lib_tests/portal/e2e.clj Normal file
View file

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

23
test-resources/lib_tests/portal/jvm_test.clj Normal file
View file

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

172
test-resources/lib_tests/portal/runtime/cson_test.cljc Normal file
View file

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

21
test-resources/lib_tests/portal/runtime/fs_test.cljc Normal file
View file

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

11
test-resources/lib_tests/portal/test_planck.cljs Normal file
View file

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

14
test-resources/lib_tests/portal/test_runner.clj Normal file
View file

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

14
test-resources/lib_tests/portal/test_runner.cljs Normal file
View file

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

43
test-resources/lib_tests/progrock/core_test.clj Normal file
View file

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

9
test-resources/lib_tests/slingshot/slingshot_test.clj
View file

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

4
test-resources/lib_tests/slingshot/support_test.clj
View file

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

2
test-resources/lib_tests/table/core_test.clj
View file

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

133
test-resources/lib_tests/testdoc/core_test.clj Normal file
View file

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

26
test-resources/lib_tests/testdoc/style/code_first_test.clj Normal file
View file

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

25
test-resources/lib_tests/testdoc/style/repl_test.clj Normal file
View file

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

9
test-resources/lib_tests/version_clj/compare_test.cljc
View file

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

4
test-resources/lib_tests/version_clj/split_test.cljc
View file

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

1
test-resources/lib_tests/version_clj/via_use_test.clj
View file

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