[eval-opt] Similar to uberscript but creates jar file.
+ prepare Download deps & pods defined in bb.edn and cache their metadata. Only an optimization, this will happen on demand when needed.
In- and output flags (only to be used with -e one-liners):
@@ -244,6 +259,7 @@ Use bb run --help to show this help output.
:feature/yaml %s
:feature/jdbc %s
:feature/postgresql %s
+ :feature/sqlite %s
:feature/hsqldb %s
:feature/oracledb %s
:feature/httpkit-client %s
@@ -262,8 +278,8 @@ Use bb run --help to show this help output.
features/xml?
features/yaml?
features/jdbc?
- features/sqlite?
features/postgresql?
+ features/sqlite?
features/hsqldb?
features/oracledb?
features/httpkit-client?
@@ -289,27 +305,24 @@ Use bb run --help to show this help output.
s (slurp f)]
(sci/with-bindings {sci/ns @sci/ns
sci/file (.getAbsolutePath f)}
- (sci/eval-string* @common/ctx s))))
+ (sci/eval-string* (common/ctx) s))))
(defn start-socket-repl! [address ctx]
(socket-repl/start-repl! address ctx))
-(defn start-nrepl! [address ctx]
- (let [dev? (= "true" (System/getenv "BABASHKA_DEV"))
- nrepl-opts (nrepl-server/parse-opt address)
- nrepl-opts (assoc nrepl-opts
- :debug dev?
- :describe {"versions" {"babashka" version}}
- :thread-bind [core/warn-on-reflection])]
- (nrepl-server/start-server! ctx nrepl-opts)
- (binding [*out* *err*]
- (println "For more info visit: https://book.babashka.org/#_nrepl")))
+(defn start-nrepl! [address]
+ (let [opts (nrepl-server/parse-opt address)]
+ (babashka.impl.nrepl-server/start-server! opts))
+ (binding [*out* *err*]
+ (println "For more info visit: https://book.babashka.org/#_nrepl"))
;; hang until SIGINT
@(promise))
(def aliases
(cond->
- '{tools.cli clojure.tools.cli
+ '{str clojure.string
+ set clojure.set
+ tools.cli clojure.tools.cli
edn clojure.edn
wait babashka.wait
signal babashka.signal
@@ -335,6 +348,11 @@ Use bb run --help to show this help output.
(require 'babashka.impl.instaparse)
+(defn catvec [& xs]
+ (into [] cat xs))
+
+(def sci-ns (sci/create-ns 'sci.core))
+
(def namespaces
(cond->
{'user {'*input* (reify
@@ -344,6 +362,7 @@ Use bb run --help to show this help output.
'clojure.tools.cli tools-cli-namespace
'clojure.java.shell shell-namespace
'babashka.core bbcore/core-namespace
+ 'babashka.nrepl.server nrepl-server-namespace
'babashka.wait wait-namespace
'babashka.signal signal-ns
'clojure.java.io io-namespace
@@ -358,10 +377,12 @@ Use bb run --help to show this help output.
'repl (sci/new-var 'repl
(fn [& opts]
(let [opts (apply hash-map opts)]
- (repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})}
+ (repl/start-repl! (common/ctx) opts))) {:ns clojure-main-ns})
+ 'with-bindings (sci/copy-var clojure-main/with-bindings clojure-main-ns)}
'clojure.test t/clojure-test-namespace
'clojure.math math-namespace
'babashka.classpath classpath-namespace
+ 'babashka.classes classes-namespace
'clojure.pprint pprint-namespace
'babashka.curl curl-namespace
'babashka.fs fs-namespace
@@ -376,13 +397,28 @@ Use bb run --help to show this help output.
'babashka.tasks tasks-namespace
'clojure.tools.reader.edn edn-namespace
'clojure.tools.reader.reader-types reader-types-namespace
+ 'clojure.tools.reader reader-namespace
'clojure.core.async async-namespace
'clojure.core.async.impl.protocols async-protocols-namespace
'rewrite-clj.node rewrite/node-namespace
'rewrite-clj.paredit rewrite/paredit-namespace
'rewrite-clj.parser rewrite/parser-namespace
'rewrite-clj.zip rewrite/zip-namespace
- 'rewrite-clj.zip.subedit rewrite/subedit-namespace}
+ 'rewrite-clj.zip.subedit rewrite/subedit-namespace
+ 'clojure.core.rrb-vector (if features/rrb-vector?
+ @(resolve 'babashka.impl.rrb-vector/rrb-vector-namespace)
+ {'catvec (sci/copy-var catvec
+ (sci/create-ns 'clojure.core.rrb-vector))})
+ 'edamame.core edamame-namespace
+ 'sci.core {'format-stacktrace (sci/copy-var sci/format-stacktrace sci-ns)
+ 'stacktrace (sci/copy-var sci/stacktrace sci-ns)
+ ;; 'eval-string (sci/copy-var sci/eval-string sci-ns)
+ ;; 'eval-string* (sci/copy-var sci/eval-string* sci-ns)
+ ;; 'init (sci/copy-var sci/init sci-ns)
+ ;; 'fork (sci/copy-var sci/fork sci-ns)
+ }
+ 'babashka.cli cli/cli-namespace
+ }
features/xml? (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace)
'clojure.data.xml.event @(resolve 'babashka.impl.xml/xml-event-namespace)
'clojure.data.xml.tree @(resolve 'babashka.impl.xml/xml-tree-namespace))
@@ -524,9 +560,6 @@ Use bb run --help to show this help output.
("--verbose") (recur (next options)
(assoc opts-map
:verbose? true))
- ("--force") (recur (next options)
- (assoc opts-map
- :force? true))
("--describe") (recur (next options)
(assoc opts-map
:describe? true))
@@ -620,6 +653,12 @@ Use bb run --help to show this help output.
:command-line-args (if (= "--" (second options))
(nthrest options 2)
(rest options))))
+ ("--exec", "-x",)
+ (let [options (next options)]
+ (assoc opts-map :exec (first options)
+ :command-line-args (if (= "--" (second options))
+ (nthrest options 2)
+ (rest options))))
("--run")
(parse-run-opts opts-map (next options))
("--tasks")
@@ -627,6 +666,10 @@ Use bb run --help to show this help output.
:command-line-args (next options))
("--print-deps")
(parse-print-deps-opts opts-map (next options))
+ ("--prepare")
+ (let [options (next options)]
+ (recur (next options)
+ (assoc opts-map :prepare true)))
;; fallback
(if (and opts-map
(some opts-map [:file :jar :socket-repl :expressions :main :run]))
@@ -661,6 +704,12 @@ Use bb run --help to show this help output.
("--init")
(recur (nnext options) (assoc opts-map :init (second options)))
+ ("--force" "-Sforce")
+ (recur (next options) (assoc opts-map :force? true))
+
+ ("-Sdeps")
+ (recur (nnext options) (assoc opts-map :merge-deps (second options)))
+
("--config")
(recur (nnext options) (assoc opts-map :config (second options)))
@@ -669,6 +718,15 @@ Use bb run --help to show this help output.
[options opts-map])
[options opts-map])))
+(defn parse-file-opt
+ [options opts-map]
+ (let [opt (first options)
+ opts-key (if (str/ends-with? opt ".jar")
+ :jar :file)]
+ (assoc opts-map
+ opts-key opt
+ :command-line-args (next options))))
+
(defn parse-opts
([options] (parse-opts options nil))
([options opts-map]
@@ -678,29 +736,51 @@ Use bb run --help to show this help output.
;; FILE > TASK > SUBCOMMAND
(cond
(.isFile (io/file opt))
- (if (str/ends-with? opt ".jar")
- (assoc opts-map
- :jar opt
- :command-line-args (next options))
- (assoc opts-map
- :file opt
- :command-line-args (next options)))
+ (if (or (:file opts-map) (:jar opts-map))
+ opts-map ; we've already parsed the file opt
+ (parse-file-opt options opts-map))
+
(contains? tasks opt)
(assoc opts-map
:run opt
:command-line-args (next options))
+
(command? opt)
(recur (cons (str "--" opt) (next options)) opts-map)
+
:else
(parse-args options opts-map))))))
(def env (atom {}))
+(def pod-namespaces (volatile! {}))
+
+(defn download-only?
+ "If we're preparing pods for another OS / arch, don't try to run them."
+ []
+ (let [env-os-name (System/getenv "BABASHKA_PODS_OS_NAME")
+ env-os-name-present? (not (str/blank? env-os-name))
+ sys-os-name (System/getProperty "os.name")
+ env-os-arch (System/getenv "BABASHKA_PODS_OS_ARCH")
+ env-os-arch-present? (not (str/blank? env-os-arch))
+ sys-os-arch (System/getProperty "os.arch")]
+ (when @common/debug
+ (binding [*out* *err*]
+ (println "System OS name:" sys-os-name)
+ (when env-os-name-present? (println "BABASHKA_PODS_OS_NAME:" env-os-name))
+ (println "System OS arch:" sys-os-arch)
+ (when env-os-arch-present? (println "BABASHKA_PODS_OS_ARCH:" env-os-arch))))
+ (cond
+ env-os-name-present? (not= env-os-name sys-os-name)
+ env-os-arch-present? (not= env-os-arch sys-os-arch))))
+
(defn exec [cli-opts]
(binding [*unrestricted* true]
(sci/binding [core/warn-on-reflection @core/warn-on-reflection
+ core/unchecked-math @core/unchecked-math
core/data-readers @core/data-readers
- sci/ns @sci/ns]
+ sci/ns @sci/ns
+ sci/print-length @sci/print-length]
(let [{version-opt :version
:keys [:shell-in :edn-in :shell-out :edn-out
:help :file :command-line-args
@@ -710,11 +790,13 @@ Use bb run --help to show this help output.
:main :uberscript :describe?
:jar :uberjar :clojure
:doc :run :list-tasks
- :print-deps]}
+ :print-deps :prepare]
+ exec-fn :exec}
cli-opts
_ (when debug (vreset! common/debug true))
_ (do ;; set properties
(when main (System/setProperty "babashka.main" main))
+ ;; TODO: what about exec here?
(System/setProperty "babashka.version" version))
read-next (fn [*in*]
(if (pipe-signal-received?)
@@ -746,29 +828,51 @@ Use bb run --help to show this help output.
_ (when jar
(cp/add-classpath jar))
load-fn (fn [{:keys [:namespace :reload]}]
- (or (when-let [{:keys [:loader]}
- @cp/cp-state]
- (if ;; ignore built-in namespaces when uberscripting, unless with :reload
- (and uberscript
- (not reload)
- (or (contains? namespaces namespace)
- (contains? sci-namespaces/namespaces namespace)))
- ""
- (when-let [res (cp/source-for-namespace loader namespace nil)]
- (if uberscript
- (do (swap! uberscript-sources conj (:source res))
- (uberscript/uberscript {:ctx @common/ctx
- :expressions [(:source res)]})
- {})
- res))))
- (case namespace
- clojure.spec.alpha
- (binding [*out* *err*]
- (println "[babashka] WARNING: Use the babashka-compatible version of clojure.spec.alpha, available here: https://github.com/babashka/spec.alpha"))
- clojure.core.specs.alpha
- (binding [*out* *err*]
- (println "[babashka] WARNING: clojure.core.specs.alpha is removed from the classpath, unless you explicitly add the dependency."))
- nil)))
+ (let [{:keys [loader]}
+ @cp/cp-state]
+ (or
+ (when ;; ignore built-in namespaces when uberscripting, unless with :reload
+ (and uberscript
+ (not reload)
+ (or (contains? namespaces namespace)
+ (contains? sci-namespaces/namespaces namespace)))
+ "")
+ ;; pod namespaces go before namespaces from source,
+ ;; unless reload is used
+ (when-not reload
+ (when-let [pod (get @pod-namespaces namespace)]
+ (if uberscript
+ (do
+ (swap! uberscript-sources conj
+ (format
+ "(babashka.pods/load-pod '%s \"%s\" '%s)\n"
+ (:pod-spec pod) (:version (:opts pod))
+ (dissoc (:opts pod)
+ :version :metadata)))
+ {})
+ (pods/load-pod (:pod-spec pod) (:opts pod)))))
+ (when loader
+ (when-let [res (cp/source-for-namespace loader namespace nil)]
+ (if uberscript
+ (do (swap! uberscript-sources conj (:source res))
+ (uberscript/uberscript {:ctx (common/ctx)
+ :expressions [(:source res)]})
+ {})
+ res)))
+ (let [rps (cp/resource-paths namespace)
+ rps (mapv #(str "src/babashka/" %) rps)]
+ (when-let [url (some #(io/resource %) rps)]
+ (let [source (slurp url)]
+ {:file (str url)
+ :source source})))
+ (case namespace
+ clojure.spec.alpha
+ (binding [*out* *err*]
+ (println "[babashka] WARNING: Use the babashka-compatible version of clojure.spec.alpha, available here: https://github.com/babashka/spec.alpha"))
+ clojure.core.specs.alpha
+ (binding [*out* *err*]
+ (println "[babashka] WARNING: clojure.core.specs.alpha is removed from the classpath, unless you explicitly add the dependency."))
+ nil))))
main (if (and jar (not main))
(when-let [res (cp/getResource
(cp/loader jar)
@@ -780,10 +884,10 @@ Use bb run --help to show this help output.
:namespaces (-> namespaces
(assoc 'clojure.core
(assoc core-extras
- 'load-file (sci-namespaces/core-var 'load-file load-file*))))
+ 'load-file (sci-copy-vars/new-var 'load-file load-file*))))
:env env
:features #{:bb :clj}
- :classes classes/class-map
+ :classes @classes/class-map
:imports classes/imports
:load-fn load-fn
:uberscript uberscript
@@ -792,7 +896,11 @@ Use bb run --help to show this help output.
:proxy-fn proxy-fn}
opts (addons/future opts)
sci-ctx (sci/init opts)
- _ (vreset! common/ctx sci-ctx)
+ _ (ctx-store/reset-ctx! sci-ctx)
+ _ (when-let [pods (:pods @common/bb-edn)]
+ (when-let [pod-metadata (pods/load-pods-metadata
+ pods {:download-only (download-only?)})]
+ (vreset! pod-namespaces pod-metadata)))
preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
[expressions exit-code]
(cond expressions [expressions nil]
@@ -805,6 +913,9 @@ Use bb run --help to show this help output.
"-main")]
[[(format "(ns user (:require [%1$s])) (apply %1$s/%2$s *command-line-args*)"
ns var-name)] nil])
+ exec-fn
+ (let [sym (symbol exec-fn)]
+ [[(cli/exec-fn-snippet sym)] nil])
run (if (:run-help cli-opts)
[(print-run-help) 0]
(do
@@ -860,10 +971,11 @@ Use bb run --help to show this help output.
describe?
[(print-describe) 0]
repl [(repl/start-repl! sci-ctx) 0]
- nrepl [(start-nrepl! nrepl sci-ctx) 0]
+ nrepl [(start-nrepl! nrepl) 0]
uberjar [nil 0]
list-tasks [(tasks/list-tasks sci-ctx) 0]
print-deps [(print-deps/print-deps (:print-deps-format cli-opts)) 0]
+ prepare [nil 0]
uberscript
[nil (do (uberscript/uberscript {:ctx sci-ctx
:expressions expressions})
@@ -872,8 +984,8 @@ Use bb run --help to show this help output.
;; execute code
(sci/binding [sci/file abs-path]
(try
- ; when evaluating expression(s), add in repl-requires so things like
- ; pprint and dir are available
+ ;; when evaluating expression(s), add in repl-requires so things like
+ ;; pprint and dir are available
(sci/eval-form sci-ctx `(apply require (quote ~clojure-main/repl-requires)))
(loop []
(let [in (read-next *in*)]
@@ -919,11 +1031,20 @@ Use bb run --help to show this help output.
(spit uberscript-out expression :append true)))
(when uberjar
(if-let [cp (cp/get-classpath)]
- (uberjar/run {:dest uberjar
- :jar :uber
- :classpath cp
- :main-class main
- :verbose debug})
+ (let [uber-params {:dest uberjar
+ :jar :uber
+ :classpath cp
+ :main-class main
+ :verbose debug}]
+ (if-let [bb-edn-pods (:pods @common/bb-edn)]
+ (fs/with-temp-dir [bb-edn-dir {}]
+ (let [bb-edn-resource (fs/file bb-edn-dir "META-INF" "bb.edn")]
+ (fs/create-dirs (fs/parent bb-edn-resource))
+ (->> {:pods bb-edn-pods} pr-str (spit bb-edn-resource))
+ (let [cp-with-bb-edn (str bb-edn-dir cp/path-sep cp)]
+ (uberjar/run (assoc uber-params
+ :classpath cp-with-bb-edn)))))
+ (uberjar/run uber-params)))
(throw (Exception. "The uberjar task needs a classpath."))))
exit-code))))
@@ -936,16 +1057,33 @@ Use bb run --help to show this help output.
(and (= minor-current minor-min)
(>= patch-current patch-min)))))))
+(defn load-bb-edn [string]
+ (try (edn/read-string {:default tagged-literal} string)
+ (catch java.lang.RuntimeException e
+ (if (re-find #"No dispatch macro for: \"" (.getMessage e))
+ (throw (ex-info "Invalid regex literal found in EDN config, use re-pattern instead" {}))
+ (do (binding [*out* *err*]
+ (println "Error during loading bb.edn:"))
+ (throw e))))))
+
(defn main [& args]
(let [[args global-opts] (parse-global-opts args)
+ {:keys [:jar] :as file-opt} (when (some-> args first io/file .isFile)
+ (parse-file-opt args global-opts))
config (:config global-opts)
- bb-edn-file (or config
- "bb.edn")
- bb-edn (when (fs/exists? bb-edn-file)
- (System/setProperty "babashka.config"
- (.getAbsolutePath (io/file bb-edn-file)))
- (let [raw-string (slurp bb-edn-file)
- edn (edn/read-string raw-string)
+ merge-deps (:merge-deps global-opts)
+ abs-path #(-> % io/file .getAbsolutePath)
+ bb-edn-file (cond
+ config (when (fs/exists? config) (abs-path config))
+ jar (some-> jar cp/loader (cp/resource "META-INF/bb.edn") .toString)
+ :else (when (fs/exists? "bb.edn") (abs-path "bb.edn")))
+ bb-edn (when (or bb-edn-file merge-deps)
+ (when bb-edn-file (System/setProperty "babashka.config" bb-edn-file))
+ (let [raw-string (when bb-edn-file (slurp bb-edn-file))
+ edn (when bb-edn-file (load-bb-edn raw-string))
+ edn (if merge-deps
+ (deps/merge-deps [edn (load-bb-edn merge-deps)])
+ edn)
edn (assoc edn
:raw raw-string
:file bb-edn-file)
@@ -954,13 +1092,14 @@ Use bb run --help to show this help output.
(assoc edn :deps-root deps-root)
edn)]
(vreset! common/bb-edn edn)))
+ ;; _ (.println System/err (str bb-edn))
min-bb-version (:min-bb-version bb-edn)]
(when min-bb-version
(when-not (satisfies-min-version? min-bb-version)
(binding [*out* *err*]
(println (str "WARNING: this project requires babashka "
min-bb-version " or newer, but you have: " version)))))
- (exec (parse-opts args global-opts))))
+ (exec (parse-opts args (merge global-opts file-opt)))))
(def musl?
"Captured at compile time, to know if we are running inside a
diff --git a/src/babashka/wait.clj b/src/babashka/wait.clj
index 5cbea999..d8c4fe69 100644
--- a/src/babashka/wait.clj
+++ b/src/babashka/wait.clj
@@ -26,8 +26,9 @@
:wait-for-port.impl/timed-out
:wait-for-port.impl/try-again))))]
(cond (identical? :wait-for-port.impl/try-again v)
- (do (Thread/sleep (or pause 100))
- (recur))
+ (let [^long pause (or pause 100)]
+ (Thread/sleep pause)
+ (recur))
(identical? :wait-for-port.impl/timed-out v)
default
:else
@@ -51,8 +52,9 @@
:wait-for-path.impl/timed-out
:wait-for-path.impl/try-again)))]
(cond (identical? :wait-for-path.impl/try-again v)
- (do (Thread/sleep (or pause 100))
- (recur))
+ (let [^long pause (or pause 100)]
+ (Thread/sleep pause)
+ (recur))
(identical? :wait-for-path.impl/timed-out v)
default
:else
diff --git a/test-resources/babashka/exec_test.clj b/test-resources/babashka/exec_test.clj
new file mode 100644
index 00000000..a18676bf
--- /dev/null
+++ b/test-resources/babashka/exec_test.clj
@@ -0,0 +1,9 @@
+(ns babashka.exec-test
+ {:org.babashka/cli {:coerce {:foo []}}})
+
+(defn exec-test
+ {:org.babashka/cli {:coerce {:bar :keyword}}}
+ [m]
+ (if (:meta m)
+ (prn (meta m))
+ (prn m)))
diff --git a/test-resources/babashka/uberjar/src/my/main_pod.clj b/test-resources/babashka/uberjar/src/my/main_pod.clj
new file mode 100644
index 00000000..a3a0e46f
--- /dev/null
+++ b/test-resources/babashka/uberjar/src/my/main_pod.clj
@@ -0,0 +1,5 @@
+(ns my.main-pod
+ (:require [pod.babashka.go-sqlite3 :as sqlite]))
+
+(defn -main [& _args]
+ (sqlite/query ":memory:" ["SELECT 1 + 2 as sum"]))
diff --git a/test-resources/babashka/uberscript/src/my/main_pod.clj b/test-resources/babashka/uberscript/src/my/main_pod.clj
new file mode 100644
index 00000000..139b5e48
--- /dev/null
+++ b/test-resources/babashka/uberscript/src/my/main_pod.clj
@@ -0,0 +1,6 @@
+(ns my.main-pod
+ (:require [my.other-ns-with-pod]
+ [pod.babashka.go-sqlite3 :as sqlite]))
+
+(defn -main [& _args]
+ (sqlite/query ":memory:" ["SELECT 1 + 2 as sum"]))
diff --git a/test-resources/babashka/uberscript/src/my/other_ns_with_pod.clj b/test-resources/babashka/uberscript/src/my/other_ns_with_pod.clj
new file mode 100644
index 00000000..b8f061ba
--- /dev/null
+++ b/test-resources/babashka/uberscript/src/my/other_ns_with_pod.clj
@@ -0,0 +1,2 @@
+(ns my.other-ns-with-pod
+ (:require [pod.babashka.go-sqlite3]))
diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj
index 56fcda74..092263f8 100644
--- a/test-resources/lib_tests/babashka/run_all_libtests.clj
+++ b/test-resources/lib_tests/babashka/run_all_libtests.clj
@@ -1,10 +1,17 @@
(ns babashka.run-all-libtests
- (:require [babashka.core :refer [windows?]]
- [clojure.edn :as edn]
- [clojure.java.io :as io]
- [clojure.test :as t :refer [*report-counters*]]))
+ (:require
+ [babashka.classpath :as cp :refer [add-classpath]]
+ [babashka.core :refer [windows?]]
+ [babashka.fs :as fs]
+ [clojure.edn :as edn]
+ [clojure.java.io :as io]
+ [clojure.spec.test.alpha :as st]
+ [clojure.string :as str]
+ [clojure.test :as t :refer [*report-counters*]]))
-(defmethod clojure.test/report :end-test-var [_m]
+(def orig-spec-checking-fn @#'st/spec-checking-fn)
+
+(defmethod t/report :end-test-var [_m]
(when-let [rc *report-counters*]
(let [{:keys [:fail :error]} @rc]
(when (and (= "true" (System/getenv "BABASHKA_FAIL_FAST"))
@@ -32,19 +39,33 @@
(defn test-namespaces [& namespaces]
(let [namespaces (seq (filter test-namespace? namespaces))]
(when (seq namespaces)
- (doseq [n namespaces]
- (require n)
- (filter-vars! (find-ns n) #(-> % meta ((some-fn :skip-bb
- :test-check-slow)) not)))
- (let [m (apply t/run-tests namespaces)]
- (swap! status (fn [status]
- (merge-with + status (dissoc m :type))))))))
+ (let [namespaces namespaces]
+ (doseq [n namespaces]
+ (let [orchestra? (str/starts-with? (str n) "orchestra")]
+ (if orchestra?
+ nil ;; (alter-var-root #'st/spec-checking-fn (constantly ot/spec-checking-fn))
+ (alter-var-root #'st/spec-checking-fn (constantly orig-spec-checking-fn)))
+ (when-not orchestra?
+ (require n)
+ (filter-vars! (find-ns n) #(-> % meta ((some-fn :skip-bb
+ :test-check-slow)) not))
+ (let [m (apply t/run-tests [n])]
+ (swap! status (fn [status]
+ (merge-with + status (dissoc m :type))))))))))))
;; 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)]
+(let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))
+ test-nss (atom [])]
+ (doseq [[libname {tns :test-namespaces skip-windows :skip-windows
+ :keys [test-paths
+ git-sha]}] lib-tests]
+ (let [git-dir (format ".gitlibs/libs/%s/%s" libname git-sha)
+ git-dir (fs/file (fs/home) git-dir)]
+ (doseq [p test-paths]
+ (add-classpath (str (fs/file git-dir p)))))
(when-not (and skip-windows (windows?))
- (apply test-namespaces tns))))
+ (swap! test-nss into tns)))
+ (apply test-namespaces @test-nss))
;; Non-standard tests - These are tests with unusual setup around test-namespaces
diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn
index 9297d2a2..d549dfa2 100644
--- a/test-resources/lib_tests/bb-tested-libs.edn
+++ b/test-resources/lib_tests/bb-tested-libs.edn
@@ -20,8 +20,6 @@
;; 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)}
@@ -47,7 +45,7 @@
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
+ ; 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}
@@ -71,7 +69,6 @@
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}
@@ -79,7 +76,7 @@
;; 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"}
+ org.clojars.lispyclouds/contajners {:git-url "https://github.com/lispyclouds/contajners", :test-namespaces (contajners.impl-test), :git-sha "5d55187eebedee4cd4f120fbffcbbcfae70a8a7b"}
;; 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`
@@ -111,4 +108,78 @@
aysylu/loom {:git-url "https://github.com/aysylu/loom", :test-namespaces (loom.test.network-simplex loom.test.label loom.test.alg-generic loom.test.compliance-tester loom.test.flow loom.test.alg loom.test.attr loom.test.graph loom.test.derived), :git-sha "d458f0c0dee9021983c64381b90a470f0178cc8e"}
com.layerware/hugsql-core {:test-namespaces (hugsql.babashka-test)}
com.github.seancorfield/expectations {:git-url "https://github.com/clojure-expectations/clojure-test", :test-namespaces (expectations.clojure.test-test), :git-sha "b30fefd97d9eb7d1f47e06956521f354cb926b03"}
-}
+ com.rpl/specter {:git-url "https://github.com/redplanetlabs/specter", :test-namespaces (com.rpl.specter.cljs-test-helpers com.rpl.specter.test-helpers com.rpl.specter.core-test com.rpl.specter.zipper-test), :git-sha "67e86806020b9d02fbca8cdb1efad3002fc81a32"}
+ com.github.askonomm/clarktown {:git-url "https://github.com/askonomm/clarktown", :test-namespaces (clarktown.core-test clarktown.parsers.horizontal-line-block-test clarktown.parsers.italic-test clarktown.parsers.link-and-image-test clarktown.parsers.empty-block-test clarktown.parsers.inline-code-test clarktown.parsers.heading-block-test clarktown.parsers.bold-test clarktown.parsers.quote-block-test clarktown.parsers.code-block-test clarktown.parsers.strikethrough-test), :git-sha "059bfa7bd9bfdde0c75646bf1dfc20d23da8a02c"}
+ org.clojure/math.numeric-tower {:git-url "https://github.com/clojure/math.numeric-tower", :test-namespaces (clojure.math.test-numeric-tower), :git-sha "97827be66f35feebc3c89ba81c546fef4adc7947"}
+ prismatic/schema {:test-namespaces [schema.core-test
+ schema.macros-test
+ schema.coerce-test
+ schema.experimental.abstract-map-test
+ schema.test-test
+ schema.utils-test]
+ :git-url "https://github.com/plumatic/schema"
+ :git-sha "6846dc7c3a9df5bfd718f68f183c683ce0f621ff"
+ :git-tag "schema-1.3.0"
+ ;; specify for adding tests to classpath
+ :test-paths ["test/clj" "test/cljc"]}
+ metosin/malli {:test-namespaces [malli.clj-kondo-test
+ malli.core-test
+ malli.destructure-test
+ malli.dot-test
+ malli.error-test
+ malli.experimental-test
+ ;; malli.generator-test
+ malli.instrument-test
+ malli.json-schema-test
+ malli.plantuml-test
+ malli.provider-test
+ malli.registry-test
+ malli.swagger-test
+ malli.transform-test
+ malli.util-test]
+ :git-url "https://github.com/metosin/malli"
+ :git-sha "588147ef49b2e41c7d12a8aa994b39c1c6fedd99"
+ :git-tag "0.8.9"
+ ;; specify for adding tests to classpath
+ :test-paths ["test"]}
+ meander/epsilon {:test-namespaces [meander.epsilon-test
+ meander.defsyntax-test
+ meander.syntax.epsilon-test
+ meander.substitute.epsilon-test
+ meander.strategy.epsilon-test
+ meander.matrix.epsilon-test
+ meander.match.epsilon-test
+ meander.match.ir.epsilon-test
+ meander.match.check.epsilon-test
+ meander.interpreter.epsilon-test
+ meander.defsyntax-test.gh-145]
+ :test-paths ["test"]
+ :git-url "https://github.com/noprompt/meander"
+ :git-sha "55f5ce70e6ef717e95c58260f6bc725d70c0cb6d"}
+ cc.qbits/auspex {:git-url "https://github.com/mpenet/auspex"
+ :git-sha "1a9d7427e60e1a434a764aa820d1c53f7e22504a"
+ :test-paths ["test"]
+ :test-namespaces [qbits.auspex-test]}
+ exoscale/interceptor {:git-url "https://github.com/exoscale/interceptor"
+ :git-sha "ca115fe00a0abf3a2f78452ab309c3aa4c00fc4e"
+ :test-paths ["test"]
+ :test-namespaces [exoscale.interceptor-test]}
+ clj-commons/fs {:git-url "https://github.com/clj-commons/fs", :test-namespaces (me.raynes.core-test), :git-sha "60026817c44015da8656925411d4af1d8210bad0"}
+ postmortem/postmortem {:git-url "https://github.com/athos/Postmortem"
+ :git-sha "1a29775a3d286f9f6fe3f979c78b6e2bf298d5ba"
+ :test-paths ["test"]
+ :test-namespaces [postmortem.core-test postmortem.instrument-test
+ postmortem.instrument-test]}
+ com.github.rawleyfowler/sluj {:git-url "https://github.com/rawleyfowler/sluj"
+ :git-sha "4a92e772b4e07bf127423448d4140748b5782198"
+ :test-paths ["test"]
+ :test-namespaces [sluj.core-test]}
+ io.github.cognitect-labs/test-runner {:git-url "https://github.com/cognitect-labs/test-runner",
+ :git-sha "7284cda41fb9edc0f3bc6b6185cfb7138fc8a023"
+ :test-namespaces [cognitect.test-runner.samples-test cognitect.test-runner.sample-property-test cognitect.test-runner-test],
+ :test-paths ["test"]}
+ ;; BB-TEST-PATCH: Removed clojure.tools.namespace.dir-test as it fails on windows
+ org.clojure/tools.namespace {:git-sha "daf82a10e70182aea4c0716a48f3922163441b32",
+ :git-url "https://github.com/clojure/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],
+ :test-paths ["src/test/clojure"]}}
diff --git a/test-resources/lib_tests/clarktown/core.md b/test-resources/lib_tests/clarktown/core.md
new file mode 100644
index 00000000..6a5b2f17
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/core.md
@@ -0,0 +1,93 @@
+Lorem ipsum dolor **sit** amet. Lorem ipsum *dolor* _sit_ __amet__.
+
+There's a [link here](https://example.com/that_has_things?!???!#in-it).
+
+1. List item
+2. Another list item
+ 1. Sub list item
+ 2. Another sub list item
+ 1. Sub sub list item
+ 3. Continuing sub list item
+3. Continuing list item
+
+```javascript
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `
`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
+```
+
+- Test 123
+- Test 223
+ - Test 334
+ 1. Test test
+
+This is ___bold italic text___ and ***this is also***. *What about italic text that **has bold text***?
+
+## Hi there, world!
+
+* List item
+* Another list ~~item~~
+ * Sub list item
+ * Another sub list item
+ * Sub sub list item
+ * Continuing sub list item
+* Continuing list item
+
+***
+
+* List item
+* Another list item
+ * Sub list item
+ * Another sub list item
+ 1. Sub sub list item
+ 2. Continuing sub list item
+* Continuing list item
+
+This is a H1 heading with settext
+=================================
+
+And this is a H2 heading with settext
+-------------------------------------
+
+Testing paragraph right before a code block
+```
+code goes here
+```
+# Heading goes here
+Paragraph right after heading
diff --git a/test-resources/lib_tests/clarktown/core_result.html b/test-resources/lib_tests/clarktown/core_result.html
new file mode 100644
index 00000000..d604bf58
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/core_result.html
@@ -0,0 +1,69 @@
+Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet.
+
+There's a link here.
+
+- List item
- Another list item
- Sub list item
- Another sub list item
- Sub sub list item
- Continuing sub list item
- Continuing list item
+
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `<hr>`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
+
+
+
+This is bold italic text and this is also. What about italic text that has bold text?
+
+Hi there, world!
+
+- List item
- Another list
item- Sub list item
- Another sub list item
- Sub sub list item
- Continuing sub list item
- Continuing list item
+
+
+
+- List item
- Another list item
- Sub list item
- Another sub list item
- Sub sub list item
- Continuing sub list item
- Continuing list item
+
+This is a H1 heading with settext
+
+And this is a H2 heading with settext
+
+Testing paragraph right before a code block
+
+code goes here
+
+Heading goes here
+
+Paragraph right after heading
diff --git a/test-resources/lib_tests/clarktown/core_test.clj b/test-resources/lib_tests/clarktown/core_test.clj
new file mode 100644
index 00000000..86ca1765
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/core_test.clj
@@ -0,0 +1,15 @@
+(ns clarktown.core-test
+ (:require
+ ;; BB-TEST-PATCH: require clojure.string for split-lines patch below
+ [clojure.string :as str]
+ [clojure.test :refer [deftest testing is]]
+ [clojure.java.io :as io]
+ [clarktown.core :as core]))
+
+
+(deftest overall-test
+ (testing "Overall"
+ ;; BB-TEST-PATCH: library uses hard-coded \n, so using split-lines for platform-agnostic testing
+ ;; BB-TEST-PATCH: change file paths to match bb folder structure (and copy resource files)
+ (is (= (str/split-lines (core/render (slurp (io/file (io/resource "clarktown/core.md")))))
+ (str/split-lines (slurp (io/file (io/resource "clarktown/core_result.html"))))))))
diff --git a/test-resources/lib_tests/clarktown/parsers/bold_test.clj b/test-resources/lib_tests/clarktown/parsers/bold_test.clj
new file mode 100644
index 00000000..a082d418
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/bold_test.clj
@@ -0,0 +1,18 @@
+(ns clarktown.parsers.bold-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.bold :as bold]))
+
+
+(deftest bold-test
+ (testing "Creating bold text with two surrounding asterisk characters"
+ (is (= "This is bold."
+ (bold/render "**This is bold.**" nil))))
+
+ (testing "Creating bold text with two surrounding underscore characters"
+ (is (= "This is bold."
+ (bold/render "__This is bold.__" nil))))
+
+ (testing "Creating bold text with both underscores and asterisks mixed"
+ (is (= "Hi, my name is John, what is your name?"
+ (bold/render "Hi, my name is **John**, what is __your name?__" nil)))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/code_block.md b/test-resources/lib_tests/clarktown/parsers/code_block.md
new file mode 100644
index 00000000..8e6f863f
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/code_block.md
@@ -0,0 +1,41 @@
+```javascript
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `
`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
+```
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/code_block_no_language.md b/test-resources/lib_tests/clarktown/parsers/code_block_no_language.md
new file mode 100644
index 00000000..dbba1f11
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/code_block_no_language.md
@@ -0,0 +1,41 @@
+```
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `
`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
+```
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/code_block_no_language_result.html b/test-resources/lib_tests/clarktown/parsers/code_block_no_language_result.html
new file mode 100644
index 00000000..0512d3eb
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/code_block_no_language_result.html
@@ -0,0 +1,39 @@
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `<hr>`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/code_block_result.html b/test-resources/lib_tests/clarktown/parsers/code_block_result.html
new file mode 100644
index 00000000..21b92144
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/code_block_result.html
@@ -0,0 +1,39 @@
+// Detect horizontal line block
+function isHorizontalLineBlock(block) {
+ return block === "***";
+}
+
+// Render horizontal line block
+function horizontalLineBlock(block) {
+ return `<hr>`;
+}
+
+// Compose an array of parsers
+const parsers = [{
+ matcher: isHorizontalLineBlock,
+ renderers: [horizontalLineBlock]
+}];
+
+// And finally, our parser itself
+function markdownToHTML(markdown) {
+ // Create blocks
+ const blocks = content.split(/\n\n/);
+
+ // Parse blocks
+ const parsedBlocks = blocks.map((block) => {
+ // Let's find a parser that has a matcher that matches
+ const parser = parsers.find((parser) => parser.matcher(block));
+
+ // If match was found, let's run our renderers over `block`
+ if (parser) {
+ for (const renderer of match.renderers) {
+ block = renderer(block);
+ }
+ }
+
+ return block;
+ });
+
+ // And at last, join the blocks together for one big block.
+ return parsedBlocks.join("");
+}
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/code_block_test.clj b/test-resources/lib_tests/clarktown/parsers/code_block_test.clj
new file mode 100644
index 00000000..b965e5fa
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/code_block_test.clj
@@ -0,0 +1,18 @@
+(ns clarktown.parsers.code-block-test
+ (:require
+ ;; require clojure.string to accomodate line break hack below
+ [clojure.string :as str]
+ [clojure.test :refer [deftest testing is]]
+ [clojure.java.io :as io]
+ [clarktown.parsers.code-block :as code-block]))
+
+;; BB-TEST-PATCH: change paths to match folder structure (and copy resource files)
+;; BB-TEST-PATCH: use split-lines to make tests platform-agnostic
+(deftest code-block-test
+ (testing "Code block with language specification"
+ (is (= (str/split-lines (slurp (io/file (io/resource "clarktown/parsers/code_block_result.html"))))
+ (str/split-lines (code-block/render (slurp (io/file (io/resource "clarktown/parsers/code_block.md"))) nil)))))
+
+ (testing "Code block with NO language specification"
+ (is (= (str/split-lines (slurp (io/file (io/resource "clarktown/parsers/code_block_no_language_result.html"))))
+ (str/split-lines (code-block/render (slurp (io/file (io/resource "clarktown/parsers/code_block_no_language.md"))) nil))))))
diff --git a/test-resources/lib_tests/clarktown/parsers/empty_block_test.clj b/test-resources/lib_tests/clarktown/parsers/empty_block_test.clj
new file mode 100644
index 00000000..a8d89c48
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/empty_block_test.clj
@@ -0,0 +1,14 @@
+(ns clarktown.parsers.empty-block-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.empty-block :as empty-block]))
+
+
+(deftest empty-block-test
+ (testing "Rendering an empty block"
+ (is (= (empty-block/render "" nil)
+ "")))
+
+ (testing "Checking an empty block"
+ (is (true? (empty-block/is? "")))
+ (is (true? (empty-block/is? " ")))))
diff --git a/test-resources/lib_tests/clarktown/parsers/heading_block_test.clj b/test-resources/lib_tests/clarktown/parsers/heading_block_test.clj
new file mode 100644
index 00000000..9bfff4fd
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/heading_block_test.clj
@@ -0,0 +1,44 @@
+(ns clarktown.parsers.heading-block-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.heading-block :as heading-block]))
+
+
+(deftest hashbang-heading-test
+ (testing "Hashbang heading block that's a H1"
+ (is (= "This is a heading block.
"
+ (heading-block/render "# This is a heading block." nil))))
+
+ (testing "Hashbang heading block that's a H2"
+ (is (= "This is a heading block.
"
+ (heading-block/render "## This is a heading block." nil))))
+
+ (testing "Hashbang heading block that's a H3"
+ (is (= "This is a heading block.
"
+ (heading-block/render "### This is a heading block." nil))))
+
+ (testing "Hashbang heading block that's a H4"
+ (is (= "This is a heading block.
"
+ (heading-block/render "#### This is a heading block." nil))))
+
+ (testing "Hashbang heading block that's a H5"
+ (is (= "This is a heading block.
"
+ (heading-block/render "##### This is a heading block." nil)))))
+
+
+(deftest settext-heading-text
+ (testing "Settext heading block that's a H1"
+ (is (= "This is a heading block.
"
+ (heading-block/render "This is a heading block.\n=========" nil))))
+
+ (testing "Settext heading block that's a H1 spanning multiple lines"
+ (is (= "This is a \nheading block spanning multiple lines.
"
+ (heading-block/render "This is a \nheading block spanning multiple lines.\n========" nil))))
+
+ (testing "Settext heading block that's a H2"
+ (is (= "This is a heading block.
"
+ (heading-block/render "This is a heading block.\n---------" nil))))
+
+ (testing "Settext heading block that's a H2 spanning multiple lines"
+ (is (= "This is a \nheading block spanning multiple lines.
"
+ (heading-block/render "This is a \nheading block spanning multiple lines.\n--------" nil)))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/horizontal_line_block_test.clj b/test-resources/lib_tests/clarktown/parsers/horizontal_line_block_test.clj
new file mode 100644
index 00000000..21617b6c
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/horizontal_line_block_test.clj
@@ -0,0 +1,21 @@
+(ns clarktown.parsers.horizontal-line-block-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.horizontal-line-block :as horizontal-line-block]))
+
+
+(deftest horizontal-line-block-test
+ (testing "Creating a horizontal line"
+ (is (= "
"
+ (horizontal-line-block/render "***" nil)))
+
+ (is (= "
"
+ (horizontal-line-block/render "---" nil))))
+
+ (testing "Is a horizontal line block"
+ (is (true? (horizontal-line-block/is? "***")))
+ (is (true? (horizontal-line-block/is? " ***")))
+ (is (false? (horizontal-line-block/is? "Test *** 123")))
+ (is (true? (horizontal-line-block/is? "---")))
+ (is (true? (horizontal-line-block/is? " ---")))
+ (is (false? (horizontal-line-block/is? "Test --- 123")))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/inline_code_test.clj b/test-resources/lib_tests/clarktown/parsers/inline_code_test.clj
new file mode 100644
index 00000000..028c4b7d
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/inline_code_test.clj
@@ -0,0 +1,14 @@
+(ns clarktown.parsers.inline-code-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.inline-code :as inline-code]))
+
+
+(deftest inline-code-test
+ (testing "Creating inline code text"
+ (is (= "This is inline code."
+ (inline-code/render "`This is inline code.`" nil))))
+
+ (testing "Creating inline-code text in the middle of regular text"
+ (is (= "This is regular text, mixed with some inline code., and it's great."
+ (inline-code/render "This is regular text, mixed with `some inline code.`, and it's great." nil)))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/italic_test.clj b/test-resources/lib_tests/clarktown/parsers/italic_test.clj
new file mode 100644
index 00000000..8ab13698
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/italic_test.clj
@@ -0,0 +1,18 @@
+(ns clarktown.parsers.italic-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.italic :as italic]))
+
+
+(deftest italic-test
+ (testing "Creating italic text with one surrounding asterisk character"
+ (is (= "This is italic."
+ (italic/render "*This is italic.*" nil))))
+
+ (testing "Creating italic text with one surrounding underscore character"
+ (is (= "This is italic."
+ (italic/render "_This is italic._" nil))))
+
+ (testing "Creating italic text with both underscores and asterisks mixed"
+ (is (= "Hi, my name is John, what is your name?"
+ (italic/render "Hi, my name is *John*, what is _your name?_" nil)))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/link_and_image_test.clj b/test-resources/lib_tests/clarktown/parsers/link_and_image_test.clj
new file mode 100644
index 00000000..348a8f90
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/link_and_image_test.clj
@@ -0,0 +1,23 @@
+(ns clarktown.parsers.link-and-image-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.link-and-image :as link-and-image]))
+
+
+(deftest link-test
+ (testing "Creating a link"
+ (is (= (link-and-image/render "[This is a link](https://example.com)" nil)
+ "This is a link"))
+
+ (is (= (link-and-image/render "[This-is-a-link](https://example.com)" nil)
+ "This-is-a-link"))
+
+ (is (= (link-and-image/render "[x] [label](link)" nil)
+ "[x] label"))
+
+ (is (= (link-and-image/render "[ ] [label](link)" nil)
+ "[ ] label")))
+
+ (testing "Creating an image"
+ (is (= (link-and-image/render "" nil)
+ "![\"This](\"https://example.com\")
"))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/quote_block_test.clj b/test-resources/lib_tests/clarktown/parsers/quote_block_test.clj
new file mode 100644
index 00000000..94553cf1
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/quote_block_test.clj
@@ -0,0 +1,15 @@
+(ns clarktown.parsers.quote-block-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.quote-block :as quote-block]))
+
+
+(deftest quote-block-block-test
+ (testing "Creating a quote block line"
+ (is (= (quote-block/render "> First line\n> second line" nil)
+ "First line\nsecond line
")))
+
+ (testing "Checking a quote block"
+ (is (true? (quote-block/is? "> Test")))
+ (is (true? (quote-block/is? " > Test")))
+ (is (true? (quote-block/is? ">")))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clarktown/parsers/strikethrough_test.clj b/test-resources/lib_tests/clarktown/parsers/strikethrough_test.clj
new file mode 100644
index 00000000..fdf61888
--- /dev/null
+++ b/test-resources/lib_tests/clarktown/parsers/strikethrough_test.clj
@@ -0,0 +1,14 @@
+(ns clarktown.parsers.strikethrough-test
+ (:require
+ [clojure.test :refer [deftest testing is]]
+ [clarktown.parsers.strikethrough :as strikethrough]))
+
+
+(deftest strikethrough-test
+ (testing "Creating strikethrough text"
+ (is (= (strikethrough/render "~~This is strikethrough text.~~" nil)
+ "This is strikethrough text.")))
+
+ (testing "Creating strikethrough text mixed with regular text"
+ (is (= (strikethrough/render "Some other text, ~~This is strikethrough text.~~ And more text." nil)
+ "Some other text, This is strikethrough text. And more text."))))
\ No newline at end of file
diff --git a/test-resources/lib_tests/clojure/math/test_numeric_tower.clj b/test-resources/lib_tests/clojure/math/test_numeric_tower.clj
new file mode 100644
index 00000000..ba0ba266
--- /dev/null
+++ b/test-resources/lib_tests/clojure/math/test_numeric_tower.clj
@@ -0,0 +1,129 @@
+(ns clojure.math.test-numeric-tower
+ (:use clojure.test
+ clojure.math.numeric-tower))
+
+(deftest test-expt
+ (are [x y] (= x y)
+ (expt 2 3) 8
+ (expt (expt 2 16) 2) (expt 2 32)
+ (expt 4/3 2) 16/9
+ (expt 2 -10) 1/1024
+ (expt 0.5M 2) 0.25M
+ (expt 5 4.2) (Math/pow 5 4.2)
+ (expt 5.3 4) (Math/pow 5.3 4)
+ (expt 5.3 4) (Math/pow 5.3 4)
+ (expt 2 0) 1
+ (expt (java.math.BigInteger. "4") 0) (java.math.BigInteger. "1")
+ (expt 4M 0) 1M
+ (expt 8M 1) 8M
+ (expt 16M 16) 18446744073709551616M))
+
+(when-available clojure.lang.BigInt
+ (deftest test-expt-bigint
+ (are [x y] (= x y)
+ (expt (bigint 4) 0) (bigint 1))))
+
+(deftest test-abs
+ (are [x y] (= x y)
+ (abs -2) 2
+ (abs 0) 0
+ (abs 5) 5
+ (abs 123456789123456789) 123456789123456789
+ (abs -123456789123456789) 123456789123456789
+ (abs 5/3) 5/3
+ (abs -4/3) 4/3
+ (abs 4.3M) 4.3M
+ (abs -4.3M) 4.3M
+ (abs 2.8) 2.8
+ (abs -2.8) 2.8))
+
+(deftest test-gcd
+ (are [x y] (= x y)
+ (gcd 4 3) 1
+ (gcd 24 12) 12
+ (gcd 24 27) 3
+ (gcd 1 0) 1
+ (gcd 0 1) 1
+ (gcd 0 0) 0)
+ (is (thrown? IllegalArgumentException (gcd nil 0)))
+ (is (thrown? IllegalArgumentException (gcd 0 nil)))
+ (is (thrown? IllegalArgumentException (gcd 7.0 0))))
+
+(deftest test-lcm
+ (are [x y] (= x y)
+ (lcm 2 3) 6
+ (lcm 3 2) 6
+ (lcm -2 3) 6
+ (lcm 2 -3) 6
+ (lcm -2 -3) 6
+ (lcm 4 10) 20
+ (lcm 1 0) 0
+ (lcm 0 1) 0
+ (lcm 0 0) 0)
+ (is (thrown? IllegalArgumentException (lcm nil 0)))
+ (is (thrown? IllegalArgumentException (lcm 0 nil)))
+ (is (thrown? IllegalArgumentException (lcm 7.0 0))))
+
+(deftest test-floor
+ (are [x y] (== x y)
+ (floor 6) 6
+ (floor -6) -6
+ (floor 123456789123456789) 123456789123456789
+ (floor -123456789123456789) -123456789123456789
+ (floor 4/3) 1
+ (floor -4/3) -2
+ (floor 4.3M) 4
+ (floor -4.3M) -5
+ (floor 4.3) 4.0
+ (floor -4.3) -5.0))
+
+(deftest test-ceil
+ (are [x y] (== x y)
+ (ceil 6) 6
+ (ceil -6) -6
+ (ceil 123456789123456789) 123456789123456789
+ (ceil -123456789123456789) -123456789123456789
+ (ceil 4/3) 2
+ (ceil -4/3) -1
+ (ceil 4.3M) 5
+ (ceil -4.3M) -4
+ (ceil 4.3) 5.0
+ (ceil -4.3) -4.0))
+
+(deftest test-round
+ (are [x y] (== x y)
+ (round 6) 6
+ (round -6) -6
+ (round 123456789123456789) 123456789123456789
+ (round -123456789123456789) -123456789123456789
+ (round 4/3) 1
+ (round 5/3) 2
+ (round 5/2) 3
+ (round -4/3) -1
+ (round -5/3) -2
+ (round -5/2) -2
+ (round 4.3M) 4
+ (round 4.7M) 5
+ (round -4.3M) -4
+ (round -4.7M) -5
+ (round 4.5M) 5
+ (round -4.5M) -4
+ (round 4.3) 4
+ (round 4.7) 5
+ (round -4.3) -4
+ (round -4.7) -5
+ (round 4.5) 5
+ (round -4.5) -4))
+
+(deftest test-sqrt
+ (are [x y] (= x y)
+ (sqrt 9) 3
+ (sqrt 16/9) 4/3
+ (sqrt 0.25M) 0.5M
+ (sqrt 2) (Math/sqrt 2)))
+
+(deftest test-exact-integer-sqrt
+ (are [x y] (= x y)
+ (exact-integer-sqrt 15) [3 6]
+ (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1]
+ (exact-integer-sqrt 1000000000000) [1000000 0]))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj
deleted file mode 100644
index 5aedb27f..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj
+++ /dev/null
@@ -1,315 +0,0 @@
-(ns clojure.tools.namespace.dependency-test
- (:use clojure.test
- clojure.tools.namespace.dependency))
-
-;; building a graph like:
-;;
-;; :a
-;; / |
-;; :b |
-;; \ |
-;; :c
-;; |
-;; :d
-;;
-(def g1 (-> (graph)
- (depend :b :a) ; "B depends on A"
- (depend :c :b) ; "C depends on B"
- (depend :c :a) ; "C depends on A"
- (depend :d :c))) ; "D depends on C"
-
-;; 'one 'five
-;; | |
-;; 'two |
-;; / \ |
-;; / \ |
-;; / \ /
-;; 'three 'four
-;; | /
-;; 'six /
-;; | /
-;; | /
-;; | /
-;; 'seven
-;;
-(def g2 (-> (graph)
- (depend 'two 'one)
- (depend 'three 'two)
- (depend 'four 'two)
- (depend 'four 'five)
- (depend 'six 'three)
- (depend 'seven 'six)
- (depend 'seven 'four)))
-
-;; :level0
-;; / | | \
-;; ----- | | -----
-;; / | | \
-;; :level1a :level1b :level1c :level1d
-;; \ | | /
-;; ----- | | -----
-;; \ | | /
-;; :level2
-;; / | | \
-;; ----- | | -----
-;; / | | \
-;; :level3a :level3b :level3c :level3d
-;; \ | | /
-;; ----- | | -----
-;; \ | | /
-;; :level4
-;;
-;; ... and so on in a repeating pattern like that, up to :level26
-
-(def g3 (-> (graph)
- (depend :level1a :level0)
- (depend :level1b :level0)
- (depend :level1c :level0)
- (depend :level1d :level0)
- (depend :level2 :level1a)
- (depend :level2 :level1b)
- (depend :level2 :level1c)
- (depend :level2 :level1d)
-
- (depend :level3a :level2)
- (depend :level3b :level2)
- (depend :level3c :level2)
- (depend :level3d :level2)
- (depend :level4 :level3a)
- (depend :level4 :level3b)
- (depend :level4 :level3c)
- (depend :level4 :level3d)
-
- (depend :level5a :level4)
- (depend :level5b :level4)
- (depend :level5c :level4)
- (depend :level5d :level4)
- (depend :level6 :level5a)
- (depend :level6 :level5b)
- (depend :level6 :level5c)
- (depend :level6 :level5d)
-
- (depend :level7a :level6)
- (depend :level7b :level6)
- (depend :level7c :level6)
- (depend :level7d :level6)
- (depend :level8 :level7a)
- (depend :level8 :level7b)
- (depend :level8 :level7c)
- (depend :level8 :level7d)
-
- (depend :level9a :level8)
- (depend :level9b :level8)
- (depend :level9c :level8)
- (depend :level9d :level8)
- (depend :level10 :level9a)
- (depend :level10 :level9b)
- (depend :level10 :level9c)
- (depend :level10 :level9d)
-
- (depend :level11a :level10)
- (depend :level11b :level10)
- (depend :level11c :level10)
- (depend :level11d :level10)
- (depend :level12 :level11a)
- (depend :level12 :level11b)
- (depend :level12 :level11c)
- (depend :level12 :level11d)
-
- (depend :level13a :level12)
- (depend :level13b :level12)
- (depend :level13c :level12)
- (depend :level13d :level12)
- (depend :level14 :level13a)
- (depend :level14 :level13b)
- (depend :level14 :level13c)
- (depend :level14 :level13d)
-
- (depend :level15a :level14)
- (depend :level15b :level14)
- (depend :level15c :level14)
- (depend :level15d :level14)
- (depend :level16 :level15a)
- (depend :level16 :level15b)
- (depend :level16 :level15c)
- (depend :level16 :level15d)
-
- (depend :level17a :level16)
- (depend :level17b :level16)
- (depend :level17c :level16)
- (depend :level17d :level16)
- (depend :level18 :level17a)
- (depend :level18 :level17b)
- (depend :level18 :level17c)
- (depend :level18 :level17d)
-
- (depend :level19a :level18)
- (depend :level19b :level18)
- (depend :level19c :level18)
- (depend :level19d :level18)
- (depend :level20 :level19a)
- (depend :level20 :level19b)
- (depend :level20 :level19c)
- (depend :level20 :level19d)
-
- (depend :level21a :level20)
- (depend :level21b :level20)
- (depend :level21c :level20)
- (depend :level21d :level20)
- (depend :level22 :level21a)
- (depend :level22 :level21b)
- (depend :level22 :level21c)
- (depend :level22 :level21d)
-
- (depend :level23a :level22)
- (depend :level23b :level22)
- (depend :level23c :level22)
- (depend :level23d :level22)
- (depend :level24 :level23a)
- (depend :level24 :level23b)
- (depend :level24 :level23c)
- (depend :level24 :level23d)
-
- (depend :level25a :level24)
- (depend :level25b :level24)
- (depend :level25c :level24)
- (depend :level25d :level24)
- (depend :level26 :level25a)
- (depend :level26 :level25b)
- (depend :level26 :level25c)
- (depend :level26 :level25d)))
-
-(deftest t-transitive-dependencies
- (is (= #{:a :c :b}
- (transitive-dependencies g1 :d)))
- (is (= '#{two four six one five three}
- (transitive-dependencies g2 'seven))))
-
-(deftest t-transitive-dependencies-deep
- (is (= #{:level0
- :level1a :level1b :level1c :level1d
- :level2
- :level3a :level3b :level3c :level3d
- :level4
- :level5a :level5b :level5c :level5d
- :level6
- :level7a :level7b :level7c :level7d
- :level8
- :level9a :level9b :level9c :level9d
- :level10
- :level11a :level11b :level11c :level11d
- :level12
- :level13a :level13b :level13c :level13d
- :level14
- :level15a :level15b :level15c :level15d
- :level16
- :level17a :level17b :level17c :level17d
- :level18
- :level19a :level19b :level19c :level19d
- :level20
- :level21a :level21b :level21c :level21d
- :level22
- :level23a :level23b :level23c :level23d}
- (transitive-dependencies g3 :level24)))
- (is (= #{:level0
- :level1a :level1b :level1c :level1d
- :level2
- :level3a :level3b :level3c :level3d
- :level4
- :level5a :level5b :level5c :level5d
- :level6
- :level7a :level7b :level7c :level7d
- :level8
- :level9a :level9b :level9c :level9d
- :level10
- :level11a :level11b :level11c :level11d
- :level12
- :level13a :level13b :level13c :level13d
- :level14
- :level15a :level15b :level15c :level15d
- :level16
- :level17a :level17b :level17c :level17d
- :level18
- :level19a :level19b :level19c :level19d
- :level20
- :level21a :level21b :level21c :level21d
- :level22
- :level23a :level23b :level23c :level23d
- :level24
- :level25a :level25b :level25c :level25d}
- (transitive-dependencies g3 :level26))))
-
-
-(deftest t-transitive-dependents
- (is (= '#{four seven}
- (transitive-dependents g2 'five)))
- (is (= '#{four seven six three}
- (transitive-dependents g2 'two))))
-
-(defn- before?
- "True if x comes before y in an ordered collection."
- [coll x y]
- (loop [[item & more] (seq coll)]
- (cond (nil? item) true ; end of the seq
- (= x item) true ; x comes first
- (= y item) false
- :else (recur more))))
-
-(deftest t-before
- (is (true? (before? [:a :b :c :d] :a :b)))
- (is (true? (before? [:a :b :c :d] :b :c)))
- (is (false? (before? [:a :b :c :d] :d :c)))
- (is (false? (before? [:a :b :c :d] :c :a))))
-
-(deftest t-topo-comparator-1
- (let [sorted (sort (topo-comparator g1) [:d :a :b :foo])]
- (are [x y] (before? sorted x y)
- :a :b
- :a :d
- :a :foo
- :b :d
- :b :foo
- :d :foo)))
-
-(deftest t-topo-comparator-2
- (let [sorted (sort (topo-comparator g2) '[three seven nine eight five])]
- (are [x y] (before? sorted x y)
- 'three 'seven
- 'three 'eight
- 'three 'nine
- 'five 'eight
- 'five 'nine
- 'seven 'eight
- 'seven 'nine)))
-
-(deftest t-topo-sort
- (let [sorted (topo-sort g2)]
- (are [x y] (before? sorted x y)
- 'one 'two
- 'one 'three
- 'one 'four
- 'one 'six
- 'one 'seven
- 'two 'three
- 'two 'four
- 'two 'six
- 'two 'seven
- 'three 'six
- 'three 'seven
- 'four 'seven
- 'five 'four
- 'five 'seven
- 'six 'seven)))
-
-(deftest t-no-cycles
- (is (thrown? Exception
- (-> (graph)
- (depend :a :b)
- (depend :b :c)
- (depend :c :a)))))
-
-(deftest t-no-self-cycles
- (is (thrown? Exception
- (-> (graph)
- (depend :a :b)
- (depend :a :a)))))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj
deleted file mode 100644
index 60e56427..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj
+++ /dev/null
@@ -1,20 +0,0 @@
-(ns clojure.tools.namespace.dir-test
- (:require [clojure.test :refer [deftest is]]
- [clojure.tools.namespace.test-helpers :as help]
- [clojure.tools.namespace.dir :as dir])
- (:import
- (java.io File)))
-
-;; Only run this test on Java 1.7+, where java.nio.file.Files is available.
-(when (try (Class/forName "java.nio.file.Files")
- (catch ClassNotFoundException _ false))
- (deftest t-scan-by-canonical-path
- (let [dir (help/create-temp-dir "t-scan-by-canonical-path")
- main-clj (help/create-source dir 'example.main :clj '[example.one])
- one-cljc (help/create-source dir 'example.one :clj)
- other-dir (help/create-temp-dir "t-scan-by-canonical-path-other")
- link (File. other-dir "link")]
- (java.nio.file.Files/createSymbolicLink (.toPath link) (.toPath dir)
- (make-array java.nio.file.attribute.FileAttribute 0))
- (is (= (::dir/files (dir/scan-dirs {} [dir]))
- (::dir/files (dir/scan-dirs {} [link])))))))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/find_test.clj b/test-resources/lib_tests/clojure/tools/namespace/find_test.clj
deleted file mode 100644
index d081e84a..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/find_test.clj
+++ /dev/null
@@ -1,29 +0,0 @@
-(ns clojure.tools.namespace.find-test
- (:require [clojure.test :refer [deftest is]]
- [clojure.tools.namespace.test-helpers :as help]
- [clojure.tools.namespace.find :as find])
- (:import (java.io File)))
-
-(deftest t-find-clj-and-cljc-files
- "main.clj depends on one.cljc which depends on two.clj.
- two.cljs also exists but should not be returned"
- (let [dir (help/create-temp-dir "t-find-clj-and-cljc-files")
- main-clj (help/create-source dir 'example.main :clj '[example.one])
- one-cljc (help/create-source dir 'example.one :cljc '[example.two])
- two-clj (help/create-source dir 'example.two :clj)
- two-cljs (help/create-source dir 'example.two :cljs)]
- (is (help/same-files?
- [main-clj one-cljc two-clj]
- (find/find-sources-in-dir dir)))))
-
-(deftest t-find-cljs-and-cljc-files
- "main.cljs depends on one.cljc which depends on two.cljs.
- two.clj also exists but should not be returned"
- (let [dir (help/create-temp-dir "t-find-cljs-and-cljc-files")
- main-cljs (help/create-source dir 'example.main :cljs '[example.one])
- one-cljc (help/create-source dir 'example.one :cljc '[example.two])
- two-clj (help/create-source dir 'example.two :clj)
- two-cljs (help/create-source dir 'example.two :cljs)]
- (is (help/same-files?
- [main-cljs one-cljc two-cljs]
- (find/find-sources-in-dir dir find/cljs)))))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/move_test.clj b/test-resources/lib_tests/clojure/tools/namespace/move_test.clj
deleted file mode 100644
index 47de7ac4..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/move_test.clj
+++ /dev/null
@@ -1,52 +0,0 @@
-(ns clojure.tools.namespace.move-test
- (:require [clojure.java.io :as io]
- [clojure.test :refer [deftest is]]
- [clojure.tools.namespace.move :refer [move-ns]]
- [clojure.tools.namespace.test-helpers :as help])
- (:import (java.io File)))
-
-(defn- create-file-one [dir]
- (help/create-source dir 'example.one :clj
- '[example.two example.three]
- '[(defn foo []
- (example.a.four/foo))]))
-
-(defn- create-file-two [dir]
- (help/create-source dir 'example.two :clj
- '[example.three example.a.four]))
-
-(defn- create-file-three [dir]
- (help/create-source dir 'example.three :clj
- '[example.five]))
-
-(defn- create-file-four [dir]
- (help/create-source dir 'example.a.four :clj))
-
-(deftest t-move-ns
- (let [temp-dir (help/create-temp-dir "tools-namespace-t-move-ns")
- src-dir (io/file temp-dir "src")
- example-dir (io/file temp-dir "src" "example")
- file-one (create-file-one src-dir)
- file-two (create-file-two src-dir)
- file-three (create-file-three src-dir)
- old-file-four (create-file-four src-dir)
- new-file-four (io/file example-dir "b" "four.clj")]
-
- (let [file-three-last-modified (.lastModified file-three)]
-
- (Thread/sleep 1500) ;; ensure file timestamps are different
-
- (move-ns 'example.a.four 'example.b.four src-dir [src-dir])
-
- (is (.exists new-file-four)
- "new file should exist")
- (is (not (.exists old-file-four))
- "old file should not exist")
- (is (not (.exists (.getParentFile old-file-four)))
- "old empty directory should not exist")
- (is (= file-three-last-modified (.lastModified file-three))
- "unaffected file should not have been modified")
- (is (not-any? #(.contains (slurp %) "example.a.four")
- [file-one file-two file-three new-file-four]))
- (is (every? #(.contains (slurp %) "example.b.four")
- [file-one file-two new-file-four])))))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj b/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj
deleted file mode 100644
index b6ac6aaa..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj
+++ /dev/null
@@ -1,210 +0,0 @@
-(ns clojure.tools.namespace.parse-test
- (:use [clojure.test :only (deftest is)]
- [clojure.tools.namespace.parse :only (deps-from-ns-decl
- read-ns-decl)]))
-
-(def ns-decl-prefix-list
- '(ns com.example.one
- (:require (com.example two
- [three :as three]
- [four :refer (a b)])
- (com.example.sub [five :as five]
- six))
- (:use (com.example seven
- [eight :as eight]
- (nine :only (c d))
- [ten]))))
-
-;; Some people like to write prefix lists as vectors, not lists. The
-;; use/require functions accept this form.
-(def ns-decl-prefix-list-as-vector
- '(ns com.example.one
- (:require [com.example
- two
- [three :as three]
- [four :refer (a b)]]
- [com.example.sub
- [five :as five]
- six])
- (:use [com.example
- seven
- [eight :as eight]
- (nine :only (c d))
- [ten]])))
-
-(def ns-decl-prefix-list-clauses-as-vectors
- "Sometimes people even write the clauses inside ns as vectors, which
- clojure.core/ns allows. See TNS-21."
- '(ns com.example.one
- [:require [com.example
- two
- [three :as three]
- [four :refer (a b)]]
- [com.example.sub
- [five :as five]
- six]]
- [:use [com.example
- seven
- [eight :as eight]
- (nine :only (c d))
- [ten]]]))
-
-(def deps-from-prefix-list
- '#{com.example.two
- com.example.three
- com.example.four
- com.example.sub.five
- com.example.sub.six
- com.example.seven
- com.example.eight
- com.example.nine
- com.example.ten})
-
-(deftest t-prefix-list
- (is (= deps-from-prefix-list
- (deps-from-ns-decl ns-decl-prefix-list))))
-
-(deftest t-prefix-list-as-vector
- (is (= deps-from-prefix-list
- (deps-from-ns-decl ns-decl-prefix-list-as-vector))))
-
-(deftest t-prefix-list-clauses-as-vectors
- (is (= deps-from-prefix-list
- (deps-from-ns-decl ns-decl-prefix-list-clauses-as-vectors))))
-
-(deftest t-no-deps-returns-empty-set
- (is (= #{} (deps-from-ns-decl '(ns com.example.one)))))
-
-(def multiple-ns-decls
- '((ns one)
- (ns two (:require one))
- (ns three (:require [one :as o] [two :as t]))))
-
-(def multiple-ns-decls-string
-" (println \"Code before first ns\")
- (ns one)
- (println \"Some code\")
- (defn hello-world [] \"Hello, World!\")
- (ns two (:require one))
- (println \"Some more code\")
- (ns three (:require [one :as o] [two :as t]))")
-
-(deftest t-read-multiple-ns-decls
- (with-open [rdr (clojure.lang.LineNumberingPushbackReader.
- (java.io.PushbackReader.
- (java.io.StringReader. multiple-ns-decls-string)))]
- (is (= multiple-ns-decls
- (take-while identity (repeatedly #(read-ns-decl rdr)))))))
-
-(def ns-docstring-example
- "The example ns declaration used in the docstring of clojure.core/ns"
- '(ns foo.bar
- (:refer-clojure :exclude [ancestors printf])
- (:require (clojure.contrib sql combinatorics))
- (:use (my.lib this that))
- (:import (java.util Date Timer Random)
- (java.sql Connection Statement))))
-
-(def deps-from-ns-docstring-example
- '#{clojure.contrib.sql
- clojure.contrib.combinatorics
- my.lib.this
- my.lib.that})
-
-(deftest t-ns-docstring-example
- (is (= deps-from-ns-docstring-example
- (deps-from-ns-decl ns-docstring-example))))
-
-(def require-docstring-example
- "The example ns declaration used in the docstring of
- clojure.core/require"
- '(ns (:require (clojure zip [set :as s]))))
-
-(def deps-from-require-docstring-example
- '#{clojure.zip
- clojure.set})
-
-(deftest t-require-docstring-example
- (is (= deps-from-require-docstring-example
- (deps-from-ns-decl require-docstring-example))))
-
-(def multiple-clauses
- "Example showing more than one :require or :use clause in one ns
- declaration, which clojure.core/ns allows."
- '(ns foo.bar
- (:require com.example.one)
- (:import java.io.File)
- (:require (com.example two three))
- (:use (com.example [four :only [x]]))
- (:use (com.example (five :only [x])))))
-
-(def deps-from-multiple-clauses
- '#{com.example.one
- com.example.two
- com.example.three
- com.example.four
- com.example.five})
-
-(deftest t-deps-from-multiple-clauses
- (is (= deps-from-multiple-clauses
- (deps-from-ns-decl multiple-clauses))))
-
-(def clauses-without-keywords
- "Example of require/use clauses with symbols instead of keywords,
- which clojure.core/ns allows."
- '(ns foo.bar
- (require com.example.one)
- (import java.io.File)
- (use (com.example (prefixes (two :only [x])
- three)))))
-
-(def deps-from-clauses-without-keywords
- '#{com.example.one
- com.example.prefixes.two
- com.example.prefixes.three})
-
-(deftest t-clauses-without-keywords
- (is (= deps-from-clauses-without-keywords
- (deps-from-ns-decl clauses-without-keywords))))
-
-(def reader-conditionals-string
- "(ns com.examples.one
- (:require #?(:clj clojure.string
- :cljs goog.string)))")
-
-(deftest t-reader-conditionals
- ;; TODO: the predicate wasn't added to bb yet, will come in version after 0.6.7
- (when true #_(resolve 'clojure.core/reader-conditional?)
- (let [actual (-> reader-conditionals-string
- java.io.StringReader.
- java.io.PushbackReader.
- clojure.lang.LineNumberingPushbackReader.
- read-ns-decl
- deps-from-ns-decl)]
- (is (= #{'clojure.string} actual)))))
-
-(def ns-with-npm-dependency
- "(ns com.examples.one
- (:require [\"foobar\"] [baz]))")
-
-(deftest npm-dependency
- (let [actual (-> ns-with-npm-dependency
- java.io.StringReader.
- java.io.PushbackReader.
- clojure.lang.LineNumberingPushbackReader.
- read-ns-decl
- deps-from-ns-decl)]
- (is (= #{'baz} actual))))
-
-(def ns-with-require-macros
- "(ns com.examples.one
- (:require-macros [foo :refer [bar]]))")
-
-(deftest require-macros
- (let [actual (-> ns-with-require-macros
- java.io.StringReader.
- java.io.PushbackReader.
- clojure.lang.LineNumberingPushbackReader.
- read-ns-decl
- deps-from-ns-decl)]
- (is (= #{'foo} actual))))
diff --git a/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj b/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj
deleted file mode 100644
index 62679e69..00000000
--- a/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj
+++ /dev/null
@@ -1,82 +0,0 @@
-(ns clojure.tools.namespace.test-helpers
- "Utilities to help with testing files and namespaces."
- (:require [clojure.java.io :as io]
- [clojure.string :as string])
- (:import (java.io Closeable File Writer PrintWriter)))
-
-(defn create-temp-dir
- "Creates and returns a new temporary directory java.io.File."
- [name]
- (let [temp-file (File/createTempFile name nil)]
- (.delete temp-file)
- (.mkdirs temp-file)
- (println "Temporary directory" (.getAbsolutePath temp-file))
- temp-file))
-
-(defn- write-contents
- "Writes contents into writer. Strings are written as-is via println,
- other types written as by prn."
- [^Writer writer contents]
- {:pre [(sequential? contents)]}
- (binding [*out* (PrintWriter. writer)]
- (doseq [content contents]
- (if (string? content)
- (println content)
- (prn content))
- (newline))))
-
-(defn create-file
- "Creates a file from a vector of path elements. Writes contents into
- the file. Elements of contents may be data, written via prn, or
- strings, written directly."
- [path contents]
- {:pre [(vector? path)]}
- (let [^File file (apply io/file path)]
- (when-let [parent (.getParentFile file)]
- (.mkdirs parent))
- (with-open [wtr (io/writer file)]
- (write-contents wtr contents))
- file))
-
-(defn- sym->path
- "Converts a symbol name into a vector of path parts, not including
- file extension."
- [symbol]
- {:pre [(symbol? symbol)]
- :post [(vector? %)]}
- (-> (name symbol)
- (string/replace \- \_)
- (string/split #"\.")))
-
-(defn- source-path
- "Returns a vector of path components for namespace named sym,
- with given file extension (keyword)."
- [sym extension]
- (let [path (sym->path sym)
- basename (peek path)
- filename (str basename \. (name extension))]
- (conj (pop path) filename)))
-
-(defn create-source
- "Creates a file at the correct path under base-dir for a namespace
- named sym, with file extension (keyword), containing a ns
- declaration which :require's the dependencies (symbols). Optional
- contents written after the ns declaration as by write-contents."
- ([base-dir sym extension]
- (create-source base-dir sym extension nil nil))
- ([base-dir sym extension dependencies]
- (create-source base-dir sym extension dependencies nil))
- ([base-dir sym extension dependencies contents]
- (let [full-path (into [base-dir] (source-path sym extension))
- ns-decl (if (seq dependencies)
- (list 'ns sym (list* :require dependencies))
- (list 'ns sym))]
- (create-file full-path (into [ns-decl] contents)))))
-
-(defn same-files?
- "True if files-a and files-b contain the same canonical File's,
- regardless of order."
- [files-a files-b]
- (= (sort (map #(.getCanonicalPath ^File %) files-a))
- (sort (map #(.getCanonicalPath ^File %) files-b))))
-
diff --git a/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj b/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj
deleted file mode 100644
index 1792beae..00000000
--- a/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns cognitect.test-runner.sample-property-test
- (:require [clojure.test.check :as tc]
- [clojure.test.check.generators :as gen]
- [clojure.test.check.properties :as prop]
- [clojure.test.check.clojure-test :refer [defspec]]))
-
-(defspec first-element-is-min-after-sorting 100
- (prop/for-all [v (gen/not-empty (gen/vector gen/int))]
- (= (apply min v)
- (first (sort v)))))
diff --git a/test-resources/lib_tests/cognitect/test_runner/samples_test.clj b/test-resources/lib_tests/cognitect/test_runner/samples_test.clj
deleted file mode 100644
index e4ec385c..00000000
--- a/test-resources/lib_tests/cognitect/test_runner/samples_test.clj
+++ /dev/null
@@ -1,14 +0,0 @@
-(ns cognitect.test-runner.samples-test
- (:require [clojure.test :as t :refer [deftest is testing]]))
-
-(deftest math-works
- (testing "basic addition and subtraction"
- (is (= 42 (+ 40 2)))
- (is (= 42 (- 44 2)))))
-
-(deftest ^:integration test-i
- (is (= 1 1)))
-
-
-
-
diff --git a/test-resources/lib_tests/cognitect/test_runner_test.clj b/test-resources/lib_tests/cognitect/test_runner_test.clj
deleted file mode 100644
index e1ea8deb..00000000
--- a/test-resources/lib_tests/cognitect/test_runner_test.clj
+++ /dev/null
@@ -1,23 +0,0 @@
-(ns cognitect.test-runner-test
- (:require
- [clojure.test :refer :all]
- [cognitect.test-runner :as tr]))
-
-(deftest ns-filters
- (are [ns-names ns-regexes available selected]
- (= selected (filter (#'tr/ns-filter {:namespace ns-names :namespace-regex ns-regexes}) available))
-
- ;; default settings (no -n / -r, use default for -r)
- nil nil nil []
- nil nil '[ns1-test ns2-test] '[ns1-test ns2-test]
- nil nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns1-test ns2-test]
-
- ;; specific namespaces
- '#{ns3} nil '[ns1-test ns2-test] '[]
- '#{ns3 ns4} nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns3 ns4]
-
- ;; regexes
- nil #{#"ns1.*" #"ns3"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3]
-
- ;; both
- '#{ns3} '#{#"ns1.*"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3]))
\ No newline at end of file
diff --git a/test-resources/lib_tests/com/rpl/specter/cljs_test_helpers.clj b/test-resources/lib_tests/com/rpl/specter/cljs_test_helpers.clj
new file mode 100644
index 00000000..4986c823
--- /dev/null
+++ b/test-resources/lib_tests/com/rpl/specter/cljs_test_helpers.clj
@@ -0,0 +1,13 @@
+(ns com.rpl.specter.cljs-test-helpers)
+
+;; it seems like gen/bind and gen/return are a monad (hence the names)
+(defmacro for-all+ [bindings & body]
+ (let [parts (partition 2 bindings)
+ vars (vec (map first parts))
+ genned (reduce
+ (fn [curr [v code]]
+ `(clojure.test.check.generators/bind ~code (fn [~v] ~curr)))
+ `(clojure.test.check.generators/return ~vars)
+ (reverse parts))]
+ `(clojure.test.check.properties/for-all [~vars ~genned]
+ ~@body)))
diff --git a/test-resources/lib_tests/com/rpl/specter/cljs_test_runner.cljs b/test-resources/lib_tests/com/rpl/specter/cljs_test_runner.cljs
new file mode 100644
index 00000000..49c06c26
--- /dev/null
+++ b/test-resources/lib_tests/com/rpl/specter/cljs_test_runner.cljs
@@ -0,0 +1,7 @@
+(ns com.rpl.specter.cljs-test-runner
+ (:require [doo.runner :refer-macros [doo-tests]]
+ [com.rpl.specter.core-test]
+ [com.rpl.specter.zipper-test]))
+
+(doo-tests 'com.rpl.specter.core-test
+ 'com.rpl.specter.zipper-test)
diff --git a/test-resources/lib_tests/com/rpl/specter/core_test.cljc b/test-resources/lib_tests/com/rpl/specter/core_test.cljc
new file mode 100644
index 00000000..1ba123cd
--- /dev/null
+++ b/test-resources/lib_tests/com/rpl/specter/core_test.cljc
@@ -0,0 +1,1704 @@
+(ns com.rpl.specter.core-test
+ #?(:cljs (:require-macros
+ [cljs.test :refer [is deftest]]
+ [clojure.test.check.clojure-test :refer [defspec]]
+ [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
+ [com.rpl.specter.test-helpers :refer [ic-test]]
+ [com.rpl.specter
+ :refer [defprotocolpath defnav extend-protocolpath
+ nav declarepath providepath select select-one select-one!
+ select-first transform setval replace-in
+ select-any selected-any? collected? traverse
+ multi-transform path dynamicnav recursive-path
+ defdynamicnav traverse-all satisfies-protpath? end-fn
+ vtransform]]))
+ (:use
+ #?(:clj [clojure.test :only [deftest is]])
+ #?(:clj [clojure.test.check.clojure-test :only [defspec]])
+ #?(:clj [com.rpl.specter.test-helpers :only [for-all+ ic-test]])
+ #?(:clj [com.rpl.specter
+ :only [defprotocolpath defnav extend-protocolpath
+ nav declarepath providepath select select-one select-one!
+ select-first transform setval replace-in
+ select-any selected-any? collected? traverse
+ multi-transform path dynamicnav recursive-path
+ defdynamicnav traverse-all satisfies-protpath? end-fn
+ vtransform]]))
+
+
+
+ (:require #?(:clj [clojure.test.check.generators :as gen])
+ #?(:clj [clojure.test.check.properties :as prop])
+ #?(:cljs [clojure.test.check :as tc])
+ #?(:cljs [clojure.test.check.generators :as gen])
+ #?(:cljs [clojure.test.check.properties :as prop :include-macros true])
+ [com.rpl.specter :as s]
+ [com.rpl.specter.transients :as t]
+ [clojure.set :as set]))
+
+;;TODO:
+;; test walk, codewalk
+
+(defn limit-size [n {gen :gen}]
+ (gen/->Generator
+ (fn [rnd _size]
+ (gen rnd (if (< _size n) _size n)))))
+
+(defn gen-map-with-keys [key-gen val-gen & keys]
+ (gen/bind (gen/map key-gen val-gen)
+ (fn [m]
+ (gen/bind
+ (apply gen/hash-map (mapcat (fn [k] [k val-gen]) keys))
+ (fn [m2]
+ (gen/return (merge m m2)))))))
+
+(defspec select-all-keyword-filter
+ (for-all+
+ [kw gen/keyword
+ v (gen/vector (limit-size 5
+ (gen-map-with-keys gen/keyword gen/int kw)))
+ pred (gen/elements [odd? even?])]
+ (= (select [s/ALL kw pred] v)
+ (->> v (map kw) (filter pred)))))
+
+
+(defspec select-pos-extreme-pred
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [odd? even?])
+ pos (gen/elements [[s/FIRST first] [s/LAST last]])]
+ (= (select-one [(s/filterer pred) (first pos)] v)
+ (->> v (filter pred) ((last pos))))))
+
+
+(defspec select-all-on-map
+ (for-all+
+ [m (limit-size 5 (gen/map gen/keyword gen/int))
+ p (gen/elements [s/MAP-VALS [s/ALL s/LAST]])]
+ (= (select p m)
+ (for [[k v] m] v))))
+
+
+(deftest select-one-test
+ (is (thrown? #?(:clj Exception :cljs js/Error) (select-one [s/ALL even?] [1 2 3 4])))
+ (is (= 1 (select-one [s/ALL odd?] [2 4 1 6]))))
+
+
+(deftest select-first-test
+ (is (= 7 (select-first [(s/filterer odd?) s/ALL #(> % 4)] [3 4 2 3 7 5 9 8])))
+ (is (nil? (select-first [s/ALL even?] [1 3 5 9]))))
+
+
+(defspec transform-all-on-map
+ (for-all+
+ [m (limit-size 5 (gen/map gen/keyword gen/int))
+ p (gen/elements [s/MAP-VALS [s/ALL s/LAST]])]
+ (= (transform p inc m)
+ (into {} (for [[k v] m] [k (inc v)])))))
+
+
+(defspec transform-all
+ (for-all+
+ [v (gen/vector gen/int)]
+ (let [v2 (transform [s/ALL] inc v)]
+ (and (vector? v2) (= v2 (map inc v))))))
+
+
+(defspec transform-all-list
+ (for-all+
+ [v (gen/list gen/int)]
+ (let [v2 (transform [s/ALL] inc v)]
+ (and (seq? v2) (= v2 (map inc v))))))
+
+
+(defspec transform-all-filter
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [odd? even?])
+ action (gen/elements [inc dec])]
+ (let [v2 (transform [s/ALL pred] action v)]
+ (= v2 (map (fn [v] (if (pred v) (action v) v)) v)))))
+
+
+(defspec transform-last
+ (for-all+
+ [v (gen/not-empty (gen/vector gen/int))
+ pred (gen/elements [inc dec])]
+ (let [v2 (transform [s/LAST] pred v)]
+ (= v2 (concat (butlast v) [(pred (last v))])))))
+
+
+(defspec transform-first
+ (for-all+
+ [v (gen/not-empty (gen/vector gen/int))
+ pred (gen/elements [inc dec])]
+ (let [v2 (transform [s/FIRST] pred v)]
+ (= v2 (concat [(pred (first v))] (rest v))))))
+
+
+(defspec transform-filterer-all-equivalency
+ (prop/for-all
+ [s (gen/vector gen/int)
+ target-type (gen/elements ['() []])
+ pred (gen/elements [even? odd?])
+ updater (gen/elements [inc dec])]
+ (let [v (into target-type s)
+ v2 (transform [(s/filterer pred) s/ALL] updater v)
+ v3 (transform [s/ALL pred] updater v)]
+ (and (= v2 v3) (= (type v2) (type v3))))))
+
+
+(defspec transform-with-context
+ (for-all+
+ [kw1 gen/keyword
+ kw2 gen/keyword
+ m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw1 kw2))
+ pred (gen/elements [odd? even?])]
+ (= (transform [(s/collect-one kw2) kw1 pred] + m)
+ (if (pred (kw1 m))
+ (assoc m kw1 (+ (kw1 m) (kw2 m)))
+ m))))
+
+
+(defn differing-elements [v1 v2]
+ (->> (map vector v1 v2)
+ (map-indexed (fn [i [e1 e2]]
+ (if (not= e1 e2)
+ i)))
+ (filter identity)))
+
+(defspec transform-last-compound
+ (for-all+
+ [pred (gen/elements [odd? even?])
+ v (gen/such-that #(some pred %) (gen/vector gen/int))]
+ (let [v2 (transform [(s/filterer pred) s/LAST] inc v)
+ differing-elems (differing-elements v v2)]
+ (and (= (count v2) (count v))
+ (= (count differing-elems) 1)
+ (every? (complement pred) (drop (first differing-elems) v2))))))
+
+
+;; max sizes prevent too much data from being generated and keeps test from taking forever
+(defspec transform-keyword
+ (for-all+
+ [k1 (limit-size 3 gen/keyword)
+ k2 (limit-size 3 gen/keyword)
+ m1 (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ (gen-map-with-keys gen/keyword gen/int k2)
+ k1))
+ pred (gen/elements [inc dec])]
+ (let [m2 (transform [k1 k2] pred m1)]
+ (and (= (assoc-in m1 [k1 k2] nil) (assoc-in m2 [k1 k2] nil))
+ (= (pred (get-in m1 [k1 k2])) (get-in m2 [k1 k2]))))))
+
+
+(defspec replace-in-test
+ (for-all+
+ [v (gen/vector gen/int)]
+ (let [res (->> v (map (fn [v] (if (even? v) (inc v) v))))
+ user-ret (->> v
+ (filter even?)
+ (map (fn [v] [v v]))
+ (apply concat))
+ user-ret (if (empty? user-ret) nil user-ret)]
+ (= (replace-in [s/ALL even?] (fn [v] [(inc v) [v v]]) v)
+ [res user-ret]))))
+
+
+(defspec replace-in-custom-merge
+ (for-all+
+ [v (gen/vector gen/int)]
+ (let [res (->> v (map (fn [v] (if (even? v) (inc v) v))))
+ last-even (->> v (filter even?) last)
+ user-ret (if last-even {:a last-even})]
+ (= (replace-in [s/ALL even?] (fn [v] [(inc v) v]) v :merge-fn (fn [curr new]
+ (assoc curr :a new)))
+ [res user-ret]))))
+
+
+(defspec srange-extremes-test
+ (for-all+
+ [v (gen/vector gen/int)
+ v2 (gen/vector gen/int)]
+ (let [b (setval s/BEGINNING v2 v)
+ e (setval s/END v2 v)]
+ (and (= b (concat v2 v))
+ (= e (concat v v2))))))
+
+
+(defspec srange-test
+ (for-all+
+ [v (gen/vector gen/int)
+ b (gen/elements (-> v count inc range))
+ e (gen/elements (range b (-> v count inc)))]
+
+ (let [sv (subvec v b e)
+ predcount (fn [pred v] (->> v (filter pred) count))
+ even-count (partial predcount even?)
+ odd-count (partial predcount odd?)
+ b (transform (s/srange b e) (fn [r] (filter odd? r)) v)]
+ (and (= (odd-count v) (odd-count b))
+ (= (+ (even-count b) (even-count sv))
+ (even-count v))))))
+
+
+(deftest structure-path-directly-test
+ (is (= 3 (select-one :b {:a 1 :b 3})))
+ (is (= 5 (select-one (s/comp-paths :a :b) {:a {:b 5}}))))
+
+
+(deftest atom-test
+ (let [v (transform s/ATOM inc (atom 1))]
+ (is (instance? #?(:clj clojure.lang.Atom :cljs cljs.core/Atom) v))
+ (is (= 2 (select-one s/ATOM v) @v))))
+
+(defspec view-test
+ (for-all+
+ [i gen/int
+ afn (gen/elements [inc dec])]
+ (= (first (select (s/view afn) i))
+ (afn i)
+ (transform (s/view afn) identity i))))
+
+
+(defspec must-test
+ (for-all+
+ [k1 gen/int
+ k2 (gen/such-that #(not= k1 %) gen/int)
+ m (gen-map-with-keys gen/int gen/int k1)
+ op (gen/elements [inc dec])]
+
+ (let [m (dissoc m k2)]
+ (and (= (transform (s/must k1) op m)
+ (transform (s/keypath k1) op m))
+ (= (transform (s/must k2) op m) m)
+ (= (select (s/must k1) m) (select (s/keypath k1) m))
+ (empty? (select (s/must k2) m))))))
+
+
+(defspec parser-test
+ (for-all+
+ [i gen/int
+ afn (gen/elements [inc dec #(* % 2)])
+ bfn (gen/elements [inc dec #(* % 2)])
+ cfn (gen/elements [inc dec #(* % 2)])]
+ (and (= (select-one! (s/parser afn bfn) i)
+ (afn i))
+ (= (transform (s/parser afn bfn) cfn i)
+ (-> i afn cfn bfn)))))
+
+
+(deftest selected?-test
+ (is (= [[1 3 5] [2 :a] [7 11 4 2 :a] [10 1 :a] []]
+ (setval [s/ALL (s/selected? s/ALL even?) s/END]
+ [:a]
+ [[1 3 5] [2] [7 11 4 2] [10 1] []])))
+
+ (is (= [2 4] (select [s/ALL (s/selected? even?)] [1 2 3 4])))
+ (is (= [1 3] (select [s/ALL (s/not-selected? even?)] [1 2 3 4]))))
+
+
+(defspec identity-test
+ (for-all+
+ [i gen/int
+ afn (gen/elements [inc dec])]
+ (and (= [i] (select nil i))
+ (= (afn i) (transform nil afn i)))))
+
+(deftest nil-comp-test
+ (is (= [5] (select (com.rpl.specter.impl/comp-paths* nil) 5))))
+
+(defspec putval-test
+ (for-all+
+ [kw gen/keyword
+ m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw))
+ c gen/int]
+ (= (transform [(s/putval c) kw] + m)
+ (transform [kw (s/putval c)] + m)
+ (assoc m kw (+ c (get m kw))))))
+
+
+(defspec empty-selector-test
+ (for-all+
+ [v (gen/vector gen/int)]
+ (= [v]
+ (select [] v)
+ (select nil v)
+ (select (s/comp-paths) v)
+ (select (s/comp-paths nil) v)
+ (select [nil nil nil] v))))
+
+
+(defspec empty-selector-transform-test
+ (for-all+
+ [kw gen/keyword
+ m (limit-size 10 (gen-map-with-keys gen/keyword gen/int kw))]
+ (and (= m
+ (transform nil identity m)
+ (transform [] identity m)
+ (transform (s/comp-paths []) identity m)
+ (transform (s/comp-paths nil nil) identity m))
+
+ (= (transform kw inc m)
+ (transform [nil kw] inc m)
+ (transform (s/comp-paths kw nil) inc m)
+ (transform (s/comp-paths nil kw nil) inc m)))))
+
+
+(deftest compose-empty-comp-path-test
+ (let [m {:a 1}]
+ (is (= [1]
+ (select [:a (s/comp-paths)] m)
+ (select [(s/comp-paths) :a] m)))))
+
+
+(defspec mixed-selector-test
+ (for-all+
+ [k1 (limit-size 3 gen/keyword)
+ k2 (limit-size 3 gen/keyword)
+ m (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ (gen-map-with-keys gen/keyword gen/int k2)
+ k1))]
+ (= [(-> m k1 k2)]
+ (select [k1 (s/comp-paths k2)] m)
+ (select [(s/comp-paths k1) k2] m)
+ (select [(s/comp-paths k1 k2) nil] m)
+ (select [(s/comp-paths) k1 k2] m)
+ (select [k1 (s/comp-paths) k2] m))))
+
+
+(deftest cond-path-test
+ (is (= [4 2 6 8 10]
+ (select [s/ALL (s/cond-path even? [(s/view inc) (s/view inc)]
+ #(= 3 %) (s/view dec))]
+ [1 2 3 4 5 6 7 8])))
+ (is (empty? (select (s/if-path odd? (s/view inc)) 2)))
+ (is (= [6 2 10 6 14]
+ (transform [(s/putval 2)
+ s/ALL
+ (s/if-path odd? [(s/view inc) (s/view inc)] (s/view dec))]
+ *
+ [1 2 3 4 5])))
+
+ (is (= 2
+ (transform [(s/putval 2)
+ (s/if-path odd? (s/view inc))]
+ *
+ 2))))
+
+
+(defspec cond-path-selector-test
+ (for-all+
+ [k1 (limit-size 3 gen/keyword)
+ k2 (limit-size 3 gen/keyword)
+ k3 (limit-size 3 gen/keyword)
+ m (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ gen/int
+ k1
+ k2
+ k3))
+ pred (gen/elements [odd? even?])]
+
+ (let [v1 (get m k1)
+ k (if (pred v1) k2 k3)]
+ (and
+ (= (transform (s/if-path [k1 pred] k2 k3) inc m)
+ (transform k inc m))
+ (= (select (s/if-path [k1 pred] k2 k3) m)
+ (select k m))))))
+
+
+(deftest optimized-if-path-test
+ (is (= [-4 -2] (select [s/ALL (s/if-path [even? neg?] s/STAY)]
+ [1 2 -3 -4 0 -2])))
+ (is (= [1 2 -3 4 0 2] (transform [s/ALL (s/if-path [even? neg?] s/STAY)]
+ -
+ [1 2 -3 -4 0 -2]))))
+
+
+(defspec multi-path-test
+ (for-all+
+ [k1 (limit-size 3 gen/keyword)
+ k2 (limit-size 3 gen/keyword)
+ m (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ gen/int
+ k1
+ k2))]
+
+ (= (transform (s/multi-path k1 k2) inc m)
+ (->> m
+ (transform k1 inc)
+ (transform k2 inc)))))
+
+
+(deftest empty-pos-transform
+ (is (empty? (select s/FIRST [])))
+ (is (empty? (select s/LAST [])))
+ (is (= [] (transform s/FIRST inc [])))
+ (is (= [] (transform s/LAST inc []))))
+
+
+(defspec set-filter-test
+ (for-all+
+ [k1 gen/keyword
+ k2 (gen/such-that #(not= k1 %) gen/keyword)
+ k3 (gen/such-that (complement #{k1 k2}) gen/keyword)
+ v (gen/vector (gen/elements [k1 k2 k3]))]
+ (= (filter #{k1 k2} v) (select [s/ALL #{k1 k2}] v))))
+
+
+(deftest nil-select-one-test
+ (is (= nil (select-one! s/ALL [nil])))
+ (is (thrown? #?(:clj Exception :cljs js/Error) (select-one! s/ALL []))))
+
+
+
+(defspec transformed-test
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [even? odd?])
+ op (gen/elements [inc dec])]
+ (= (select-one (s/transformed [s/ALL pred] op) v)
+ (transform [s/ALL pred] op v))))
+
+
+(defspec basic-parameterized-composition-test
+ (for-all+
+ [k1 (limit-size 3 gen/keyword)
+ k2 (limit-size 3 gen/keyword)
+ m1 (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ (gen-map-with-keys gen/keyword gen/int k2)
+ k1))
+ pred (gen/elements [inc dec])]
+ (let [p (dynamicnav [a b] (path (s/keypath a) (s/keypath b)))]
+ (and
+ (= (s/compiled-select (p k1 k2) m1) (select [k1 k2] m1))
+ (= (s/compiled-transform (p k1 k2) pred m1) (transform [k1 k2] pred m1))))))
+
+
+(defspec filterer-param-test
+ (for-all+
+ [k gen/keyword
+ k2 gen/keyword
+ v (gen/vector
+ (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ gen/int
+ k
+ k2)))
+
+ pred (gen/elements [odd? even?])
+ updater (gen/elements [inc dec])]
+ (and
+ (= (select (s/filterer (s/keypath k) pred) v)
+ (select (s/filterer k pred) v))
+ (= (transform [(s/filterer (s/keypath k) pred) s/ALL k2]
+ updater
+ v)
+ (transform [(s/filterer k pred) s/ALL k2]
+ updater
+ v)))))
+
+
+(deftest nested-param-paths
+ (let [p (fn [a b c]
+ (path
+ (s/filterer (s/keypath a)
+ (s/selected? s/ALL
+ (s/keypath b)
+ (s/filterer (s/keypath c) even?)
+ s/ALL))))
+ p2 (p :a :b :c)
+ p3 (s/filterer :a (s/selected? s/ALL :b (s/filterer :c even?) s/ALL))
+ data [{:a [{:b [{:c 4 :d 5}]}]}
+ {:a [{:c 3}]}
+ {:a [{:b [{:c 7}] :e [1]}]}]]
+
+ (is (= (select p2 data)
+ (select p3 data)
+ [[{:a [{:b [{:c 4 :d 5}]}]}]]))))
+
+
+
+(defspec subselect-nested-vectors
+ (for-all+
+ [v1 (gen/vector
+ (gen/vector gen/int))]
+ (let [path (s/comp-paths (s/subselect s/ALL s/ALL))
+ v2 (s/compiled-transform path reverse v1)]
+ (and
+ (= (s/compiled-select path v1) [(flatten v1)])
+ (= (flatten v1) (reverse (flatten v2)))
+ (= (map count v1) (map count v2))))))
+
+(defspec subselect-param-test
+ (for-all+
+ [k gen/keyword
+ v (gen/vector
+ (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ gen/int
+ k)))]
+ (and
+ (= (s/compiled-select (s/subselect s/ALL (s/keypath k)) v)
+ [(map k v)])
+ (let [v2 (s/compiled-transform (s/comp-paths (s/subselect s/ALL (s/keypath k)))
+ reverse
+ v)]
+ (and (= (map k v) (reverse (map k v2)))
+ (= (map #(dissoc % k) v)
+ (map #(dissoc % k) v2))))))) ; only key k was touched in any of the maps
+
+
+(defspec param-multi-path-test
+ (for-all+
+ [k1 gen/keyword
+ k2 gen/keyword
+ k3 gen/keyword
+ m (limit-size 5
+ (gen-map-with-keys
+ gen/keyword
+ gen/int
+ k1
+ k2
+ k3))
+
+ pred1 (gen/elements [odd? even?])
+ pred2 (gen/elements [odd? even?])
+ updater (gen/elements [inc dec])]
+
+ (let [paths [(path (s/multi-path [(s/keypath k1) pred1] [(s/keypath k2) pred2] k3))
+ (path (s/multi-path [k1 pred1] [(s/keypath k2) pred2] (s/keypath k3)))
+ (path (s/multi-path [(s/keypath k1) pred1] [(s/keypath k2) pred2] (s/keypath k3)))
+ (s/multi-path [k1 pred1] [k2 pred2] k3)
+ (path (s/multi-path [k1 pred1] [(s/keypath k2) pred2] k3))]]
+
+ (and
+ (apply =
+ (for [p paths]
+ (select p m)))
+
+ (apply =
+ (for [p paths]
+ (transform p updater m)))))))
+
+
+(defspec subset-test
+ (for-all+
+ [s1 (gen/vector (limit-size 5 gen/keyword))
+ s2 (gen/vector (limit-size 5 gen/keyword))
+ s3 (gen/vector (limit-size 5 gen/int))
+ s4 (gen/vector (limit-size 5 gen/keyword))]
+ (let [s1 (set s1)
+ s2 (set s1)
+ s3 (set s1)
+ s4 (set s1)
+ combined (set/union s1 s2)
+ ss (set/union s2 s3)]
+ (and
+ (= (transform (s/subset s3) identity combined) combined)
+ (= (setval (s/subset s3) #{} combined) (set/difference combined s2))
+ (= (setval (s/subset s3) s4 combined) (-> combined (set/difference s2) (set/union s4)))))))
+
+
+(deftest submap-test
+ (is (= [{:foo 1}]
+ (select [(s/submap [:foo :baz])] {:foo 1 :bar 2})))
+ (is (= {:foo 1, :barry 1}
+ (setval [(s/submap [:bar])] {:barry 1} {:foo 1 :bar 2})))
+ (is (= {:bar 1, :foo 2}
+ (transform [(s/submap [:foo :baz]) s/ALL s/LAST] inc {:foo 1 :bar 1})))
+ (is (= {:a {:new 1}
+ :c {:new 1
+ :old 1}}
+ (setval [s/ALL s/LAST (s/submap [])] {:new 1} {:a nil, :c {:old 1}}))))
+
+(deftest nil->val-test
+ (is (= {:a #{:b}}
+ (setval [:a s/NIL->SET (s/subset #{})] #{:b} nil)))
+ (is (= {:a #{:b :c :d}}
+ (setval [:a s/NIL->SET (s/subset #{})] #{:b} {:a #{:c :d}})))
+ (is (= {:a [:b]}
+ (setval [:a s/NIL->VECTOR s/END] [:b] nil))))
+
+
+(defspec void-test
+ (for-all+
+ [s1 (gen/vector (limit-size 5 gen/int))]
+ (and
+ (empty? (select s/STOP s1))
+ (empty? (select [s/STOP s/ALL s/ALL s/ALL s/ALL] s1))
+ (= s1 (transform s/STOP inc s1))
+ (= s1 (transform [s/ALL s/STOP s/ALL] inc s1))
+ (= (transform [s/ALL (s/cond-path even? nil odd? s/STOP)] inc s1)
+ (transform [s/ALL even?] inc s1)))))
+
+
+(deftest stay-continue-tests
+ (is (= [[1 2 [:a :b]] [3 [:a :b]] [:a :b [:a :b]]]
+ (setval [(s/stay-then-continue s/ALL) s/END] [[:a :b]] [[1 2] [3]])))
+ (is (= [[1 2 [:a :b]] [3 [:a :b]] [:a :b]]
+ (setval [(s/continue-then-stay s/ALL) s/END] [[:a :b]] [[1 2] [3]])))
+ (is (= [[1 2 3] 1 3]
+ (select (s/stay-then-continue s/ALL odd?) [1 2 3])))
+ (is (= [1 3 [1 2 3]]
+ (select (s/continue-then-stay s/ALL odd?) [1 2 3]))))
+
+
+
+(declarepath MyWalker)
+
+(providepath MyWalker
+ (s/if-path vector?
+ (s/if-path [s/FIRST #(= :abc %)]
+ (s/continue-then-stay s/ALL MyWalker)
+ [s/ALL MyWalker])))
+
+
+(deftest recursive-path-test
+ (is (= [9 1 10 3 1]
+ (select [MyWalker s/ALL number?]
+ [:bb [:aa 34 [:abc 10 [:ccc 9 8 [:abc 9 1]]]] [:abc 1 [:abc 3]]])))
+
+ (is (= [:bb [:aa 34 [:abc 11 [:ccc 9 8 [:abc 10 2]]]] [:abc 2 [:abc 4]]]
+ (transform [MyWalker s/ALL number?] inc
+ [:bb [:aa 34 [:abc 10 [:ccc 9 8 [:abc 9 1]]]] [:abc 1 [:abc 3]]]))))
+
+
+(def map-key-walker
+ (recursive-path [akey] p
+ [s/ALL
+ (s/if-path [s/FIRST #(= % akey)]
+ s/LAST
+ [s/LAST p])]))
+
+(deftest recursive-params-path-test
+ (is (= #{1 2 3} (set (select (map-key-walker :aaa)
+ {:a {:aaa 3 :b {:c {:aaa 2} :aaa 1}}}))))
+ (is (= {:a {:aaa 4 :b {:c {:aaa 3} :aaa 2}}}
+ (transform (map-key-walker :aaa) inc
+ {:a {:aaa 3 :b {:c {:aaa 2} :aaa 1}}})))
+ (is (= {:a {:c {:b "X"}}}
+ (setval (map-key-walker :b) "X" {:a {:c {:b {:d 1}}}}))))
+
+
+(deftest recursive-params-composable-path-test
+ (let [p (fn [k k2] (path (s/keypath k) (map-key-walker k2)))]
+ (is (= [1] (select (p 1 :a) [{:a 3} {:a 1} {:a 2}])))))
+
+
+(deftest all-map-test
+ (is (= {3 3} (transform [s/ALL s/FIRST] inc {2 3})))
+ (is (= {3 21 4 31} (transform [s/ALL s/ALL] inc {2 20 3 30}))))
+
+
+
+(def NestedHigherOrderWalker
+ (recursive-path [k] p
+ (s/if-path vector?
+ (s/if-path [s/FIRST #(= % k)]
+ (s/continue-then-stay s/ALL p)
+ [s/ALL p]))))
+
+
+(deftest nested-higher-order-walker-test
+ (is (= [:q [:abc :I 3] [:ccc [:abc :I] [:abc :I "a" [:abc :I [:abc :I [:d]]]]]]
+ (setval [(NestedHigherOrderWalker :abc) (s/srange 1 1)]
+ [:I]
+ [:q [:abc 3] [:ccc [:abc] [:abc "a" [:abc [:abc [:d]]]]]]))))
+
+
+#?(:clj
+ (deftest large-params-test
+ (let [path (apply com.rpl.specter.impl/comp-navs (for [i (range 25)] (s/keypath i)))
+ m (reduce
+ (fn [m k]
+ {k m})
+ :a
+ (reverse (range 25)))]
+ (is (= :a (select-one path m))))))
+
+;;TODO: there's a bug in clojurescript that won't allow
+;; non function implementations of IFn to have more than 20 arguments
+
+#?(:clj
+ (do
+ (defprotocolpath AccountPath [])
+ (defrecord Account [funds])
+ (defrecord User [account])
+ (defrecord Family [accounts])
+ (extend-protocolpath AccountPath User :account Family [:accounts s/ALL])))
+
+
+#?(:clj
+ (deftest protocolpath-basic-test
+ (let [data [(->User (->Account 30))
+ (->User (->Account 50))
+ (->Family [(->Account 51) (->Account 52)])]]
+ (is (= [30 50 51 52]
+ (select [s/ALL AccountPath :funds] data)))
+ (is (= [(->User (->Account 31))
+ (->User (->Account 51))
+ (->Family [(->Account 52) (->Account 53)])]
+ (transform [s/ALL AccountPath :funds]
+ inc
+ data))))))
+
+
+#?(:clj
+ (do
+ (defprotocolpath LabeledAccountPath [label])
+ (defrecord LabeledUser [account])
+ (defrecord LabeledFamily [accounts])
+ (extend-protocolpath LabeledAccountPath
+ LabeledUser [:account (s/keypath label)]
+ LabeledFamily [:accounts (s/keypath label) s/ALL])))
+
+
+#?(:clj
+ (deftest protocolpath-params-test
+ (let [data [(->LabeledUser {:a (->Account 30)})
+ (->LabeledUser {:a (->Account 50)})
+ (->LabeledFamily {:a [(->Account 51) (->Account 52)]})]]
+ (is (= [30 50 51 52]
+ (select [s/ALL (LabeledAccountPath :a) :funds] data)))
+ (is (= [(->LabeledUser {:a (->Account 31)})
+ (->LabeledUser {:a (->Account 51)})
+ (->LabeledFamily {:a [(->Account 52) (->Account 53)]})]
+ (transform [s/ALL (LabeledAccountPath :a) :funds]
+ inc
+ data))))))
+
+
+
+#?(:clj
+ (do
+ (defprotocolpath CustomWalker [])
+ (extend-protocolpath CustomWalker
+ Object nil
+ clojure.lang.PersistentHashMap [(s/keypath :a) CustomWalker]
+ clojure.lang.PersistentArrayMap [(s/keypath :a) CustomWalker]
+ clojure.lang.PersistentVector [s/ALL CustomWalker])))
+
+
+#?(:clj
+ (deftest mixed-rich-regular-protocolpath
+ (is (= [1 2 3 11 21 22 25]
+ (select [CustomWalker number?] [{:a [1 2 :c [3]]} [[[[[[11]]] 21 [22 :c 25]]]]])))
+ (is (= [2 3 [[[4]] :b 0] {:a 4 :b 10}]
+ (transform [CustomWalker number?] inc [1 2 [[[3]] :b -1] {:a 3 :b 10}])))))
+
+
+
+#?(
+ :clj
+ (defn make-queue [coll]
+ (reduce
+ #(conj %1 %2)
+ clojure.lang.PersistentQueue/EMPTY
+ coll))
+
+ :cljs
+ (defn make-queue [coll]
+ (reduce
+ #(conj %1 %2)
+ #queue []
+ coll)))
+
+
+(defspec transform-idempotency 50
+ (for-all+
+ [v1 (gen/vector gen/int)
+ l1 (gen/list gen/int)
+ m1 (gen/map gen/keyword gen/int)]
+ (let [s1 (set v1)
+ q1 (make-queue v1)
+ v2 (transform s/ALL identity v1)
+ m2 (transform s/ALL identity m1)
+ s2 (transform s/ALL identity s1)
+ l2 (transform s/ALL identity l1)
+ q2 (transform s/ALL identity q1)]
+ (and
+ (= v1 v2)
+ (= (type v1) (type v2))
+ (= m1 m2)
+ (= (type m1) (type m2))
+ (= s1 s2)
+ (= (type s1) (type s2))
+ (= l1 l2)
+ (seq? l2) ; Transformed lists are only guaranteed to impelment ISeq
+ (= q1 q2)
+ (= (type q1) (type q2))))))
+
+(defn ^:direct-nav double-str-keypath [s1 s2]
+ (path (s/keypath (str s1 s2))))
+
+(defn ^:direct-nav some-keypath
+ ([] (s/keypath "a"))
+ ([k1] (s/keypath (str k1 "!")))
+ ([k & args] (s/keypath "bbb")))
+
+(deftest nav-constructor-test
+ ;; this also tests that the eval done by clj platform during inline
+ ;; caching rebinds to the correct namespace since this is run
+ ;; by clojure.test in a different namespace
+ (is (= 1 (select-one! (double-str-keypath "a" "b") {"ab" 1 "c" 2})))
+ (is (= 1 (select-one! (some-keypath) {"a" 1 "a!" 2 "bbb" 3 "d" 4})))
+ (is (= 2 (select-one! (some-keypath "a") {"a" 1 "a!" 2 "bbb" 3 "d" 4})))
+ (is (= 3 (select-one! (some-keypath 1 2 3 4 5) {"a" 1 "a!" 2 "bbb" 3 "d" 4}))))
+
+
+(def ^:dynamic *APATH* s/keypath)
+
+(deftest inline-caching-test
+ (ic-test
+ [k]
+ [s/ALL (s/must k)]
+ inc
+ [{:a 1} {:b 2 :c 3} {:a 7 :d -1}]
+ [[:a] [:b] [:c] [:d] [:e]])
+ (ic-test
+ []
+ [s/ALL #{4 5 11} #(> % 2) (fn [e] (< e 7))]
+ inc
+ (range 20)
+ [])
+ (ic-test
+ [v]
+ (if v :a :b)
+ inc
+ {:a 1 :b 2}
+ [[true] [false]])
+ (ic-test
+ [v]
+ [s/ALL (double-str-keypath v (inc v))]
+ str
+ [{"12" :a "1011" :b} {"1011" :c}]
+ [[1] [10]])
+ (ic-test
+ [k]
+ (*APATH* k)
+ str
+ {:a 1 :b 2}
+ [[:a] [:b] [:c]])
+
+ (binding [*APATH* s/must]
+ (ic-test
+ [k]
+ (*APATH* k)
+ inc
+ {:a 1 :b 2}
+ [[:a] [:b] [:c]]))
+
+ (ic-test
+ [k k2]
+ [s/ALL (s/selected? (s/must k) #(> % 2)) (s/must k2)]
+ dec
+ [{:a 1 :b 2} {:a 10 :b 6} {:c 7 :b 8} {:c 1 :d 9} {:c 3 :d -1}]
+ [[:a :b] [:b :a] [:c :d] [:b :c]])
+
+ (ic-test
+ []
+ [(s/transformed s/STAY inc)]
+ inc
+ 10
+ [])
+
+
+ ;; verifying that these don't throw errors
+ (is (= 1 (select-any (if true :a :b) {:a 1})))
+ (is (= 3 (select-any (*APATH* :a) {:a 3})))
+ (is (= 2 (select-any [:a (identity even?)] {:a 2})))
+
+ (is (= [10 11] (select-one! [(s/putval 10) (s/transformed s/STAY #(inc %))] 10)))
+
+ (is (= 2 (let [p :a] (select-one! [p even?] {:a 2}))))
+
+ (is (= [{:a 2}] (let [p :a] (select [s/ALL (s/selected? p even?)] [{:a 2}])))))
+
+
+
+(deftest nested-inline-caching-test
+ (is (= [[1]]
+ (let [a :b]
+ (select
+ (s/view
+ (fn [v]
+ (select [(s/keypath v) (s/keypath a)]
+ {:a {:b 1}})))
+ :a)))))
+
+
+
+(defspec continuous-subseqs-filter-equivalence
+ (for-all+
+ [aseq (gen/vector (gen/elements [1 2 3 :a :b :c 4 5 :d :e]))
+ pred (gen/elements [keyword? number?])]
+ (= (setval (s/continuous-subseqs pred) nil aseq)
+ (filter (complement pred) aseq))))
+
+
+(deftest continuous-subseqs-test
+ (is (= [1 "ab" 2 3 "c" 4 "def"]
+ (transform
+ (s/continuous-subseqs string?)
+ (fn [s] [(apply str s)])
+ [1 "a" "b" 2 3 "c" 4 "d" "e" "f"])))
+
+ (is (= [[] [2] [4 6]]
+ (select
+ [(s/continuous-subseqs number?) (s/filterer even?)]
+ [1 "a" "b" 2 3 "c" 4 5 6 "d" "e" "f"]))))
+
+
+
+;; verifies that late binding of dynamic parameters works correctly
+(deftest transformed-inline-caching
+ (dotimes [i 10]
+ (is (= [(inc i)] (select (s/transformed s/STAY #(+ % i)) 1)))))
+
+
+;; test for issue #103
+(deftest nil->val-regression-test
+ (is (= false (transform (s/nil->val true) identity false)))
+ (is (= false (select-one! (s/nil->val true) false))))
+
+
+#?(:clj
+ (deftest all-map-entry
+ (let [e (transform s/ALL inc (first {1 3}))]
+ (is (instance? clojure.lang.MapEntry e))
+ (is (= 2 (key e)))
+ (is (= 4 (val e))))))
+
+
+(deftest select-on-empty-vector
+ (is (= s/NONE (select-any s/ALL [])))
+ (is (nil? (select-first s/ALL [])))
+ (is (nil? (select-one s/ALL [])))
+ (is (= s/NONE (select-any s/FIRST [])))
+ (is (= s/NONE (select-any s/LAST [])))
+ (is (nil? (select-first s/FIRST [])))
+ (is (nil? (select-one s/FIRST [])))
+ (is (nil? (select-first s/LAST [])))
+ (is (nil? (select-one s/LAST []))))
+
+
+(defspec select-first-one-any-equivalency
+ (for-all+
+ [aval gen/int
+ apred (gen/elements [even? odd?])]
+ (let [data [aval]
+ r1 (select-any [s/ALL (s/pred apred)] data)
+ r2 (select-first [s/ALL (s/pred apred)] data)
+ r3 (select-one [s/ALL (s/pred apred)] data)
+ r4 (first (select [s/ALL (s/pred apred)] data))
+ r5 (select-any [s/FIRST (s/pred apred)] data)
+ r6 (select-any [s/LAST (s/pred apred)] data)]
+
+ (or (and (= r1 s/NONE) (nil? r2) (nil? r3) (nil? r4)
+ (= r5 s/NONE) (= r6 s/NONE))
+ (and (not= r1 s/NONE) (some? r1) (= r1 r2 r3 r4 r5 r6))))))
+
+
+(deftest select-any-static-fn
+ (is (= 2 (select-any even? 2)))
+ (is (= s/NONE (select-any odd? 2))))
+
+
+(deftest select-any-keywords
+ (is (= s/NONE (select-any [:a even?] {:a 1})))
+ (is (= 2 (select-any [:a even?] {:a 2})))
+ (is (= s/NONE (select-any [(s/keypath "a") even?] {"a" 1})))
+ (is (= 2 (select-any [(s/keypath "a") even?] {"a" 2})))
+ (is (= s/NONE (select-any (s/must :b) {:a 1 :c 3})))
+ (is (= 2 (select-any (s/must :b) {:a 1 :b 2 :c 3})))
+ (is (= s/NONE (select-any [(s/must :b) odd?] {:a 1 :b 2 :c 3}))))
+
+
+(defspec select-any-ALL
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [even? odd?])]
+ (let [r1 (select [s/ALL pred] v)
+ r2 (select-any [s/ALL pred] v)]
+ (or (and (empty? r1) (= s/NONE r2))
+ (contains? (set r1) r2)))))
+
+
+(deftest select-any-beginning-end
+ (is (= [] (select-any s/BEGINNING [1 2 3]) (select-any s/END [1])))
+ (is (= s/NONE (select-any [s/BEGINNING s/STOP] [1 2 3]) (select-any [s/END s/STOP] [2 3]))))
+
+
+(deftest select-any-walker
+ (let [data [1 [2 3 4] [[6]]]]
+ (is (= s/NONE (select-any (s/walker keyword?) data)))
+ (is (= s/NONE (select-any [(s/walker number?) neg?] data)))
+ (is (#{1 3} (select-any [(s/walker number?) odd?] data)))
+ (is (#{2 4 6} (select-any [(s/walker number?) even?] data)))))
+
+
+(defspec selected-any?-select-equivalence
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [even? odd?])]
+ (let [r1 (not (empty? (select [s/ALL pred] v)))
+ r2 (selected-any? [s/ALL pred] v)]
+ (= r1 r2))))
+
+
+(defn div-by-3? [v]
+ (= 0 (mod v 3)))
+
+(defspec selected?-filter-equivalence
+ (for-all+
+ [v (gen/vector gen/int)
+ pred (gen/elements [even? odd?])]
+ (and
+ (= (select-any [s/ALL pred] v)
+ (select-any [s/ALL (s/selected? pred)] v))
+
+ (= (select-any [s/ALL pred div-by-3?] v)
+ (select-any [s/ALL (s/selected? pred) div-by-3?] v)))))
+
+
+
+(deftest multi-path-select-any-test
+ (is (= s/NONE (select-any (s/multi-path s/STOP s/STOP) 1)))
+ (is (= 1 (select-any (s/multi-path s/STAY s/STOP) 1)
+ (select-any (s/multi-path s/STOP s/STAY) 1)
+ (select-any (s/multi-path s/STOP s/STAY s/STOP) 1)))
+
+ (is (= s/NONE (select-any [(s/multi-path s/STOP s/STAY) even?] 1))))
+
+
+(deftest if-path-select-any-test
+ (is (= s/NONE (select-any (s/if-path even? s/STAY) 1)))
+ (is (= 2 (select-any (s/if-path even? s/STAY s/STAY) 2)))
+ (is (= s/NONE (select-any [(s/if-path even? s/STAY s/STAY) odd?] 2)))
+ (is (= 2 (select-any (s/if-path odd? s/STOP s/STAY) 2)))
+ (is (= s/NONE (select-any [(s/if-path odd? s/STOP s/STAY) odd?] 2))))
+
+
+(defspec transient-vector-test
+ (for-all+
+ [v (gen/vector (limit-size 5 gen/int))]
+ (every? identity
+ (for [[path transient-path f]
+ [[s/FIRST t/FIRST! (fnil inc 0)] ;; fnil in case vector is empty
+ [s/LAST t/LAST! (fnil inc 0)]
+ [(s/keypath 0) (t/keypath! 0) (fnil inc 0)]
+ [s/END t/END! #(conj % 1 2 3)]]]
+ (and (= (s/transform* path f v)
+ (persistent! (s/transform* transient-path f (transient v))))
+ (= (s/select* path v)
+ (s/select* transient-path (transient v))))))))
+
+(defspec transient-map-test
+ (for-all+
+ [m (limit-size 5 (gen/not-empty (gen/map gen/keyword gen/int)))
+ new-key gen/keyword]
+ (let [existing-key (first (keys m))]
+ (every? identity
+ (for [[path transient-path f]
+ [[(s/keypath existing-key) (t/keypath! existing-key) inc]
+ [(s/keypath new-key) (t/keypath! new-key) (constantly 3)]
+ [(s/submap [existing-key new-key])
+ (t/submap! [existing-key new-key])
+ (constantly {new-key 1234})]]]
+ (and (= (s/transform* path f m)
+ (persistent! (s/transform* transient-path f (transient m))))
+ (= (s/select* path m)
+ (s/select* transient-path (transient m)))))))))
+
+(defspec meta-test
+ (for-all+
+ [v (gen/vector gen/int)
+ meta-map (limit-size 5 (gen/map gen/keyword gen/int))]
+ (= meta-map
+ (meta (setval s/META meta-map v))
+ (first (select s/META (with-meta v meta-map)))
+ (first (select s/META (setval s/META meta-map v))))))
+
+
+(deftest beginning-end-all-first-last-on-nil
+ (is (= [2 3] (setval s/END [2 3] nil) (setval s/BEGINNING [2 3] nil)))
+ (is (nil? (setval s/FIRST :a nil)))
+ (is (nil? (setval s/LAST :a nil)))
+ (is (nil? (transform s/ALL inc nil)))
+ (is (empty? (select s/FIRST nil)))
+ (is (empty? (select s/LAST nil)))
+ (is (empty? (select s/ALL nil))))
+
+
+(deftest map-vals-nil
+ (is (= nil (transform s/MAP-VALS inc nil)))
+ (is (empty? (select s/MAP-VALS nil))))
+
+
+(defspec dispense-test
+ (for-all+
+ [k1 gen/int
+ k2 gen/int
+ k3 gen/int
+ m (gen-map-with-keys gen/int gen/int k1 k2 k3)]
+ (= (select [(s/collect-one (s/keypath k1))
+ (s/collect-one (s/keypath k2))
+ s/DISPENSE
+ (s/collect-one (s/keypath k2))
+ (s/keypath k3)]
+ m)
+ (select [(s/collect-one (s/keypath k2))
+ (s/keypath k3)]
+ m))))
+
+
+(deftest collected?-test
+ (let [data {:active-id 1 :items [{:id 1 :name "a"} {:id 2 :name "b"}]}]
+ (is (= {:id 1 :name "a"}
+ (select-any [(s/collect-one :active-id)
+ :items
+ s/ALL
+ (s/collect-one :id)
+ (collected? [a i] (= a i))
+ s/DISPENSE]
+
+ data)
+ (select-any [(s/collect-one :active-id)
+ :items
+ s/ALL
+ (s/collect-one :id)
+ (collected? v (apply = v))
+ s/DISPENSE]
+
+ data))))
+
+ (let [data {:active 3 :items [{:id 1 :val 0} {:id 3 :val 11}]}]
+ (is (= (transform [:items s/ALL (s/selected? :id #(= % 3)) :val] inc data)
+ (transform [(s/collect-one :active)
+ :items
+ s/ALL
+ (s/collect-one :id)
+ (collected? [a i] (= a i))
+ s/DISPENSE
+ :val]
+ inc
+ data)))))
+
+
+(defspec traverse-test
+ (for-all+
+ [v (gen/vector gen/int)
+ p (gen/elements [odd? even?])
+ i gen/int]
+ (and
+ (= (reduce + (traverse [s/ALL p] v))
+ (reduce + (filter p v)))
+ (= (reduce + i (traverse [s/ALL p] v))
+ (reduce + i (filter p v))))))
+
+(def KeyAccumWalker
+ (recursive-path [k] p
+ (s/if-path (s/must k)
+ s/STAY
+ [s/ALL (s/collect-one s/FIRST) s/LAST p])))
+
+
+(deftest recursive-if-path-select-vals-test
+ (let [data {"e1" {"e2" {"e1" {:template 1} "e2" {:template 2}}}}]
+ (is (= [["e1" "e2" "e1" {:template 1}] ["e1" "e2" "e2" {:template 2}]]
+ (select (KeyAccumWalker :template) data)))
+ (is (= {"e1" {"e2" {"e1" "e1e2e1" "e2" "e1e2e2"}}}
+ (transform (KeyAccumWalker :template)
+ (fn [& all] (apply str (butlast all)))
+ data)))))
+
+
+(deftest multi-path-vals-test
+ (is (= {:a 1 :b 6 :c 3}
+ (transform [(s/multi-path (s/collect-one :a) (s/collect-one :c)) :b]
+ +
+ {:a 1 :b 2 :c 3})))
+ (is (= [[1 2] [3 2]]
+ (select [(s/multi-path (s/collect-one :a) (s/collect-one :c)) :b]
+ {:a 1 :b 2 :c 3}))))
+
+
+(deftest sorted-map-by-transform
+ (let [amap (sorted-map-by > 1 10 2 20 3 30)]
+ (is (= [3 2 1] (keys (transform s/MAP-VALS inc amap))))
+ (is (= [3 2 1] (keys (transform [s/ALL s/LAST] inc amap))))))
+
+
+(deftest setval-vals-collection-test
+ (is (= 2 (setval s/VAL 2 :a))))
+
+(defspec multi-transform-test
+ (for-all+
+ [kw1 gen/keyword
+ kw2 gen/keyword
+ m (limit-size 5 (gen-map-with-keys gen/keyword gen/int kw1 kw2))]
+ (= (->> m (transform [(s/keypath kw1) s/VAL] +) (transform (s/keypath kw2) dec))
+ (multi-transform
+ (s/multi-path [(s/keypath kw1) s/VAL (s/terminal +)]
+ [(s/keypath kw2) (s/terminal dec)])
+ m))))
+
+
+(deftest multi-transform-overrun-error
+ (is (thrown? #?(:clj Exception :cljs js/Error) (multi-transform s/STAY 3))))
+
+
+(deftest terminal-val-test
+ (is (= 3 (multi-transform (s/terminal-val 3) 2)))
+ (is (= 3 (multi-transform [s/VAL (s/terminal-val 3)] 2))))
+
+
+
+(deftest multi-path-order-test
+ (is (= 102
+ (multi-transform
+ (s/multi-path
+ [odd? (s/terminal #(* 2 %))]
+ [even? (s/terminal-val 100)]
+ [#(= 100 %) (s/terminal inc)]
+ [#(= 101 %) (s/terminal inc)])
+ 1))))
+
+
+(defdynamicnav ignorer [a]
+ s/STAY)
+
+(deftest dynamic-nav-ignores-dynamic-arg
+ (let [a 1]
+ (is (= 1 (select-any (ignorer a) 1)))
+ (is (= 1 (select-any (ignorer :a) 1)))))
+
+
+(deftest nested-dynamic-nav
+ (let [data {:a {:a 1 :b 2} :b {:a 3 :b 4}}
+ afn (fn [a b] (select-any (s/selected? (s/must a)
+ (s/selected? (s/must b)))
+ data))]
+ (is (= data (afn :a :a)))
+ (is (= s/NONE (afn :a :c)))
+ (is (= data (afn :a :b)))
+ (is (= s/NONE (afn :c :a)))
+ (is (= data (afn :b :a)))
+ (is (= data (afn :b :b)))))
+
+(deftest duplicate-map-keys-test
+ (let [res (setval [s/ALL s/FIRST] "a" {:a 1 :b 2})]
+ (is (= {"a" 2} res))
+ (is (= 1 (count res)))))
+
+(deftest inline-caching-vector-params-test
+ (is (= [10 [11]] (multi-transform (s/terminal-val [10 [11]]) :a))))
+
+(defn eachnav-fn-test [akey data]
+ (select-any (s/keypath "a" akey) data))
+
+(deftest eachnav-test
+ (let [data {"a" {"b" 1 "c" 2}}]
+ (is (= 1 (eachnav-fn-test "b" data)))
+ (is (= 2 (eachnav-fn-test "c" data)))
+ ))
+
+(deftest traversed-test
+ (is (= 10 (select-any (s/traversed s/ALL +) [1 2 3 4]))))
+
+(defn- predand= [pred v1 v2]
+ (and (pred v1)
+ (pred v2)
+ (= v1 v2)))
+
+(defn listlike? [v]
+ (or (list? v) (seq? v)))
+
+(deftest nthpath-test
+ (is (predand= vector? [1 2 -3 4] (transform (s/nthpath 2) - [1 2 3 4])))
+ (is (predand= vector? [1 2 4] (setval (s/nthpath 2) s/NONE [1 2 3 4])))
+ (is (predand= (complement vector?) '(1 -2 3 4) (transform (s/nthpath 1) - '(1 2 3 4))))
+ (is (predand= (complement vector?) '(1 2 4) (setval (s/nthpath 2) s/NONE '(1 2 3 4))))
+ (is (= [0 1 [2 4 4]] (transform (s/nthpath 2 1) inc [0 1 [2 3 4]])))
+ )
+
+(deftest remove-with-NONE-test
+ (is (predand= vector? [1 2 3] (setval [s/ALL nil?] s/NONE [1 2 nil 3 nil])))
+ (is (predand= listlike? '(1 2 3) (setval [s/ALL nil?] s/NONE '(1 2 nil 3 nil))))
+ (is (= {:b 2} (setval :a s/NONE {:a 1 :b 2})))
+ (is (= {:b 2} (setval (s/must :a) s/NONE {:a 1 :b 2})))
+ (is (predand= vector? [1 3] (setval (s/keypath 1) s/NONE [1 2 3])))
+ ;; test with PersistentArrayMap
+ (is (= {:a 1 :c 3} (setval [s/MAP-VALS even?] s/NONE {:a 1 :b 2 :c 3 :d 4})))
+ (is (= {:a 1 :c 3} (setval [s/ALL (s/selected? s/LAST even?)] s/NONE {:a 1 :b 2 :c 3 :d 4})))
+ ;; test with PersistentHashMap
+ (let [m (into {} (for [i (range 500)] [i i]))]
+ (is (= (dissoc m 31) (setval [s/MAP-VALS #(= 31 %)] s/NONE m)))
+ (is (= (dissoc m 31) (setval [s/ALL (s/selected? s/LAST #(= 31 %))] s/NONE m)))
+ ))
+
+(deftest fresh-collected-test
+ (let [data [{:a 1 :b 2} {:a 3 :b 3}]]
+ (is (= [[{:a 1 :b 2} 2]]
+ (select [s/ALL
+ s/VAL
+ (s/with-fresh-collected
+ (s/collect-one :a)
+ (s/collected? [a] (= a 1)))
+ :b]
+ data)))
+ (is (= [{:a 1 :b 3} {:a 3 :b 3}]
+ (transform [s/ALL
+ s/VAL
+ (s/with-fresh-collected
+ (s/collect-one :a)
+ (s/collected? [a] (= a 1)))
+ :b]
+ (fn [m v] (+ (:a m) v))
+ data
+ )))
+ ))
+
+(deftest traverse-all-test
+ (is (= 3
+ (transduce (comp (mapcat identity)
+ (traverse-all :a))
+ (completing (fn [r i] (if (= i 4) (reduced r) (+ r i))))
+ 0
+ [[{:a 1}] [{:a 2}] [{:a 4}] [{:a 5}]])))
+ (is (= 6
+ (transduce (traverse-all [s/ALL :a])
+ +
+ 0
+ [[{:a 1} {:a 2}] [{:a 3}]]
+ )))
+ (is (= [1 2]
+ (into [] (traverse-all :a) [{:a 1} {:a 2}])))
+ )
+
+(deftest early-terminate-traverse-test
+ (is (= 6
+ (reduce
+ (completing (fn [r i] (if (> r 5) (reduced r) (+ r i))))
+ 0
+ (traverse [s/ALL s/ALL]
+ [[1 2] [3 4] [5]])))))
+
+(deftest select-any-vals-test
+ (is (= [1 1] (select-any s/VAL 1))))
+
+(deftest conditional-vals-test
+ (is (= 2 (select-any (s/with-fresh-collected
+ (s/collect-one (s/keypath 0))
+ (s/if-path (collected? [n] (even? n))
+ (s/keypath 1)
+ (s/keypath 2)))
+ [4 2 3])))
+ (is (= [4 2 3]
+ (select-any (s/with-fresh-collected
+ (s/collect-one (s/keypath 0))
+ (s/selected? (collected? [n] (even? n))))
+ [4 2 3])))
+ )
+
+(deftest name-namespace-test
+ (is (= :a (setval s/NAME "a" :e)))
+ (is (= :a/b (setval s/NAME "b" :a/e)))
+ (is (= 'a (setval s/NAME "a" 'e)))
+ (is (= 'a/b (setval s/NAME "b" 'a/e)))
+ (is (= :a/e (setval s/NAMESPACE "a" :e)))
+ (is (= :a/e (setval s/NAMESPACE "a" :f/e)))
+ (is (= 'a/e (setval s/NAMESPACE "a" 'e)))
+ (is (= 'a/e (setval s/NAMESPACE "a" 'f/e)))
+ )
+
+(deftest string-navigation-test
+ (is (= "ad" (setval (s/srange 1 3) "" "abcd")))
+ (is (= "abcxd" (setval [(s/srange 1 3) s/END] "x" "abcd")))
+ (is (= "bc" (select-any (s/srange 1 3) "abcd")))
+ (is (= "ab" (setval s/END "b" "a")))
+ (is (= "ba" (setval s/BEGINNING "b" "a")))
+ (is (= "" (select-any s/BEGINNING "abc")))
+ (is (= "" (select-any s/END "abc")))
+ (is (= \a (select-any s/FIRST "abc")))
+ (is (= \c (select-any s/LAST "abc")))
+ (is (= "qbc" (setval s/FIRST \q "abc")))
+ (is (= "abq" (setval s/LAST "q" "abc")))
+ )
+
+(deftest regex-navigation-test
+ ;; also test regexes as implicit navs
+ (is (= (select #"t" "test") ["t" "t"]))
+ (is (= (select [:a (s/regex-nav #"t")] {:a "test"}) ["t" "t"]))
+ (is (= (transform (s/regex-nav #"t") clojure.string/capitalize "test") "TesT"))
+ ;; also test regexes as implicit navs
+ (is (= (transform [:a #"t"] clojure.string/capitalize {:a "test"}) {:a "TesT"}))
+ (is (= (transform (s/regex-nav #"\s+\w") clojure.string/triml "Hello World!") "HelloWorld!"))
+ (is (= (setval (s/regex-nav #"t") "z" "test") "zesz"))
+ (is (= (setval [:a (s/regex-nav #"t")] "z" {:a "test"}) {:a "zesz"}))
+ (is (= (transform (s/regex-nav #"aa*") (fn [s] (-> s count str)) "aadt") "2dt"))
+ (is (= (transform (s/regex-nav #"[Aa]+") (fn [s] (apply str (take (count s) (repeat "@")))) "Amsterdam Aardvarks") "@msterd@m @@rdv@rks"))
+ (is (= (select [(s/regex-nav #"(\S+):\ (\d+)") (s/nthpath 2)] "Mary: 1st George: 2nd Arthur: 3rd") ["1" "2" "3"]))
+ (is (= (transform (s/subselect (s/regex-nav #"\d\w+")) reverse "Mary: 1st George: 2nd Arthur: 3rd") "Mary: 3rd George: 2nd Arthur: 1st"))
+ )
+
+(deftest single-value-none-navigators-test
+ (is (predand= vector? [1 2 3] (setval s/AFTER-ELEM 3 [1 2])))
+ (is (predand= listlike? '(1 2 3) (setval s/AFTER-ELEM 3 '(1 2))))
+ (is (predand= listlike? '(1) (setval s/AFTER-ELEM 1 nil)))
+ (is (predand= vector? [3 1 2] (setval s/BEFORE-ELEM 3 [1 2])))
+ (is (predand= listlike? '(3 1 2) (setval s/BEFORE-ELEM 3 '(1 2))))
+ (is (predand= listlike? '(1) (setval s/BEFORE-ELEM 1 nil)))
+ (is (= #{1 2 3} (setval s/NONE-ELEM 3 #{1 2})))
+ (is (= #{1} (setval s/NONE-ELEM 1 nil)))
+ )
+
+(deftest subvec-test
+ (let [v (subvec [1] 0)]
+ (is (predand= vector? [2] (transform s/FIRST inc v)))
+ (is (predand= vector? [2] (transform s/LAST inc v)))
+ (is (predand= vector? [2] (transform s/ALL inc v)))
+ (is (predand= vector? [0 1] (setval s/BEGINNING [0] v)))
+ (is (predand= vector? [1 0] (setval s/END [0] v)))
+ (is (predand= vector? [0 1] (setval s/BEFORE-ELEM 0 v)))
+ (is (predand= vector? [1 0] (setval s/AFTER-ELEM 0 v)))
+ (is (predand= vector? [1 0] (setval (s/srange 1 1) [0] v)))
+ ))
+
+(defspec map-keys-all-first-equivalence-transform
+ (for-all+
+ [m (limit-size 10 (gen/map gen/int gen/keyword))]
+ (= (transform s/MAP-KEYS inc m)
+ (transform [s/ALL s/FIRST] inc m )
+ )))
+
+(defspec map-keys-all-first-equivalence-select
+ (for-all+
+ [m (limit-size 10 (gen/map gen/int gen/keyword))]
+ (= (select s/MAP-KEYS m)
+ (select [s/ALL s/FIRST] m)
+ )))
+
+(defspec remove-first-vector
+ (for-all+
+ [v (limit-size 10 (gen/not-empty (gen/vector gen/int)))]
+ (let [newv (setval s/FIRST s/NONE v)]
+ (and (= newv (vec (rest v)))
+ (vector? newv)
+ ))))
+
+(defspec remove-first-list
+ (for-all+
+ [l (limit-size 10 (gen/not-empty (gen/list gen/int)))]
+ (let [newl (setval s/FIRST s/NONE l)]
+ (and (= newl (rest l))
+ (listlike? newl)
+ ))))
+
+(defspec remove-last-vector
+ (for-all+
+ [v (limit-size 10 (gen/not-empty (gen/vector gen/int)))]
+ (let [newv (setval s/LAST s/NONE v)]
+ (and (= newv (vec (butlast v)))
+ (vector? newv)
+ ))))
+
+(defspec remove-last-list
+ (for-all+
+ [l (limit-size 10 (gen/not-empty (gen/list gen/int)))]
+ (let [newl (setval s/LAST s/NONE l)
+ bl (butlast l)]
+ (and (or (= newl bl) (and (nil? bl) (= '() newl)))
+ (seq? newl)
+ ))))
+
+(deftest remove-extreme-string
+ (is (= "b" (setval s/FIRST s/NONE "ab")))
+ (is (= "a" (setval s/LAST s/NONE "ab")))
+ )
+
+(deftest nested-dynamic-arg-test
+ (let [foo (fn [v] (multi-transform (s/terminal-val [v]) nil))]
+ (is (= [1] (foo 1)))
+ (is (= [10] (foo 10)))
+ ))
+
+(deftest filterer-remove-test
+ (is (= [1 :a 3 5] (setval (s/filterer even?) [:a] [1 2 3 4 5])))
+ (is (= [1 3 5] (setval (s/filterer even?) [] [1 2 3 4 5])))
+ (is (= [1 3 5] (setval (s/filterer even?) nil [1 2 3 4 5])))
+ )
+
+(deftest helper-preds-test
+ (let [data [1 2 2 3 4 0]]
+ (is (= [2 2] (select [s/ALL (s/pred= 2)] data)))
+ (is (= [1 2 2 0] (select [s/ALL (s/pred< 3)] data)))
+ (is (= [1 2 2 3 0] (select [s/ALL (s/pred<= 3)] data)))
+ (is (= [4] (select [s/ALL (s/pred> 3)] data)))
+ (is (= [3 4] (select [s/ALL (s/pred>= 3)] data)))
+ ))
+
+(deftest map-key-test
+ (is (= {:c 3} (setval (s/map-key :a) :b {:c 3})))
+ (is (= {:b 2} (setval (s/map-key :a) :b {:a 2})))
+ (is (= {:b 2} (setval (s/map-key :a) :b {:a 2 :b 1})))
+ (is (= {:b 2} (setval (s/map-key :a) s/NONE {:a 1 :b 2})))
+ )
+
+(deftest set-elem-test
+ (is (= #{:b :d} (setval (s/set-elem :a) :x #{:b :d})))
+ (is (= #{:x :a} (setval (s/set-elem :b) :x #{:b :a})))
+ (is (= #{:a} (setval (s/set-elem :b) :a #{:b :a})))
+ (is (= #{:b} (setval (s/set-elem :a) s/NONE #{:a :b})))
+ )
+
+;; this function necessary to trigger the bug from happening
+(defn inc2 [v] (inc v))
+(deftest dynamic-function-arg-test
+ (is (= {[2] 4} (let [a 1] (transform (s/keypath [(inc2 a)]) inc {[2] 3}))))
+ )
+
+(defrecord FooW [a b])
+
+(deftest walker-test
+ (is (= [1 2 3 4 5 6] (select (s/walker number?) [{1 2 :b '(3 :c 4)} 5 #{6 :d}])))
+ (is (= [{:b '(:c)} #{:d}] (setval (s/walker number?) s/NONE [{:q 3 10 :l 1 2 :b '(3 :c 4)} 5 #{6 :d}])))
+ (is (= [{:q 4 11 :l 2 3 :b '(4 :c 5)} 6 #{7 :d}]
+ (transform (s/walker number?) inc [{:q 3 10 :l 1 2 :b '(3 :c 4)} 5 #{6 :d}])))
+ (let [f (->FooW 1 2)]
+ (is (= [[:a 1] [:b 2]] (select (s/walker (complement record?)) f)))
+ (is (= (assoc f :a! 1 :b! 2) (setval [(s/walker (complement record?)) s/FIRST s/NAME s/END] "!" f)))
+ (is (= (assoc f :b 1 :c 2) (transform [(s/walker (complement record?)) s/FIRST] (fn [k] (if (= :a k) :b :c)) f)))
+ ))
+
+(def MIDDLE
+ (s/comp-paths
+ (s/srange-dynamic
+ (fn [aseq] (long (/ (count aseq) 2)))
+ (end-fn [aseq s] (if (empty? aseq) 0 (inc s))))
+ s/FIRST
+ ))
+
+(deftest srange-dynamic-test
+ (is (= 2 (select-any MIDDLE [1 2 3])))
+ (is (identical? s/NONE (select-any MIDDLE [])))
+ (is (= 1 (select-any MIDDLE [1])))
+ (is (= 2 (select-any MIDDLE [1 2])))
+ (is (= [1 3 3] (transform MIDDLE inc [1 2 3])))
+ )
+
+(def ^:dynamic *dvar* :a)
+
+(defn dvar-tester []
+ (select-any *dvar* {:a 1 :b 2}))
+
+(deftest dynamic-var-ic-test
+ (is (= 1 (dvar-tester)))
+ (is (= 2 (binding [*dvar* :b] (dvar-tester))))
+ )
+
+(deftest before-index-test
+ (let [data [1 2 3]
+ datal '(1 2 3)
+ data-str "abcdef"]
+ (is (predand= vector? [:a 1 2 3] (setval (s/before-index 0) :a data)))
+ (is (predand= vector? [1 2 3] (setval (s/before-index 1) s/NONE data)))
+ (is (predand= vector? [1 :a 2 3] (setval (s/before-index 1) :a data)))
+ (is (predand= vector? [1 2 3 :a] (setval (s/before-index 3) :a data)))
+ ; ensure inserting at index 0 in nil structure works, as in previous impl
+ (is (predand= listlike? '(:a) (setval (s/before-index 0) :a nil)))
+ (is (predand= listlike? '(:a 1 2 3) (setval (s/before-index 0) :a datal)))
+ (is (predand= listlike? '(1 :a 2 3) (setval (s/before-index 1) :a datal)))
+ (is (predand= listlike? '(1 2 3 :a) (setval (s/before-index 3) :a datal)))
+ (is (predand= string? "abcxdef" (setval (s/before-index 3) (char \x) data-str)))
+ ))
+
+(deftest index-nav-test
+ (let [data [1 2 3 4 5 6]
+ datal '(1 2 3 4 5 6)]
+ (is (predand= vector? [3 1 2 4 5 6] (setval (s/index-nav 2) 0 data)))
+ (is (predand= vector? [1 3 2 4 5 6] (setval (s/index-nav 2) 1 data)))
+ (is (predand= vector? [1 2 3 4 5 6] (setval (s/index-nav 2) 2 data)))
+ (is (predand= vector? [1 2 4 5 3 6] (setval (s/index-nav 2) 4 data)))
+ (is (predand= vector? [1 2 4 5 6 3] (setval (s/index-nav 2) 5 data)))
+ (is (predand= vector? [6 1 2 3 4 5] (setval (s/index-nav 5) 0 data)))
+
+ (is (predand= listlike? '(3 1 2 4 5 6) (setval (s/index-nav 2) 0 datal)))
+ (is (predand= listlike? '(1 3 2 4 5 6) (setval (s/index-nav 2) 1 datal)))
+ (is (predand= listlike? '(1 2 3 4 5 6) (setval (s/index-nav 2) 2 datal)))
+ (is (predand= listlike? '(1 2 4 5 3 6) (setval (s/index-nav 2) 4 datal)))
+ (is (predand= listlike? '(1 2 4 5 6 3) (setval (s/index-nav 2) 5 datal)))
+ (is (predand= listlike? '(6 1 2 3 4 5) (setval (s/index-nav 5) 0 datal)))
+ ))
+
+(deftest indexed-vals-test
+ (let [data [:a :b :c :d :e]]
+ (is (= [[0 :a] [1 :b] [2 :c] [3 :d] [4 :e]] (select s/INDEXED-VALS data)))
+ (is (= [:e :d :c :b :a] (setval [s/INDEXED-VALS s/FIRST] 0 data)))
+ (is (= [:a :b :e :d :c] (setval [s/INDEXED-VALS s/FIRST] 2 data)))
+ (is (= [:b :a :d :c :e] (transform [s/INDEXED-VALS s/FIRST odd?] dec data)))
+ (is (= [:a :b :c :d :e] (transform [s/INDEXED-VALS s/FIRST odd?] inc data)))
+ (is (= [0 2 2 4] (transform [s/INDEXED-VALS s/LAST odd?] inc [0 1 2 3])))
+ (is (= [0 1 2 3] (transform [s/INDEXED-VALS (s/collect-one s/LAST) s/FIRST] (fn [i _] i) [2 1 3 0])))
+ (is (= [-1 0 1 2 3] (transform [(s/indexed-vals -1) (s/collect-one s/LAST) s/FIRST] (fn [i _] i) [3 -1 0 2 1])))
+ (is (= [[1 :a] [2 :b] [3 :c]] (select (s/indexed-vals 1) [:a :b :c])))
+ ))
+
+(deftest other-implicit-navs-test
+ (is (= 1 (select-any ["a" true \c 10 'd] {"a" {true {\c {10 {'d 1}}}}})))
+ )
+
+(deftest vterminal-test
+ (is (= {:a {:b [[1 2] 3]}}
+ (multi-transform [(s/putval 1) :a (s/putval 2) :b (s/vterminal (fn [vs v] [vs v]))]
+ {:a {:b 3}})))
+ )
+
+(deftest vtransform-test
+ (is (= {:a 6} (vtransform [:a (s/putval 2) (s/putval 3)] (fn [vs v] (+ v (reduce + vs))) {:a 1})))
+ )
+
+(deftest compact-test
+ (is (= {} (setval [:a (s/compact :b :c)] s/NONE {:a {:b {:c 1}}})))
+ (is (= {:a {:d 2}} (setval [:a (s/compact :b :c)] s/NONE {:a {:b {:c 1} :d 2}})))
+ (let [TREE-VALUES (recursive-path [] p (s/if-path vector? [(s/compact s/ALL) p] s/STAY))
+ tree [1 [2 3] [] [4 [[5] [[6]]]]]]
+ (is (= [2 4 6] (select [TREE-VALUES even?] tree)))
+ (is (= [1 [3] [[[5]]]] (setval [TREE-VALUES even?] s/NONE tree)))
+ )
+ (is (= [{:a [{:c 1}]}]
+ (setval [s/ALL (s/compact :a s/ALL :b)]
+ s/NONE
+ [{:a [{:b 3}]}
+ {:a [{:b 2 :c 1}]}])))
+ )
+
+(deftest class-constant-test
+ (let [f (fn [p] (fn [v] (str p (inc v))))]
+ (is (= (str #?(:clj String :cljs js/String) 2)
+ (multi-transform (s/terminal (f #?(:clj String :cljs js/String))) 1)))
+ ))
+
+#?(:clj
+ (do
+ (defprotocolpath FooPP)
+ (extend-protocolpath FooPP String s/STAY)
+
+ (deftest satisfies-protpath-test
+ (is (satisfies-protpath? FooPP "a"))
+ (is (not (satisfies-protpath? FooPP 1)))
+ )))
diff --git a/test-resources/lib_tests/com/rpl/specter/test_helpers.clj b/test-resources/lib_tests/com/rpl/specter/test_helpers.clj
new file mode 100644
index 00000000..be177fba
--- /dev/null
+++ b/test-resources/lib_tests/com/rpl/specter/test_helpers.clj
@@ -0,0 +1,36 @@
+(ns com.rpl.specter.test-helpers
+ (:require [clojure.test.check
+ [generators :as gen]
+ [properties :as prop]]
+ [clojure.test])
+
+ (:use [com.rpl.specter :only [select transform]]
+ [com.rpl.specter :only [select* transform*]]))
+
+
+;; it seems like gen/bind and gen/return are a monad (hence the names)
+;; this is only for clj (cljs version in different file)
+(defmacro for-all+ [bindings & body]
+ (let [parts (partition 2 bindings)
+ vars (vec (map first parts))
+ genned (reduce
+ (fn [curr [v code]]
+ `(gen/bind ~code (fn [~v] ~curr)))
+ `(gen/return ~vars)
+ (reverse parts))]
+ `(prop/for-all [~vars ~genned]
+ ~@body)))
+
+
+(defmacro ic-test [params-decl apath transform-fn data params]
+ (let [platform (if (contains? &env :locals) :cljs :clj)
+ is-sym (if (= platform :clj) 'clojure.test/is 'cljs.test/is)]
+ `(let [icfnsel# (fn [~@params-decl] (select ~apath ~data))
+ icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data))
+ regfnsel# (fn [~@params-decl] (select* ~apath ~data))
+ regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data))
+ params# (if (empty? ~params) [[]] ~params)]
+ (dotimes [_# 3]
+ (doseq [ps# params#]
+ (~is-sym (= (apply icfnsel# ps#) (apply regfnsel# ps#)))
+ (~is-sym (= (apply icfntran# ps#) (apply regfntran# ps#))))))))
diff --git a/test-resources/lib_tests/com/rpl/specter/zipper_test.cljc b/test-resources/lib_tests/com/rpl/specter/zipper_test.cljc
new file mode 100644
index 00000000..43c21c82
--- /dev/null
+++ b/test-resources/lib_tests/com/rpl/specter/zipper_test.cljc
@@ -0,0 +1,122 @@
+(ns com.rpl.specter.zipper-test
+ #?(:cljs (:require-macros
+ [cljs.test :refer [is deftest]]
+ [clojure.test.check.clojure-test :refer [defspec]]
+ [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
+ [com.rpl.specter
+ :refer [declarepath providepath select select-one select-one!
+ select-first transform setval replace-in]]))
+
+ (:use
+ #?(:clj [clojure.test :only [deftest is]])
+ #?(:clj [clojure.test.check.clojure-test :only [defspec]])
+ #?(:clj [com.rpl.specter.test-helpers :only [for-all+]])
+ #?(:clj [com.rpl.specter
+ :only [declarepath providepath select select-one select-one!
+ select-first transform setval replace-in]]))
+
+ (:require #?(:clj [clojure.test.check.generators :as gen])
+ #?(:clj [clojure.test.check.properties :as prop])
+ #?(:cljs [clojure.test.check :as tc])
+ #?(:cljs [clojure.test.check.generators :as gen])
+ #?(:cljs [clojure.test.check.properties :as prop :include-macros true])
+ [com.rpl.specter :as s]
+ [com.rpl.specter.zipper :as z]))
+
+(defspec zipper-end-equivalency-test
+ (for-all+
+ [v (gen/not-empty (gen/vector gen/int))
+ i (gen/vector gen/int)]
+ (= (setval s/END i v)
+ (setval [z/VECTOR-ZIP z/DOWN z/RIGHTMOST z/INNER-RIGHT] i v))))
+
+
+(deftest zipper-multi-insert-test
+ (is (= [1 2 :a :b 3 :a :b 4]
+ (setval [z/VECTOR-ZIP
+ z/DOWN
+ z/RIGHT
+ z/RIGHT
+ (s/multi-path z/INNER-RIGHT z/INNER-LEFT)]
+
+ [:a :b]
+ [1 2 3 4])
+
+ (setval [z/VECTOR-ZIP
+ z/DOWN
+ z/RIGHT
+ z/RIGHT
+ (s/multi-path z/INNER-LEFT z/INNER-RIGHT)]
+
+ [:a :b]
+ [1 2 3 4]))))
+
+
+
+
+(deftest zipper-down-up-test
+ (is (= [1 [2 3 5] 6]
+ (transform [z/VECTOR-ZIP
+ z/DOWN
+ z/RIGHT
+ z/DOWN
+ z/RIGHT
+ z/RIGHT
+ (s/multi-path
+ s/STAY
+ [z/UP z/RIGHT])
+ z/NODE]
+ inc
+ [1 [2 3 4] 5]))))
+
+
+
+
+(deftest next-terminate-test
+ (is (= [2 [3 4 [5]] 6]
+ (transform [z/VECTOR-ZIP z/NEXT-WALK z/NODE number?]
+ inc
+ [1 [2 3 [4]] 5])))
+ (is (= [1 [3 [[]] 5]]
+ (setval [z/VECTOR-ZIP
+ z/NEXT-WALK
+ (s/selected? z/NODE number? even?)
+ z/NODE-SEQ]
+ []
+ [1 2 [3 [[4]] 5] 6]))))
+
+
+
+
+(deftest zipper-nav-stop-test
+ (is (= [1]
+ (transform [z/VECTOR-ZIP z/UP z/NODE] inc [1])))
+ (is (= [1]
+ (transform [z/VECTOR-ZIP z/DOWN z/LEFT z/NODE] inc [1])))
+ (is (= [1]
+ (transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1])))
+ (is (= []
+ (transform [z/VECTOR-ZIP z/DOWN z/NODE] inc []))))
+
+
+(deftest find-first-test
+ (is (= [1 [3 [[4]] 5] 6]
+ (setval [z/VECTOR-ZIP
+ (z/find-first #(and (number? %) (even? %)))
+ z/NODE-SEQ]
+
+ []
+ [1 2 [3 [[4]] 5] 6]))))
+
+
+
+(deftest nodeseq-expand-test
+ (is (= [2 [2] [[4 4 4]] 4 4 4 6]
+ (transform [z/VECTOR-ZIP
+ z/NEXT-WALK
+ (s/selected? z/NODE number? odd?)
+ (s/collect-one z/NODE)
+ z/NODE-SEQ]
+ (fn [v _]
+ (repeat v (inc v)))
+ [1 [2] [[3]] 3 6]))))
diff --git a/test-resources/lib_tests/honeysql/core_test.cljc b/test-resources/lib_tests/honeysql/core_test.cljc
index d1fc2f8b..c5736c6c 100644
--- a/test-resources/lib_tests/honeysql/core_test.cljc
+++ b/test-resources/lib_tests/honeysql/core_test.cljc
@@ -11,6 +11,17 @@
insert-into with merge-where merge-having]]
honeysql.format-test))
+;; BB_TEST_PATCH: must explicitly set data readers
+#?(:clj
+ (do
+ (require '[honeysql.types])
+ (set! *data-readers* {'sql/call honeysql.types/read-sql-call
+ 'sql/inline honeysql.types/read-sql-inline
+ 'sql/raw honeysql.types/read-sql-raw
+ 'sql/param honeysql.types/read-sql-param
+ 'sql/array honeysql.types/read-sql-array
+ 'sql/regularize honeysql.format/regularize})))
+
;; TODO: more tests
(deftest test-select
diff --git a/test-resources/lib_tests/httpkit/client_test.clj b/test-resources/lib_tests/httpkit/client_test.clj
index 8a15d811..546ff867 100644
--- a/test-resources/lib_tests/httpkit/client_test.clj
+++ b/test-resources/lib_tests/httpkit/client_test.clj
@@ -58,3 +58,14 @@
(deftest alter-var-root-test
(is (alter-var-root (var client/*default-client*) (constantly sni/default-client))))
+
+(deftest query-string-test
+ (is (= (client/query-string {:k1 "v1" :k2 "v2" :k3 nil :k4 ["v4a" "v4b"] :k5 []})
+ "k1=v1&k2=v2&k3=&k4=v4a&k4=v4b&k5="))
+ (is (= (client/query-string {:k1 \v :k2 'v2})
+ "k1=v&k2=v2")))
+
+(deftest url-encode-test
+ (is (= "AbC" (client/url-encode "AbC")))
+ (is (= "%3C%3E%21%40%23%24%25%5E"
+ (client/url-encode "<>!@#$%^"))))
diff --git a/test-resources/lib_tests/integrant/core_test.cljc b/test-resources/lib_tests/integrant/core_test.cljc
index 065bb5a5..ceeb60f7 100644
--- a/test-resources/lib_tests/integrant/core_test.cljc
+++ b/test-resources/lib_tests/integrant/core_test.cljc
@@ -489,7 +489,7 @@
[(f m (keys m) (fn [k v] (last (swap! log conj [:test k v]))))
@log]))
-(deftest run-test
+(deftest run-test* ;; BB-TEST-PATCH: renamed due to conflict with clojure.test
(let [config {::a (ig/ref ::b), ::b 1}
[system _] (build-log config)]
(is (= [nil
diff --git a/test-resources/lib_tests/me/raynes/core_test.clj b/test-resources/lib_tests/me/raynes/core_test.clj
new file mode 100644
index 00000000..9effc484
--- /dev/null
+++ b/test-resources/lib_tests/me/raynes/core_test.clj
@@ -0,0 +1,467 @@
+(ns me.raynes.core-test
+ (:refer-clojure :exclude [name parents])
+ (:require [me.raynes.fs :refer :all]
+ ;; BB-TEST-PATCH: remove compression ns (requires unavailable classes from apache commons)
+ #_[me.raynes.fs.compression :refer :all]
+ ;; BB-TEST-PATCH: remove midje (needs currently unavailable classes) and add mock midje ns
+ #_[midje.sweet :refer :all]
+ [me.raynes.mock-midje :refer [fact]]
+ [clojure.java.io :as io]
+ [clojure.string :as string])
+ (:import java.io.File))
+
+(def system-tempdir (System/getProperty "java.io.tmpdir"))
+
+(def fs-supports-symlinks? (not (.startsWith (System/getProperty "os.name") "Windows")))
+
+(defn create-walk-dir []
+ (let [root (temp-dir "fs-")]
+ (mkdir (file root "a"))
+ (mkdir (file root "b"))
+ (spit (file root "1") "1")
+ (spit (file root "a" "2") "1")
+ (spit (file root "b" "3") "1")
+ root))
+
+(fact "Makes paths absolute."
+ (file ".") => *cwd*
+ (file "foo") => (io/file *cwd* "foo"))
+
+
+(fact "Expands path to current user."
+ (let [user (System/getProperty "user.home")]
+ (expand-home "~") => (file user)
+ (expand-home (str "~" File/separator "foo")) => (file user "foo")))
+
+(fact "Expands to given user."
+ (let [user (System/getProperty "user.home")
+ name (System/getProperty "user.name")]
+ (expand-home (str "~" name)) => (file user)
+ (expand-home (format "~%s/foo" name)) => (file user "foo")))
+
+(fact "Expand a path w/o tilde just returns path"
+ (let [user (System/getProperty "user.home")]
+ (expand-home (str user File/separator "foo")) => (io/file user "foo")))
+
+;; BB-TEST-PATCH: commented tests use midje functionality that isn't currently converted and/or
+;; the compression ns
+
+;; BB-TEST-PATCH: made binding to adapt paths to bb folder structure
+(def libtest-files-path "test-resources/lib_tests/me/raynes/testfiles")
+
+;(fact (list-dir ".") => (has every? #(instance? File %)))
+;
+;;; Want to change these files to be tempfiles at some point.
+;(when unix-root (against-background
+; [(around :contents (let [f (io/file "test/me/raynes/testfiles/bar")]
+; (.setExecutable f false)
+; (.setReadable f false)
+; (.setWritable f false)
+; ?form
+; (.setExecutable f true)
+; (.setReadable f true)
+; (.setWritable f true)))]
+; (fact
+; (executable? "test/me/raynes/testfiles/foo") => true
+; (executable? "test/me/raynes/testfiles/bar") => false)
+;
+; (fact
+; (readable? "test/me/raynes/testfiles/foo") => true
+; (readable? "test/me/raynes/testfiles/bar") => false)
+;
+; (fact
+; (writeable? "test/me/raynes/testfiles/foo") => true
+; (writeable? "test/me/raynes/testfiles/bar") => false)))
+
+;; BB-TEST-PATCH: update these paths to use bb folder structure
+
+(fact
+ (file? (str libtest-files-path "/foo")) => true
+ (file? ".") => false)
+
+(fact
+ (exists? (str libtest-files-path "/foo")) => true
+ (exists? "ewjgnr4ig43j") => false)
+
+(fact
+ (let [f (io/file (str libtest-files-path "/baz"))]
+ (.createNewFile f)
+ (delete f)
+ (exists? f) => false))
+
+(fact
+ (directory? ".") => true
+ (directory? (str libtest-files-path "/foo")) => false)
+
+(fact
+ (file? ".") => false
+ (file? (str libtest-files-path "/foo")) => true)
+
+(fact
+ (let [tmp (temp-file "fs-")]
+ (exists? tmp) => true
+ (file? tmp) => true
+ (delete tmp)))
+
+(fact
+ (let [tmp (temp-dir "fs-")]
+ (exists? tmp) => true
+ (directory? tmp) => true
+ (delete tmp)))
+
+(fact
+ (let [tmp (ephemeral-file "fs-")]
+ (exists? tmp) => true
+ (file? tmp) => true)) ;; is deleted on JVM exit
+
+(fact
+ (let [tmp (ephemeral-dir "fs-")]
+ (exists? tmp) => true
+ (directory? tmp) => true)) ;; is deleted on JVM exit
+
+(fact
+ (absolute "foo") => (io/file *cwd* "foo"))
+
+(fact
+ (normalized ".") => *cwd*)
+
+(fact
+ (base-name "foo/bar") => "bar"
+ (base-name "foo/bar.txt" true) => "bar"
+ (base-name "bar.txt" ".txt") => "bar"
+ (base-name "foo/bar.txt" ".png") => "bar.txt")
+
+(fact
+ (let [tmp (temp-file "fs-")]
+ (> (mod-time tmp) 0) => true
+ (delete tmp)))
+
+(fact
+ (let [f (temp-file "fs-")]
+ (spit f "abc")
+ (size f) => 3
+ (delete f)))
+
+(fact
+ (let [root (create-walk-dir)
+ result (delete-dir root)]
+ (exists? root) => false))
+
+(fact
+ (let [f (temp-file "fs-")]
+ (delete f)
+ (mkdir f)
+ (directory? f) => true
+ (delete-dir f)))
+
+(fact
+ (let [f (temp-file "fs-")
+ sub (file f "a" "b")]
+ (delete f)
+ (mkdirs sub)
+ (directory? sub) => true
+ (delete-dir f)))
+
+;(fact
+; (split (file "test/fs")) => (has-suffix ["test" "fs"]))
+
+(when unix-root
+ (fact
+ (split (file "/tmp/foo/bar.txt")) => '("/" "tmp" "foo" "bar.txt")
+ (split (file "/")) => '("/")
+ (split "/") => '("/")
+ (split "") => '("")))
+
+(fact
+ (let [f (temp-file "fs-")
+ new-f (str f "-new")]
+ (rename f new-f)
+ (exists? f) => false
+ (exists? new-f) => true
+ (delete new-f)))
+
+;(fact
+; (let [root (create-walk-dir)]
+; (walk vector root) => (contains [[root #{"b" "a"} #{"1"}]
+; [(file root "a") #{} #{"2"}]
+; [(file root "b") #{} #{"3"}]]
+; :in-any-order)
+; (delete-dir root)))
+
+(fact
+ (let [from (temp-file "fs-")
+ to (temp-file "fs-")
+ data "What's up Doc?"]
+ (delete to)
+ (spit from data)
+ (copy from to)
+ (slurp from) => (slurp to)
+ (delete from)
+ (delete to)))
+
+(fact
+ (let [f (temp-file "fs-")
+ t (mod-time f)]
+ (Thread/sleep 1000)
+ (touch f)
+ (> (mod-time f) t) => true
+ (let [t2 3000]
+ (touch f t2)
+ (mod-time f) => t2)
+ (delete f)))
+
+(fact
+ (let [f (temp-file "fs-")]
+ (chmod "+x" f)
+ (executable? f) => true
+ (when-not (re-find #"Windows" (System/getProperty "os.name"))
+ (chmod "-x" f)
+ (executable? f) => false)
+ (delete f)))
+
+(fact
+ (let [f (temp-file "fs-")]
+ (chmod "777" f)
+ (executable? f) => true
+ (readable? f) => true
+ (writeable? f) => true
+ (chmod "000" f)
+ (when-not (re-find #"Windows" (System/getProperty "os.name"))
+ (chmod "-x" f)
+ (executable? f) => false
+ (readable? f) => false
+ (writeable? f) => false)
+ (delete f)))
+
+;(fact
+; (let [from (create-walk-dir)
+; to (temp-dir "fs-")
+; path (copy-dir from to)
+; dest (file to (base-name from))]
+; path => dest
+; (walk vector to) => (contains [[to #{(base-name from)} #{}]
+; [dest #{"b" "a"} #{"1"}]
+; [(file dest "a") #{} #{"2"}]
+; [(file dest "b") #{} #{"3"}]]
+; :in-any-order)
+; (delete-dir from)
+; (delete-dir to)))
+;
+;(fact "copy-dir-into works as expected."
+; (let [from (create-walk-dir)
+; to (temp-dir "fs-")]
+; (copy-dir-into from to)
+; (walk vector to) => (contains [[(file to) #{"a" "b"} #{"1"}]
+; [(file to "a") #{} #{"2"}]
+; [(file to "b") #{} #{"3"}]]
+; :in-any-order)
+; (delete-dir from)
+; (delete-dir to)))
+
+(when (System/getenv "HOME")
+ (fact
+ (let [env-home (io/file (System/getenv "HOME"))]
+ (home) => env-home
+ (home "") => env-home
+ (home (System/getProperty "user.name")) => env-home)))
+
+;(tabular
+; (fact (split-ext ?file) => ?ext)
+;
+; ?file ?ext
+; "fs.clj" ["fs" ".clj"]
+; "fs." ["fs" "."]
+; "fs.clj.bak" ["fs.clj" ".bak"]
+; "/path/to/fs" ["fs" nil]
+; "" [(base-name (System/getProperty "user.dir")) nil]
+; "~user/.bashrc" [".bashrc" nil])
+;
+;(tabular
+; (fact (extension ?file) => ?ext)
+;
+; ?file ?ext
+; "fs.clj" ".clj"
+; "fs." "."
+; "fs.clj.bak" ".bak"
+; "/path/to/fs" nil
+; "" nil
+; ".bashrc" nil)
+;
+;(tabular
+; (fact (name ?file) => ?ext)
+;
+; ?file ?ext
+; "fs.clj" "fs"
+; "fs." "fs"
+; "fs.clj.bak" "fs.clj"
+; "/path/to/fs" "fs"
+; "" (base-name (System/getProperty "user.dir"))
+; ".bashrc" ".bashrc")
+
+(fact "Can change cwd with with-cwd."
+ (let [old *cwd*]
+ (with-cwd "foo"
+ *cwd* => (io/file old "foo"))))
+
+(fact "Can change cwd mutably with with-mutable-cwd"
+ (let [old *cwd*]
+ (with-mutable-cwd
+ (chdir "foo")
+ *cwd* => (io/file old "foo"))))
+
+;(with-cwd "test/me/raynes/testfiles"
+; (fact
+; (unzip "ggg.zip" "zggg")
+; (exists? "zggg/ggg") => true
+; (exists? "zggg/hhh/jjj") => true
+; (delete-dir "zggg"))
+;
+; (fact (zip "fro.zip" ["bbb.txt" "bbb"])
+; (exists? "fro.zip") => true
+; (unzip "fro.zip" "fro")
+; (exists? "fro/bbb.txt") => true
+; (rename "fro.zip" "fro2.zip") => true
+; (delete "fro2.zip")
+; (delete-dir "fro"))
+;
+; (fact "about zip round trip"
+; (zip "round.zip" ["some.txt" "some text"])
+; (unzip "round.zip" "round")
+; (slurp (file "round/some.txt")) => "some text")
+;
+; (fact "zip-files"
+; (zip-files "foobar.zip" ["foo" "bar"])
+; (exists? "foobar.zip")
+; (unzip "foobar.zip" "foobar")
+; (exists? "foobar/foo") => true
+; (exists? "foobar/bar") => true
+; (delete "foobar.zip")
+; (delete-dir "foobar"))
+;
+; (fact
+; (untar "ggg.tar" "zggg")
+; (exists? "zggg/ggg") => true
+; (exists? "zggg/hhh/jjj") => true
+; (delete-dir "zggg"))
+;
+; (fact
+; (gunzip "ggg.gz" "ggg")
+; (exists? "ggg") => true
+; (delete "ggg"))
+;
+; (fact
+; (bunzip2 "bbb.bz2" "bbb")
+; (exists? "bbb") => true
+; (delete "bbb"))
+;
+; (fact
+; (unxz "xxx.xz" "xxx")
+; (exists? "xxx") => true
+; (delete "xxx"))
+;
+; (fact "zip-slip vulnerability"
+; (unzip "zip-slip.zip" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir")
+; (untar "zip-slip.tar" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir")
+; (exists? "/tmp/evil.txt") => false
+; (delete-dir "zip-slip")))
+
+;(let [win-root (when-not unix-root "c:")]
+; (fact
+; (parents (str win-root "/foo/bar/baz")) => (just [(file (str win-root "/foo"))
+; (file (str win-root "/foo/bar"))
+; (file (str win-root "/"))]
+; :in-any-order)
+; (parents (str win-root "/")) => nil))
+;
+;(fact
+; (child-of? "/foo/bar" "/foo/bar/baz") => truthy
+; (child-of? "/foo/bar/baz" "/foo/bar") => falsey)
+
+(fact
+ (path-ns "foo/bar/baz_quux.clj") => 'foo.bar.baz-quux)
+
+;(fact
+; (str (ns-path 'foo.bar.baz-quux)) => (has-suffix (string/join File/separator ["foo" "bar" "baz_quux.clj"])))
+
+(fact
+ (let [win-root (when-not unix-root "c:")]
+ (absolute? (str win-root "/foo/bar")) => true
+ (absolute? (str win-root "/foo/")) => true
+ (absolute? "foo/bar") => false
+ (absolute? "foo/") => false))
+
+(defmacro run-java-7-tests []
+ (when (try (import '[java.nio.file Files Path LinkOption StandardCopyOption FileAlreadyExistsException]
+ '[java.nio.file.attribute FileAttribute])
+ (catch Exception _ nil))
+ '(do
+ ;; BB-TEST-PATCH: change path to match bb folders
+ (def test-files-path "test-resources/lib_tests/me/raynes/testfiles")
+
+ (fact
+ (let [files (find-files test-files-path #"ggg\.*")
+ gggs (map #(file (str test-files-path "/ggg." %)) '(gz tar zip))]
+ (every? (set gggs) files) => true))
+
+ (fact
+ (let [fs1 (find-files test-files-path #"ggg\.*")
+ fs2 (find-files* test-files-path #(re-matches #"ggg\.*" (.getName %)))]
+ (= fs1 fs2) => true))
+
+ (fact
+ (let [f (touch (io/file test-files-path ".hidden"))]
+ (hidden? f)
+ (delete f)))
+
+ (fact
+ (let [target (io/file test-files-path "ggg.tar")
+ hard (link (io/file test-files-path "hard.link") target)]
+ (file? hard) => true
+ (delete hard)))
+
+ (when fs-supports-symlinks?
+ (fact
+ (let [target (io/file test-files-path "ggg.tar")
+ soft (sym-link (io/file test-files-path "soft.link") target)]
+ (file? soft) => true
+ (link? soft) => true
+ (= (read-sym-link soft) target)
+ (delete soft)))
+
+ (fact
+ (let [soft (sym-link (io/file test-files-path "soft.link") test-files-path)]
+ (link? soft) => true
+ (file? soft) => false
+ (directory? soft) => true
+ (directory? soft LinkOption/NOFOLLOW_LINKS) => false
+ (delete soft)))
+
+ (fact
+ (let [root (create-walk-dir)
+ soft-a (sym-link (io/file root "soft-a.link") (io/file root "a"))
+ soft-b (sym-link (io/file root "soft-b.link") (io/file root "b"))]
+ (delete-dir soft-a LinkOption/NOFOLLOW_LINKS)
+ (exists? (io/file root "a" "2")) => true
+ (delete-dir soft-b)
+ (exists? (io/file root "b" "3")) => false
+ (delete-dir root)
+ (exists? root) => false)))
+
+ (fact "`move` moves files"
+ (let [source (io/file test-files-path "foo")
+ target (io/file test-files-path "foo.moved")
+ existing-target (io/file test-files-path "bar")]
+ (move source target)
+ (exists? target) => true
+ (exists? source) => false
+ (move target source)
+ (exists? target) => false
+ (exists? source) => true
+; (move source existing-target) => (throws FileAlreadyExistsException)
+ (copy source target)
+ (move source target StandardCopyOption/REPLACE_EXISTING)
+ (exists? target) => true
+ (exists? source) => false
+ (move target source))))))
+
+(run-java-7-tests)
diff --git a/test-resources/lib_tests/me/raynes/mock_midje.clj b/test-resources/lib_tests/me/raynes/mock_midje.clj
new file mode 100644
index 00000000..6724496f
--- /dev/null
+++ b/test-resources/lib_tests/me/raynes/mock_midje.clj
@@ -0,0 +1,38 @@
+;; BB-TEST-PATCH: add this file to mock the midje 'fact' macro
+
+(ns me.raynes.mock-midje
+ (:require [rewrite-clj.paredit :as rcp]
+ [rewrite-clj.zip :as rcz]
+ [clojure.string :as str]
+ [clojure.test :refer [deftest is testing]]))
+
+(defn- up-until-nil [z]
+ (if-let [new-z (rcz/up z)]
+ (recur new-z)
+ z))
+
+(defn- replace-arrow [form-zipper-at-arrow]
+ (let [lhs (-> form-zipper-at-arrow rcz/left rcz/node)
+ rhs (-> form-zipper-at-arrow rcz/right rcz/node)]
+ (-> form-zipper-at-arrow
+ (rcp/wrap-around :list)
+ rcp/slurp-backward
+ rcp/slurp-forward
+ rcz/up
+ (rcz/replace `(is (= ~lhs ~rhs)))
+ up-until-nil)))
+
+(defn- replace-arrows [form-zipper]
+ (if-let [next-arrow (rcz/find-next-value form-zipper rcz/next '=>)]
+ (let [rd (replace-arrow next-arrow)]
+ (recur rd))
+ (rcz/sexpr form-zipper)))
+
+(defmacro fact
+ "mockup of midje's fact that just transforms `=>` into `is` checks and uses deftest"
+ [& _] ;operating on &form
+ (let [[nameish body] (if (string? (second &form))
+ [(str/replace (second &form) #"[^\w\d]" "-") (nnext &form)]
+ ["test" (next &form)])
+ transformed-body (replace-arrows (rcz/of-string (pr-str body)))]
+ `(deftest ~(gensym nameish) ~@transformed-body)))
diff --git a/test-resources/lib_tests/me/raynes/testfiles/bar b/test-resources/lib_tests/me/raynes/testfiles/bar
new file mode 100644
index 00000000..e69de29b
diff --git a/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2 b/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2
new file mode 100644
index 00000000..5910bdb8
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2 differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/foo b/test-resources/lib_tests/me/raynes/testfiles/foo
new file mode 100644
index 00000000..e69de29b
diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.gz b/test-resources/lib_tests/me/raynes/testfiles/ggg.gz
new file mode 100644
index 00000000..09cf4842
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.gz differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.tar b/test-resources/lib_tests/me/raynes/testfiles/ggg.tar
new file mode 100644
index 00000000..c83a6633
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.tar differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.zip b/test-resources/lib_tests/me/raynes/testfiles/ggg.zip
new file mode 100644
index 00000000..eaddda38
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.zip differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/xxx.xz b/test-resources/lib_tests/me/raynes/testfiles/xxx.xz
new file mode 100644
index 00000000..f36dec0d
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/xxx.xz differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar
new file mode 100644
index 00000000..264b2506
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar differ
diff --git a/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip
new file mode 100644
index 00000000..38b3f499
Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip differ
diff --git a/test-resources/lib_tests/slingshot/slingshot_test.clj b/test-resources/lib_tests/slingshot/slingshot_test.clj
index f787a862..f9e7c541 100644
--- a/test-resources/lib_tests/slingshot/slingshot_test.clj
+++ b/test-resources/lib_tests/slingshot/slingshot_test.clj
@@ -36,7 +36,8 @@
[:class-string e#])
;; by clojure record type
- (catch exception-record e#
+ ;; BB test patch, exception-record != class?, so this expands into incorrect code
+ #_(catch exception-record e#
[:class-exception-record e#])
;; by key-value
diff --git a/test-resources/line_number_test_test.clj b/test-resources/line_number_test_test.clj
new file mode 100644
index 00000000..e3d3fdba
--- /dev/null
+++ b/test-resources/line_number_test_test.clj
@@ -0,0 +1,7 @@
+(ns line-number-test-test
+ (:require [clojure.test :refer [is deftest run-tests]]))
+
+(deftest test-is
+ (is false))
+
+(run-tests 'line-number-test-test)
diff --git a/test-resources/pod b/test-resources/pod
new file mode 100755
index 00000000..3dbc993f
--- /dev/null
+++ b/test-resources/pod
@@ -0,0 +1,11 @@
+#!/usr/bin/env bash
+
+dir=$(dirname "$0")
+
+export BABASHKA_POD=true
+
+if [[ $BABASHKA_TEST_ENV == "native" ]]; then
+ exec "${dir}"/../bb "${dir}"/pod.clj
+else
+ exec clojure -M:test-pod
+fi
diff --git a/test-resources/pod.clj b/test-resources/pod.clj
index cd57ea17..698471e0 100644
--- a/test-resources/pod.clj
+++ b/test-resources/pod.clj
@@ -104,14 +104,14 @@
"id" id})
pod.test-pod/print
(do (write
- {"out" (pr-str args)
+ {"out" (prn-str args)
"id" id})
(write
{"status" ["done"]
"id" id}))
pod.test-pod/print-err
(do (write
- {"err" (pr-str args)
+ {"err" (prn-str args)
"id" id})
(write
{"status" ["done"]
@@ -125,7 +125,8 @@
:shutdown (System/exit 0))))))))
(let [cli-args (set *command-line-args*)]
- (if (contains? cli-args "--run-as-pod")
+ (if (or (= "true" (System/getenv "BABASHKA_POD"))
+ (contains? cli-args "--run-as-pod"))
(do (debug "running pod with cli args" cli-args)
(run-pod cli-args))
(let [native? (contains? cli-args "--native")
diff --git a/test-resources/pod_tests/bootleg.clj b/test-resources/pod_tests/bootleg.clj
new file mode 100644
index 00000000..e8312442
--- /dev/null
+++ b/test-resources/pod_tests/bootleg.clj
@@ -0,0 +1,7 @@
+(ns pod-tests.bootleg
+ (:require [pod.retrogradeorbit.bootleg.utils :as utils]))
+
+(defn -main [& args]
+ (-> [:div
+ [:p "Test"]]
+ (utils/convert-to :html)))
diff --git a/test-resources/pod_tests/local.clj b/test-resources/pod_tests/local.clj
new file mode 100644
index 00000000..f564bc12
--- /dev/null
+++ b/test-resources/pod_tests/local.clj
@@ -0,0 +1,5 @@
+(ns pod-tests.local
+ (:require [pod.test-pod :as pod]))
+
+(defn -main [& args]
+ (println (pod/add-sync 40 2)))
diff --git a/test/babashka/async_test.clj b/test/babashka/async_test.clj
index f2be1a35..7fd1050c 100644
--- a/test/babashka/async_test.clj
+++ b/test/babashka/async_test.clj
@@ -33,3 +33,12 @@
(is (number? (edn/read-string (test-utils/bb nil "
(def ^:dynamic x 0)
(binding [x 10] (async/Test
\"\n"
+ (test-utils/bb nil "-m" "pod-tests.bootleg"))))))
+
+(deftest ^:skip-windows local-pod-test
+ (test-utils/with-config
+ (pr-str '{:paths ["test-resources"]
+ :pods {pod/test-pod {:path "test-resources/pod"}}})
+ (is (= "42\n" (test-utils/bb nil "-m" "pod-tests.local")))))
+
+(deftest tag-test
+ (test-utils/with-config
+ "{:deps {}
+ :aliases {:foo {:env-vars {:dude #env \"DUDE\"}}}}"
+ (is (= 6 (bb "-e" "(+ 1 2 3)")))))
+
+(deftest merge-deps-test
+ (test-utils/with-config
+ "{:deps {}}"
+ (is (= {1 {:a 1}}
+ (bb "-Sdeps" "{:deps {medley/medley {:mvn/version \"1.4.0\"}}}" "-e" "(require 'medley.core) (medley.core/index-by :a [{:a 1}])")))))
diff --git a/test/babashka/classes_test.clj b/test/babashka/classes_test.clj
new file mode 100644
index 00000000..31b7872e
--- /dev/null
+++ b/test/babashka/classes_test.clj
@@ -0,0 +1,11 @@
+(ns babashka.classes-test
+ (:require [babashka.test-utils :as tu]
+ [clojure.edn :as edn]
+ [clojure.test :as t :refer [deftest is testing]]))
+
+(defn bb
+ [& args]
+ (edn/read-string (apply tu/bb nil (map pr-str args))))
+
+(deftest all-classes-test
+ (is (true? (bb '(let [classes (babashka.classes/all-classes)] (and (seq classes) (every? class? classes)))))))
diff --git a/test/babashka/crypto_test.clj b/test/babashka/crypto_test.clj
index 08549691..48503f69 100644
--- a/test/babashka/crypto_test.clj
+++ b/test/babashka/crypto_test.clj
@@ -17,7 +17,10 @@
(deftest hmac-sha-256-test
(let [key-s "some-key"
data "some-data"
- expected-sha (String. (hmac-sha-256 (.getBytes key-s) data))]
+ expected-sha (String. (.encode (java.util.Base64/getEncoder)
+ (hmac-sha-256 (.getBytes key-s) data))
+ "utf-8")]
+ (prn expected-sha)
(is (= expected-sha (bb '(do (ns net
(:import (javax.crypto Mac)
(javax.crypto.spec SecretKeySpec)))
@@ -28,4 +31,6 @@
(.doFinal mac (.getBytes data "UTF-8"))))
(let [key-s "some-key"
data "some-data"]
- (String. (hmac-sha-256 (.getBytes key-s) data)))))))))
+ (String. (.encode (java.util.Base64/getEncoder)
+ (hmac-sha-256 (.getBytes key-s) data))
+ "utf-8"))))))))
diff --git a/test/babashka/deps_test.clj b/test/babashka/deps_test.clj
index 397a01f9..e130e680 100644
--- a/test/babashka/deps_test.clj
+++ b/test/babashka/deps_test.clj
@@ -35,6 +35,7 @@
(bb (pr-str `(do (babashka.deps/add-deps '{:deps {babashka/process {:git/url "https://github.com/babashka/process" :sha "4c6699d06b49773d3e5c5b4c11d3334fb78cc996"}}}
{:force true
:env {"PATH" (System/getenv "PATH")
+ "JAVA_HOME" (System/getenv "JAVA_HOME")
"GITLIBS" ~(str libs-dir)}}) nil)))
(bb (pr-str `(do (babashka.deps/add-deps '{:deps {babashka/process {:git/url "https://github.com/babashka/process" :sha "4c6699d06b49773d3e5c5b4c11d3334fb78cc996"}}}
{:force true
@@ -65,6 +66,14 @@ true
(-> (babashka.deps/clojure [\"-M\" \"-e\" \"(+ 1 2 3)\"] {:out :string})
(p/check)
:out)
+"))))
+ (is (= "6\n" (test-utils/normalize (bb "
+(require '[babashka.deps :as deps])
+(require '[babashka.process :as p])
+
+(-> (babashka.deps/clojure {:out :string} \"-M\" \"-e\" \"(+ 1 2 3)\")
+ (p/check)
+ :out)
"))))
(when-not test-utils/native?
(is (thrown-with-msg? Exception #"Option changed" (bb "
@@ -86,6 +95,7 @@ true
libs-dir2 (fs/file tmp-dir ".gitlibs2")
template (pr-str '(do (babashka.deps/clojure ["-Sforce" "-Spath" "-Sdeps" "{:deps {babashka/process {:git/url \"https://github.com/babashka/process\" :sha \"4c6699d06b49773d3e5c5b4c11d3334fb78cc996\"}}}"]
{:out :string :env-key {"PATH" (System/getenv "PATH")
+ "JAVA_HOME" (System/getenv "JAVA_HOME")
"GITLIBS" :gitlibs}}) nil))]
(bb (-> template (str/replace ":gitlibs" (pr-str (str libs-dir)))
(str/replace ":env-key" ":env")))
diff --git a/test/babashka/error_test.clj b/test/babashka/error_test.clj
index fba11c14..e82a7175 100644
--- a/test/babashka/error_test.clj
+++ b/test/babashka/error_test.clj
@@ -1,24 +1,29 @@
(ns babashka.error-test
+ {:clj-kondo/config '{:linters {:unresolved-symbol {:exclude [match?]}}}}
(:require
[babashka.test-utils :as tu]
[clojure.java.io :as io]
[clojure.string :as str]
- [clojure.test :as t :refer [deftest is testing]]))
+ [clojure.test :as t :refer [deftest is testing]]
+ [matcher-combinators.test]))
-(defn multiline-equals [s1 s2]
- (let [lines-s1 (str/split-lines s1)
- lines-s2 (str/split-lines s2)
- max-lines (max (count lines-s1) (count lines-s2))]
- (run! (fn [i]
- (let [l1 (get lines-s1 i)
- l2 (get lines-s2 i)]
- (if (and l1 l2)
- (is (= l1 l2)
- (format "Lines did not match.\nLine: %s\nLeft: %s\nRight: %s"
- i (pr-str l1) (pr-str l2)))
- (is false (format "Out of lines at line: %s.\nLeft: %s\nRight: %s"
- i (pr-str l1) (pr-str l2))))))
- (range max-lines))))
+(defmacro multiline-equals [s1 s2]
+ `(let [lines-s1# (str/split-lines ~s1)
+ lines-s2# (str/split-lines ~s2)
+ max-lines# (max (count lines-s1#) (count lines-s2#))
+ lines-s1# (take max-lines# lines-s1#)
+ lines-s2# (take max-lines# lines-s2#)]
+ (is (~'match? (map str/trimr lines-s1#) (map str/trimr lines-s2#)))
+ #_(run! (fn [i]
+ (let [l1 (get lines-s1 i)
+ l2 (get lines-s2 i)]
+ (if (and l1 l2)
+ (is (= l1 l2)
+ (format "Lines did not match.\nLine: %s\nLeft: %s\nRight: %s"
+ i (pr-str l1) (pr-str l2)))
+ (is false (format "Out of lines at line: %s.\nLeft: %s\nRight: %s"
+ i (pr-str l1) (pr-str l2))))))
+ (range max-lines))))
(deftest stacktrace-from-script-test
(try (tu/bb nil (.getPath (io/file "test" "babashka" "scripts" "divide_by_zero.bb")))
@@ -122,7 +127,7 @@ Phase: macroexpand
----- Context ------------------------------------------------------------------
1: (defmacro foo [x] (subs nil 1) `(do ~x ~x)) (foo 1)
- ^---
+ ^---
----- Stack trace --------------------------------------------------------------
clojure.core/subs -
@@ -140,7 +145,7 @@ Location: :1:35
----- Context ------------------------------------------------------------------
1: (defmacro foo [x] `(subs nil ~x)) (foo 1)
- ^---
+ ^---
----- Stack trace --------------------------------------------------------------
clojure.core/subs -
@@ -156,7 +161,7 @@ Location: :1:15
----- Context ------------------------------------------------------------------
1: (defn quux [] (subs nil 1)) (defmacro foo [x & xs] `(do (quux) ~x)) (defn bar [] (foo 1)) (bar)
- ^---
+ ^---
----- Stack trace --------------------------------------------------------------
clojure.core/subs -
@@ -178,7 +183,11 @@ Location: :1:27
----- Context ------------------------------------------------------------------
1: (let [d {:zero 0 :one 1}] (throw (ex-info \"some msg\" d)))
- ^--- some msg")))
+ ^--- some msg
+
+----- Stack trace --------------------------------------------------------------
+user - :1:27
+user - :1:1")))
(testing "output of ordinary Exception"
(let [output (try (tu/bb nil "(throw (Exception. \"some msg\"))")
@@ -191,15 +200,19 @@ Location: :1:1
----- Context ------------------------------------------------------------------
1: (throw (Exception. \"some msg\"))
- ^--- some msg"))))
+ ^--- some msg
+
+----- Stack trace --------------------------------------------------------------
+user - :1:1"))))
(deftest debug-exception-print-test
(testing "debug mode includes locals and exception data in output"
(let [output (try (tu/bb nil "--debug" "(let [x 1] (/ x 0))")
(is false) ; ensure that exception is thrown and we don't get here
- (catch Exception e (ex-message e)))]
- (is (str/includes? (tu/normalize output)
- "----- Error --------------------------------------------------------------------
+ (catch Exception e (ex-message e)))
+ actual-lines (str/split-lines (tu/normalize output))]
+ (is (match? (take 16 actual-lines)
+ (str/split-lines "----- Error --------------------------------------------------------------------
Type: java.lang.ArithmeticException
Message: Divide by zero
Location: :1:12
@@ -211,18 +224,21 @@ Location: :1:12
----- Stack trace --------------------------------------------------------------
clojure.core// -
user - :1:12
+user - :1:1
----- Exception ----------------------------------------------------------------
-clojure.lang.ExceptionInfo: Divide by zero
-{:type :sci/error, :line 1, :column 12, :message \"Divide by zero\",")))))
+clojure.lang.ExceptionInfo: Divide by zero")))
+ (is (str/includes? (nth actual-lines 16)
+ "{:type :sci/error, :line 1, :column 12, :message \"Divide by zero\",")))))
(deftest macro-test
(let [output (try (tu/bb nil "--debug" "(defmacro foo [x] (subs nil 1) `(do ~x ~x)) (foo 1)")
(is false)
(catch Exception e (ex-message e)))
- output (tu/normalize output)]
- (is (str/includes? output
- "----- Error --------------------------------------------------------------------
+ output (tu/normalize output)
+ actual-lines (str/join "\n" (take 17 (str/split-lines output)))]
+ (multiline-equals actual-lines
+ "----- Error --------------------------------------------------------------------
Type: java.lang.NullPointerException
Location: :1:19
Phase: macroexpand
@@ -238,8 +254,7 @@ user/foo - :1:1
user - :1:45
----- Exception ----------------------------------------------------------------
-clojure.lang.ExceptionInfo: null
-{:type :sci/error, :line 1, :column 19"))))
+clojure.lang.ExceptionInfo: null")))
(deftest native-stacktrace-test
(let [output (try (tu/bb nil "(merge 1 2 3)")
diff --git a/test/babashka/exec_test.clj b/test/babashka/exec_test.clj
new file mode 100644
index 00000000..4a990520
--- /dev/null
+++ b/test/babashka/exec_test.clj
@@ -0,0 +1,49 @@
+(ns babashka.exec-test
+ (:require
+ [babashka.test-utils :as u]
+ [cheshire.core :as cheshire]
+ [clojure.edn :as edn]
+ [clojure.test :as t :refer [deftest is testing]]))
+
+(defn bb [& args]
+ (apply u/bb nil args))
+
+(deftest exec-test
+ (is (= {:foo 1} (edn/read-string (bb "-x" "prn" "--foo" "1"))))
+ (is (thrown? Exception (bb "-x" "json/generate-string" "--foo" "1")))
+ (is (= {:foo 1} (cheshire/parse-string
+ (edn/read-string
+ (bb "-x" "cheshire.core/generate-string" "--foo" "1")) true))))
+
+(deftest tasks-exec-test
+ (u/with-config
+ "{:deps {}
+ :tasks {foo (exec 'clojure.core/prn)}}"
+ (is (= {:dude 1} (edn/read-string (bb "run" "foo" "--dude" "1")))))
+ (u/with-config
+ "{:deps {}
+ :tasks {foo (exec 'clojure.core/prn)}}"
+ (is (= {:dude 1} (edn/read-string (bb "run" "foo" "--dude" "1")))))
+ (u/with-config
+ "{:deps {}
+ :tasks {foo {:org.babashka/cli {:coerce {:dude []}}
+ :task (exec 'clojure.core/prn)}}}"
+ (is (= {:dude [1]} (edn/read-string (bb "run" "foo" "--dude" "1")))))
+ (u/with-config
+ "{:deps {}
+ :tasks {foo {:task (exec 'babashka.exec-test/exec-test)}}}"
+ (is (= {:foo [1], :bar :yeah}
+ (edn/read-string (bb "-cp" "test-resources" "run" "foo" "--foo" "1" "--bar" "yeah")))))
+ (testing "task exec args"
+ (u/with-config
+ "{:deps {}
+ :tasks {foo {:exec-args {:foo :bar}
+ :task (exec 'babashka.exec-test/exec-test)}}}"
+ (is (= {:foo :bar, :bar :yeah}
+ (edn/read-string (bb "-cp" "test-resources" "run" "foo" "--bar" "yeah"))))))
+ (testing "meta"
+ (u/with-config
+ "{:deps {}
+ :tasks {foo {:task (exec 'babashka.exec-test/exec-test)}}}"
+ (is (= #:org.babashka{:cli {:args ["dude"]}}
+ (edn/read-string (bb "-cp" "test-resources" "run" "foo" "dude" "--bar" "yeah" "--meta")))))))
diff --git a/test/babashka/impl/socket_repl_test.clj b/test/babashka/impl/socket_repl_test.clj
index 5e6e587c..5699b456 100644
--- a/test/babashka/impl/socket_repl_test.clj
+++ b/test/babashka/impl/socket_repl_test.clj
@@ -10,6 +10,7 @@
[clojure.java.io :as io]
[clojure.string :as str]
[clojure.test :as t :refer [deftest is testing]]
+ [sci.ctx-store :as ctx-store]
[sci.impl.opts :refer [init]]))
(set! *warn-on-reflection* true)
@@ -19,7 +20,7 @@
reader (io/reader socket)
sw (java.io.StringWriter.)
writer (io/writer socket)]
- (binding [*out* writer]
+ (binding [*out* writer]
(println (str expr "\n")))
(loop []
(when-let [l (try (.readLine ^java.io.BufferedReader reader)
@@ -48,7 +49,7 @@
(if tu/jvm?
(let [ctx (init {:namespaces {'clojure.core.server clojure-core-server-namespace}
:features #{:bb}})]
- (vreset! common/ctx ctx)
+ (ctx-store/reset-ctx! ctx)
(start-repl! "0.0.0.0:1666" ctx))
(do (vreset! server-process
(p/process ["./bb" "socket-repl" "localhost:1666"]))
@@ -68,7 +69,7 @@
(finally
(if tu/jvm?
(do (stop-repl!)
- (vreset! common/ctx nil)
+ (ctx-store/reset-ctx! nil)
(Thread/sleep 100))
(p/destroy-tree @server-process))))))
@@ -81,7 +82,7 @@
:env (atom {})
:namespaces {'clojure.core.server clojure-core-server-namespace}
:features #{:bb}})]
- (vreset! common/ctx ctx)
+ (ctx-store/reset-ctx! ctx)
(start-repl! "{:address \"localhost\" :accept clojure.core.server/repl :port 1666}"
ctx))
(do (vreset! server-process
@@ -92,7 +93,7 @@
(finally
(if tu/jvm?
(do (stop-repl!)
- (vreset! common/ctx nil)
+ (ctx-store/reset-ctx! nil)
(Thread/sleep 100))
(p/destroy-tree @server-process))))))
@@ -105,7 +106,7 @@
:env (atom {})
:namespaces {'clojure.core.server clojure-core-server-namespace}
:features #{:bb}})]
- (vreset! common/ctx ctx)
+ (ctx-store/reset-ctx! ctx)
(start-repl! "{:address \"localhost\" :accept clojure.core.server/io-prepl :port 1666}"
ctx))
(do (vreset! server-process
@@ -120,7 +121,7 @@
(finally
(if tu/jvm?
(do (stop-repl!)
- (vreset! common/ctx nil)
+ (ctx-store/reset-ctx! nil)
(Thread/sleep 100))
(p/destroy-tree @server-process))))))
diff --git a/test/babashka/main_test.clj b/test/babashka/main_test.clj
index 976d2644..28102ba8 100644
--- a/test/babashka/main_test.clj
+++ b/test/babashka/main_test.clj
@@ -60,7 +60,12 @@
(is (:feature/xml v)))
(is (= {:force? true} (parse-opts ["--force"])))
(is (= {:main "foo", :command-line-args '("-h")} (parse-opts ["-m" "foo" "-h"])))
- (is (= {:main "foo", :command-line-args '("-h")} (parse-opts ["-m" "foo" "--" "-h"]))))
+ (is (= {:main "foo", :command-line-args '("-h")} (parse-opts ["-m" "foo" "--" "-h"])))
+ (is (= {:force? true :list-tasks true :command-line-args nil} (parse-opts ["--force" "tasks"])))
+ (is (= {:force? true :run "sometask" :command-line-args nil} (parse-opts ["--force" "run" "sometask"])))
+ (is (= {:force? true :repl true} (parse-opts ["--force" "repl"])))
+ (is (= {:force? true :clojure true :command-line-args '("-M" "-r")}
+ (parse-opts ["--force" "clojure" "-M" "-r"]))))
(deftest version-test
(is (= [1 0 0] (main/parse-version "1.0.0-SNAPSHOT")))
@@ -825,6 +830,19 @@ true")))
(is (= :f (bb nil "(first (into-array [:f]))")))
(is (= :f (bb nil "(first (first (into-array [(into-array [:f])])))"))))
+(deftest var-names-test
+ (testing "for all public vars, ns/symbol from ns map matches metadata"
+ (is (empty? (bb nil (.getPath (io/file "test" "babashka" "scripts" "check_var_names.bb")))))))
+
+(deftest clojure-lang-var-mapping-test
+ (is (= :var (bb nil "(defprotocol Foo (foo [_])) (extend-protocol Foo clojure.lang.Var (foo [_] :var)) (foo #'inc)"))))
+
+(deftest clojure-ns-test
+ (is (true? (bb nil "(instance? clojure.lang.Namespace *ns*)"))))
+
+(deftest index-of-test
+ (is (= 1 (bb nil "(.indexOf (map inc [1 2 3]) 3)"))))
+
;;;; Scratch
(comment
diff --git a/test/babashka/pprint_test.clj b/test/babashka/pprint_test.clj
new file mode 100644
index 00000000..d21c3386
--- /dev/null
+++ b/test/babashka/pprint_test.clj
@@ -0,0 +1,22 @@
+(ns babashka.pprint-test
+ (:require
+ [babashka.test-utils :as test-utils]
+ [clojure.string :as str]
+ [clojure.test :as test :refer [deftest is]]))
+
+(defn bb [& args]
+ (str/trim (apply test-utils/bb (map str args))))
+
+(deftest print-length-test
+ (is (= "(0 1 2 3 4 5 6 7 8 9 ...)"
+ (bb "-e" "(set! *print-length* 10) (clojure.pprint/pprint (range 20))"))))
+
+(deftest print-namespaced-map-test
+ (test/testing
+ "Testing disabling of printing namespace maps..."
+ (is (= "{:a/x 1, :a/y 2, :a/z {:b/x 10, :b/y 20}}"
+ (bb "-e" "(binding [*print-namespace-maps* false] (clojure.pprint/pprint {:a/x 1 :a/y 2 :a/z {:b/x 10 :b/y 20}}))"))))
+ (test/testing
+ "Testing manually enabling printing namespace maps..."
+ (is (= "#:a{:x 1, :y 2, :z #:b{:x 10, :y 20}}"
+ (bb "-e" "(binding [*print-namespace-maps* true] (clojure.pprint/pprint {:a/x 1 :a/y 2 :a/z {:b/x 10 :b/y 20}}))")))))
diff --git a/test/babashka/proxy_test.clj b/test/babashka/proxy_test.clj
index 496f6449..109f15e0 100644
--- a/test/babashka/proxy_test.clj
+++ b/test/babashka/proxy_test.clj
@@ -78,3 +78,51 @@
true
false]
(bb (with-out-str (clojure.pprint/pprint code))))))
+
+(deftest PipedInputStream-PipedOutputStream-proxy-test
+ (is (= {:available 1
+ :read-result -1
+ :byte-read 10
+ :array-read '(0 0 0 0 0 0 10 0 0 0 0 0 0 0 0 0)
+ :instance? true}
+ (bb (with-out-str
+ (clojure.pprint/pprint
+ '(let [ins (proxy [java.io.PipedInputStream] []
+ (available [] 1)
+ (close [] nil)
+ (read
+ ([] 10)
+ ([byte-arr off len]
+ (aset byte-arr off (byte 10))
+ -1))
+ (receive [b]
+ nil))
+ arr (byte-array 16)
+ ]
+ {:available (.available ins)
+ :read-result (.read ins arr 6 2)
+ :byte-read (.read ins)
+ :array-read (seq arr)
+ :instance? (instance? java.io.PipedInputStream ins)}))))))
+
+ (is (= {:instance? true
+ :arr '(1 2 3 4 5 0 0 0)
+ :arr2 '(10)}
+ (bb (with-out-str
+ (clojure.pprint/pprint
+ '(let [arr (byte-array 8)
+ arr2 (byte-array 1)
+ outs (proxy [java.io.PipedOutputStream] []
+ (close [] nil)
+ (connect [sink] nil)
+ (flush [] nil)
+ (write
+ ([b] (aset arr2 0 (byte b)))
+ ([byte-arr off len]
+ (doseq [n (range len)]
+ (aset arr n (aget byte-arr (+ off n)))))))]
+ (.write outs (int 10))
+ (.write outs (byte-array [0 0 0 1 2 3 4 5 0 0 0]) 3 5)
+ {:instance? (instance? java.io.PipedOutputStream outs)
+ :arr (seq arr)
+ :arr2 (seq arr2)})))))))
diff --git a/test/babashka/reify_test.clj b/test/babashka/reify_test.clj
index 72624c65..a9911dd7 100644
--- a/test/babashka/reify_test.clj
+++ b/test/babashka/reify_test.clj
@@ -2,6 +2,7 @@
(:require
[babashka.test-utils :as test-utils]
[clojure.edn :as edn]
+ [clojure.string :as str]
[clojure.test :as test :refer [deftest is testing]]))
(defn bb [input & args]
@@ -51,12 +52,22 @@
]")))))
(deftest reify-object
+ (testing "empty methods"
+ (is (str/starts-with?
+ (bb nil "
+(str (reify Object))")
+ "babashka.impl.reify")))
(testing "toString"
(is (= ":foo"
(bb nil "
(def m (reify Object
(toString [_] (str :foo))))
(str m)
+"))))
+ (testing "toString + protocol"
+ (is (= ":dude1:dude2"
+ (bb nil "
+(defprotocol Dude (dude [_])) (def obj (reify Object (toString [_] (str :dude1)) Dude (dude [_] :dude2))) (str (str obj) (dude obj))
"))))
(testing "Hashcode still works when only overriding toString"
(is (number?
@@ -97,3 +108,48 @@
[x y] (bb nil prog)]
(is (pos? x))
(is (zero? y))))
+
+(deftest reify-default-method-test
+ (let [prog '(do (def iter (let [coll [:a :b :c] idx (volatile! -1)]
+ (reify java.util.Iterator (hasNext [_] (< @idx 2))
+ (next [_] (nth coll (vswap! idx inc))))))
+ (def res (volatile! []))
+ (vswap! res conj (.hasNext iter))
+ (vswap! res conj (.next iter))
+ (.forEachRemaining
+ iter (reify java.util.function.Consumer (accept [_ x] (vswap! res conj x))))
+ (= [true :a :b :c] @res))]
+ (is (true? (bb nil prog)))))
+
+(deftest reify-multiple-interfaces-test
+ (testing "throws exception"
+ (is (thrown?
+ clojure.lang.ExceptionInfo
+ (bb nil "
+(reify
+ java.lang.Object (toString [_] \"foo\")
+ clojure.lang.Seqable (seq [_] '(1 2 3)))")))))
+
+(deftest reify-runnable-and-garbage-collection-test
+ (is (bb nil "
+(def cleaner (java.lang.ref.Cleaner/create))
+(def deleted? (atom false))
+(defn make-cleanable-ref []
+ (let [obj (Object.)]
+ (.register cleaner obj
+ (reify java.lang.Runnable
+ (run [_]
+ (reset! deleted? true))))
+ nil))
+(defn force-gc []
+ (let [t (atom (Object.))
+ wr (java.lang.ref.WeakReference. @t)]
+ (reset! t nil)
+ (while (or (.get wr)
+ (not @deleted?))
+ (System/gc)
+ (System/runFinalization))))
+(make-cleanable-ref)
+(force-gc)
+@deleted?
+")))
diff --git a/test/babashka/scripts/check_var_names.bb b/test/babashka/scripts/check_var_names.bb
new file mode 100644
index 00000000..a689cb05
--- /dev/null
+++ b/test/babashka/scripts/check_var_names.bb
@@ -0,0 +1,14 @@
+(require '[clojure.string :as str])
+(let [ns-maps (->> (all-ns)
+ (map (fn [nmspc] [(ns-name nmspc) (ns-publics nmspc)]))
+ (into {})) ; a map of { ns-name {symbol var, ...}}
+ ns-maps (update ns-maps 'user #(dissoc % '*input*))] ; *input* is a special case that we'll skip over
+ (->>
+ (for [[ns-nm _] ns-maps
+ [sym vr] (ns-maps ns-nm)
+ :let [{var-meta-ns :ns, var-meta-name :name} (meta vr)
+ var-meta-ns-name (some-> var-meta-ns ns-name)]]
+ ; build a seq of maps containing the ns/symbol from the ns and the ns/symbol from the var's metadata
+ {:actual-ns ns-nm :actual-ns-symbol sym :var-meta-ns var-meta-ns-name :var-meta-name var-meta-name})
+ ; and remove the matches
+ (remove #(and (= (:actual-ns %) (:var-meta-ns %)) (= (:actual-ns-symbol %) (:var-meta-name %))))))
diff --git a/test/babashka/test_test.clj b/test/babashka/test_test.clj
index d88c3fd5..b0ad6da5 100644
--- a/test/babashka/test_test.clj
+++ b/test/babashka/test_test.clj
@@ -108,3 +108,13 @@
(t/with-test-out (t/run-tests *ns*)))
(str/includes? (str sw) \"Ran 1 tests containing 2 assertions.\"))")]
(is (str/includes? output "true"))))
+
+(deftest line-number-test
+ (is (str/includes? (bb "test-resources/line_number_test_test.clj")
+ "line_number_test_test.clj:4")))
+
+(deftest testing-vars-str-test
+ (is (str/includes?
+ (bb "(clojure.test/testing-vars-str {:file \"x\" :line 1})")
+ "() (x:1)")
+ "includes explicit line number + file name in test report"))
diff --git a/test/babashka/test_utils.clj b/test/babashka/test_utils.clj
index d9c24cd1..9a856a96 100644
--- a/test/babashka/test_utils.clj
+++ b/test/babashka/test_utils.clj
@@ -81,8 +81,8 @@
(do
(println (str os))
(throw (ex-info (str es)
- {:stdout (str os)
- :stderr (str es)}))))))
+ {:stdout (str os)
+ :stderr (str es)}))))))
(finally
(when (string? input-or-opts) (vars/bindRoot sci/in *in*))
(vars/bindRoot sci/out *out*)
diff --git a/test/babashka/uberjar_test.clj b/test/babashka/uberjar_test.clj
index 66d94a13..4476f45a 100644
--- a/test/babashka/uberjar_test.clj
+++ b/test/babashka/uberjar_test.clj
@@ -1,16 +1,23 @@
(ns babashka.uberjar-test
(:require
- [babashka.main :as main]
- [babashka.test-utils :as tu]
- [clojure.string :as str]
- [clojure.test :as t :refer [deftest is testing]]))
+ [babashka.fs :as fs]
+ [babashka.main :as main]
+ [babashka.test-utils :as tu]
+ [clojure.edn :as edn]
+ [clojure.string :as str]
+ [clojure.test :as t :refer [deftest is testing]])
+ (:import (java.io File InputStreamReader PushbackReader)
+ (java.util.jar JarFile)))
+
+(defn jar-entries [jar]
+ (with-open [jar-file (JarFile. jar)]
+ (doall (enumeration-seq (.entries jar-file)))))
(defn count-entries [jar]
- (with-open [jar-file (java.util.jar.JarFile. jar)]
- (count (map #_prn
- identity
- (enumeration-seq
- (.entries jar-file))))))
+ (-> jar jar-entries count))
+
+(defn get-entry [^File jar entry-name]
+ (-> jar JarFile. (.getEntry entry-name)))
(deftest uberjar-test
(testing "uberjar with --main"
@@ -54,6 +61,24 @@
;; Only a manifest entry is added
(is (< (count-entries path) 3)))))
+(deftest uberjar-with-pods-test
+ (testing "jar contains bb.edn w/ only :pods when bb.edn has :pods"
+ (let [tmp-file (java.io.File/createTempFile "uber" ".jar")
+ path (.getPath tmp-file)]
+ (.deleteOnExit tmp-file)
+ (let [config {:paths ["test-resources/babashka/uberjar/src"]
+ :deps '{local/deps {:local/root "test-resources/babashka/uberjar"}}
+ :pods (cond-> '{org.babashka/go-sqlite3 {:version "0.1.0"}}
+ (not (fs/windows?)) (assoc 'pod/test-pod {:path "test-resources/pod"}))}]
+ (tu/with-config config
+ (tu/bb nil "uberjar" path "-m" "my.main-pod")
+ (let [bb-edn-entry (get-entry tmp-file "META-INF/bb.edn")
+ bb-edn (-> path JarFile. (.getInputStream bb-edn-entry)
+ InputStreamReader. PushbackReader. edn/read)]
+ (is (= #{:pods} (-> bb-edn keys set)))
+ (is (= (:pods config) (:pods bb-edn))))
+ (is (str/includes? (tu/bb nil "--jar" path) "3")))))))
+
(deftest throw-on-empty-classpath
;; this test fails the windows native test in CI
(when-not main/windows?
diff --git a/test/babashka/uberscript_test.clj b/test/babashka/uberscript_test.clj
index 4fbc1af8..9a111b18 100644
--- a/test/babashka/uberscript_test.clj
+++ b/test/babashka/uberscript_test.clj
@@ -1,7 +1,8 @@
(ns babashka.uberscript-test
(:require
[babashka.test-utils :as tu]
- [clojure.test :as t :refer [deftest is]]))
+ [clojure.test :as t :refer [deftest is]]
+ [clojure.string :as str]))
(deftest basic-test
(let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")]
@@ -23,3 +24,12 @@
(is (= ":clojure.string/foo\ntrue\n(\"1\" \"2\" \"3\" \"4\")\n"
(tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4"))))))
+(deftest pods-test
+ (let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")]
+ (.deleteOnExit tmp-file)
+ (tu/with-config (pr-str '{:paths ["test-resources/babashka/uberscript/src"]
+ :pods {org.babashka/go-sqlite3 {:version "0.1.0"}}})
+ (is (empty? (tu/bb nil "uberscript" (.getPath tmp-file) "-m" "my.main-pod")))
+ (is (= 1 (count (re-seq #"load-pod 'org.babashka/go-sqlite3"
+ (str/join (str/split-lines (slurp tmp-file))))))))
+ (is (str/includes? (tu/bb nil "--file" (.getPath tmp-file)) "3"))))
+```
+
+[
+```
+