From b65d1766b24514fe8e6f19b7b89f02aa334da559 Mon Sep 17 00:00:00 2001 From: Gabriel Horner Date: Mon, 27 Dec 2021 11:11:00 -0500 Subject: [PATCH] Convert 8 more test libs using add-libtest Also updated table and added comment for newline test --- deps.edn | 14 +- script/add-libtest.clj | 2 +- .../babashka/lambdaisland/regal_test.clj | 15 - .../lib_tests/babashka/run_all_libtests.clj | 39 +- test-resources/lib_tests/bb-tested-libs.edn | 15 +- .../lib_tests/clj_yaml/core_test.clj | 110 ++++- .../lib_tests/clojure/data/json_test.clj | 1 + .../lib_tests/clojure/test_clojure/instr.clj | 14 +- .../lib_tests/clojure/test_clojure/spec.clj | 9 +- test-resources/lib_tests/doric/test/core.clj | 11 +- .../lib_tests/doric/test/doctest.clj | 93 ++++ .../lib_tests/doric/test/readme.clj | 6 + .../lib_tests/honey/sql/helpers_test.cljc | 3 +- .../lib_tests/honey/sql/postgres_test.cljc | 11 +- test-resources/lib_tests/honey/sql_test.cljc | 100 ++++- .../lib_tests/honeysql/core_test.cljc | 141 ++++-- .../lib_tests/honeysql/format_test.cljc | 14 + .../lambdaisland/regal/malli_test.cljc | 19 + .../lambdaisland/regal/parse_test.cljc | 29 ++ .../lib_tests/lambdaisland/regal/re2_test.clj | 45 ++ .../lambdaisland/regal/spec_gen_test.clj | 39 ++ .../lambdaisland/regal/test_util.cljc | 146 +++++++ .../lib_tests/lambdaisland/regal_test.cljc | 174 ++++++++ .../lib_tests/medley/core_test.cljc | 409 ++++++++++++++++++ .../lib_tests/medley/test_runner.cljs | 5 + test-resources/lib_tests/table/core_test.clj | 2 +- 26 files changed, 1309 insertions(+), 157 deletions(-) delete mode 100644 test-resources/lib_tests/babashka/lambdaisland/regal_test.clj create mode 100644 test-resources/lib_tests/doric/test/doctest.clj create mode 100644 test-resources/lib_tests/doric/test/readme.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/malli_test.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal/parse_test.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal/re2_test.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj create mode 100644 test-resources/lib_tests/lambdaisland/regal/test_util.cljc create mode 100644 test-resources/lib_tests/lambdaisland/regal_test.cljc create mode 100644 test-resources/lib_tests/medley/core_test.cljc create mode 100644 test-resources/lib_tests/medley/test_runner.cljs diff --git a/deps.edn b/deps.edn index 031f8252..e29102b3 100644 --- a/deps.edn +++ b/deps.edn @@ -55,10 +55,7 @@ :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"} org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha" :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"} - lambdaisland/regal {:git/url "https://github.com/lambdaisland/regal" - :sha "f902d2c43121f9e1c48603d6eb99f5900eb6a9f6"} - weavejester/medley {:git/url "https://github.com/weavejester/medley" - :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} + lambdaisland/regal {:mvn/version "0.0.143"} cprop/cprop {:mvn/version "0.1.16"} comb/comb {:mvn/version "0.1.1"} mvxcvi/arrangement {:mvn/version "2.0.0"} @@ -72,8 +69,8 @@ camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.2"} aero/aero {:mvn/version "1.1.6"} org.clojure/data.generators {:mvn/version "1.0.0"} - honeysql/honeysql {:mvn/version "1.0.444"} - com.github.seancorfield/honeysql {:mvn/version "2.0.0-rc2"} + honeysql/honeysql {:mvn/version "1.0.461"} + com.github.seancorfield/honeysql {:mvn/version "2.2.840"} minimallist/minimallist {:mvn/version "0.0.10"} circleci/bond {:mvn/version "0.6.0"} version-clj/version-clj {:mvn/version "2.0.2"} @@ -104,9 +101,10 @@ listora/again {:mvn/version "1.0.0"} org.clojure/tools.gitlibs {:mvn/version "2.4.172"} environ/environ {:mvn/version "1.2.0"} - table/table {:git/url "https://github.com/cldwalker/table", :sha "55aef3d5fced682942af811bf5d642f79fb87688"} + table/table {:git/url "https://github.com/cldwalker/table", :sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7"} markdown-clj/markdown-clj {:mvn/version "1.10.8"} - org.clojure/tools.namespace {:git/url "https://github.com/babashka/tools.namespace", :sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b"}} + org.clojure/tools.namespace {:git/url "https://github.com/babashka/tools.namespace", :sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b"} + medley/medley {:mvn/version "1.3.0"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/script/add-libtest.clj b/script/add-libtest.clj index 969ccd79..0c96881a 100755 --- a/script/add-libtest.clj +++ b/script/add-libtest.clj @@ -106,7 +106,7 @@ (defn- fetch-artifact [artifact] (let [url (str "https://clojars.org/api/artifacts/" artifact) - _ (println (str "GET " url "...")) + _ (println "GET" url "...") resp @(http/get url {:headers {"Accept" "application/edn"}})] (if (= 200 (:status resp)) (-> resp :body slurp edn/read-string) diff --git a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj b/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj deleted file mode 100644 index 7f2fcf60..00000000 --- a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj +++ /dev/null @@ -1,15 +0,0 @@ -(ns babashka.lambdaisland.regal-test - (:require [clojure.test :as t :refer [deftest is]])) - -(prn :requiring :lambdaisland) -(require '[lambdaisland.regal :as regal]) -(prn ::done :requiring :lambdaisland) - -(def r [:cat - [:+ [:class [\a \z]]] - "=" - [:+ [:not \=]]]) - -(deftest regal-test - (is (= "[a-z]+=[^=]+" (str (regal/regex r)))) - (is (= "foo=bar" (re-matches (regal/regex r) "foo=bar")))) diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index ae3d2fb6..f5d532fa 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -31,22 +31,6 @@ (test-namespaces 'clj-http.lite.client-test) -;; ;;;; clojure.spec - -(test-namespaces 'clojure.test-clojure.spec - 'clojure.test-clojure.instr - 'clojure.test-clojure.multi-spec) - -;;;; regal - -(test-namespaces 'babashka.lambdaisland.regal-test) - -;;;; medley - -(require '[medley.core :refer [index-by random-uuid]]) -(prn (index-by :id [{:id 1} {:id 2}])) -(prn (random-uuid)) - ;;;; babashka.curl ; skip tests on Windows because of the :compressed thing (when-not windows? (test-namespaces 'babashka.curl-test)) @@ -59,10 +43,6 @@ (require '[cprop.source :refer [from-env]]) (println (:cprop-env (from-env))) -;;;; clj-yaml - -(test-namespaces 'clj-yaml.core-test) - ;;;; clojure.data.zip ;; TODO: port to test-namespaces @@ -82,14 +62,6 @@ (prn :alice-is-a (xml1-> xml :character [(attr= :name "alice")] (attr :type))) (prn :animal-is-called (xml1-> xml :character [(attr= :type "animal")] (attr :name)))) -;;;; clojure.data.csv - -(test-namespaces 'clojure.data.csv-test) - -;;;; clojure.math.combinatorics - -(test-namespaces 'clojure.math.test-combinatorics) - ;;;; deps.clj ;; TODO: port to test-namespaces @@ -112,12 +84,7 @@ ((resolve 'doric.core/table) [:a :b] [{:a 1 :b 2}])) (when (test-namespace? 'doric.test.core) - (test-doric-cyclic-dep-problem) - (test-namespaces 'doric.test.core)) - -;;;; honeysql - -(test-namespaces 'honeysql.core-test 'honeysql.format-test) + (test-doric-cyclic-dep-problem)) ;;;; httpkit client @@ -151,10 +118,6 @@ (test-namespaces 'selmer.core-test) (test-namespaces 'selmer.our-test) -(test-namespaces 'honey.sql-test - 'honey.sql.helpers-test - 'honey.sql.postgres-test) - (test-namespaces 'omniconf.core-test) (test-namespaces 'crispin.core-test) diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index 3e7c9d5f..bd4230f7 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -8,7 +8,7 @@ mvxcvi/arrangement {:git-sha "360d29e7ae81abbf986b5a8e272f2086227d038d", :git-url "https://github.com/greglook/clj-arrangement", :test-namespaces (arrangement.core-test)} clojure-csv/clojure-csv {:git-sha "b6bb882a3a9ac1f82e06eb2262ae7c8141935228", :git-url "https://github.com/davidsantiago/clojure-csv", :test-namespaces (clojure-csv.test.utils clojure-csv.test.core)} environ/environ {:git-sha "aa90997b38bb8070d94dc4a00a14e656eb5fc9ae", :git-url "https://github.com/weavejester/environ", :test-namespaces (environ.core-test), :directory "environ"} - table/table {:git-sha "55aef3d5fced682942af811bf5d642f79fb87688", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} + table/table {:git-sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} com.stuartsierra/dependency {:git-sha "3a467918cd0e5b6ab775d344cfb2a80b56daad6d", :git-url "https://github.com/stuartsierra/dependency", :test-namespaces (com.stuartsierra.dependency-test)} reifyhealth/specmonstah {:git-sha "a2b357009a3aa99a0c2d2361f3bbcd0b0e36505e", :git-url "https://github.com/reifyhealth/specmonstah", :test-namespaces (reifyhealth.specmonstah.spec-gen-test reifyhealth.specmonstah.test-data reifyhealth.specmonstah.core-test), :branch "develop"} exoscale/coax {:git-sha "0d4212af7c07e4f05f74186f05df8a97777b43fe", :git-url "https://github.com/exoscale/coax", :test-namespaces (exoscale.coax-test)} @@ -34,4 +34,15 @@ org.clojure/data.generators {:git-sha "bf65f99aa9dcabed7de7c09b74d71db208cf61ee", :git-url "https://github.com/clojure/data.generators", :test-namespaces (clojure.data.generators-test)} camel-snake-kebab/camel-snake-kebab {:git-sha "d072c7fd242ab0becd4bb265622ded415f2a4b68", :git-url "https://github.com/clj-commons/camel-snake-kebab", :test-namespaces (camel-snake-kebab.internals.string-separator-test camel-snake-kebab.extras-test camel-snake-kebab.core-test)} ;; BB-TEST-PATCH: Removed cljs-test-opts.edn - henryw374/cljc.java-time {:git-sha "b9da12ea25e80a0e284a5bffd88ebcbf18fc3bf7", :git-url "https://github.com/henryw374/cljc.java-time", :test-namespaces (cljc.java-time-test)}} + henryw374/cljc.java-time {:git-sha "b9da12ea25e80a0e284a5bffd88ebcbf18fc3bf7", :git-url "https://github.com/henryw374/cljc.java-time", :test-namespaces (cljc.java-time-test)} + org.babashka/spec.alpha {:git-sha "6c4aed643daaf55c6f898d4915275704db683aa2", :git-url "https://github.com/babashka/spec.alpha", :test-namespaces (clojure.test-clojure.instr clojure.test-clojure.spec)} + ;; BB-TEST-PATCH: Don't have 4 tests namespaces because they depend on + ;; additional libs that aren't bb compatible e.g. instaparse and malli + lambdaisland/regal {:git-sha "d13f26dfdf37186ee86016ed144fc823c5b24c11", :git-url "https://github.com/lambdaisland/regal", :test-namespaces (lambdaisland.regal.test-util lambdaisland.regal-test)} + medley/medley {:git-sha "d723afcb18e1fae27f3b68a25c7a151569159a9e", :git-url "https://github.com/weavejester/medley", :test-namespaces (medley.core-test)} + clj-commons/clj-yaml {:git-sha "9c2d602ec6ab33da061575f52e3de1aff41f67f5", :git-url "https://github.com/clj-commons/clj-yaml", :test-namespaces (clj-yaml.core-test)} + org.clojure/data.csv {:git-sha "aa9b3bdd3a1d3f6a7fe12eaab76b45ef3f197ad5", :git-url "https://github.com/clojure/data.csv", :test-namespaces (clojure.data.csv-test)} + org.clojure/math.combinatorics {:git-sha "e555a45b5802cf5e8c43b4377628ef34a634554b", :git-url "https://github.com/clojure/math.combinatorics", :test-namespaces (clojure.math.test-combinatorics)} + doric/doric {:git-sha "8747fdce565187a5c368c575cf4ca794084b0a5c", :git-url "https://github.com/joegallo/doric", :test-namespaces (doric.test.core doric.test.readme doric.test.doctest)} + com.github.seancorfield/honeysql {:git-sha "6e4e1f6928450788353c181f32474d930d6afe84", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honey.sql-test honey.sql.helpers-test honey.sql.postgres-test), :branch "develop"} + honeysql/honeysql {:git-sha "1137dd12350afdc30ad4976c3718279581390b36", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honeysql.format-test honeysql.core-test), :branch "v1"}} diff --git a/test-resources/lib_tests/clj_yaml/core_test.clj b/test-resources/lib_tests/clj_yaml/core_test.clj index 0e75a4d6..cf705ece 100644 --- a/test-resources/lib_tests/clj_yaml/core_test.clj +++ b/test-resources/lib_tests/clj_yaml/core_test.clj @@ -1,8 +1,15 @@ (ns clj-yaml.core-test (:require [clojure.test :refer (deftest testing is)] [clojure.string :as string] - [clj-yaml.core :refer [parse-string unmark generate-string]]) - (:import [java.util Date])) + [clojure.java.io :as io] + [clj-yaml.core :refer [parse-string unmark generate-string + parse-stream generate-stream]]) + (:import [java.util Date] + (java.io ByteArrayOutputStream OutputStreamWriter ByteArrayInputStream) + java.nio.charset.StandardCharsets + (org.yaml.snakeyaml.error YAMLException) + ;; BB-TEST-PATCH: bb doesn't have these classes + #_(org.yaml.snakeyaml.constructor DuplicateKeyException))) (def nested-hash-yaml "root:\n childa: a\n childb: \n grandchild: \n greatgrandchild: bar\n") @@ -27,7 +34,7 @@ items: ") (def inline-list-yaml -"--- # Shopping list + "--- # Shopping list [milk, pumpkin pie, eggs, juice] ") @@ -160,8 +167,8 @@ the-bin: !!binary 0101") ;; This test ensures that generate-string uses the older behavior by default, for the sake ;; of stability, i.e. backwards compatibility. (is - (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" - (generate-string data)))))) + (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" + (generate-string data)))))) (deftest dump-opts (let [data [{:age 33 :name "jon"} {:age 44 :name "boo"}]] @@ -170,9 +177,7 @@ the-bin: !!binary 0101") (is (= "[{age: 33, name: jon}, {age: 44, name: boo}]\n" (generate-string data :dumper-options {:flow-style :flow}))))) -;; TODO: this test is failing in GraalVM -;; Could be related to https://github.com/oracle/graal/issues/2234 -#_(deftest parse-time +(deftest parse-time (testing "clj-time parses timestamps with more than millisecond precision correctly." (let [timestamp "2001-11-23 15:02:31.123456 -04:00" expected 1006542151123] @@ -182,7 +187,7 @@ the-bin: !!binary 0101") (let [parsed (parse-string hashes-lists-yaml) [first second] (:items parsed)] (is (= (keys first) '(:part_no :descrip :price :quantity))) - (is (= (keys second)'(:part_no :descrip :price :quantity :owners))))) + (is (= (keys second) '(:part_no :descrip :price :quantity :owners))))) (deftest nulls-are-fine @@ -201,3 +206,90 @@ the-bin: !!binary 0101") (testing "emoji in comments are OK too" (let [yaml "# 💣 emoji in a comment\n42"] (is (= 42 (parse-string yaml)))))) + +(def too-many-aliases + (->> (range 51) + (map #(str "b" % ": *a")) + (cons "a: &a [\"a\",\"a\"]") + (string/join "\n"))) + +(deftest max-aliases-for-collections-works + (is (thrown-with-msg? YAMLException #"Number of aliases" (parse-string too-many-aliases))) + (is (parse-string too-many-aliases :max-aliases-for-collections 51))) + +(def recursive-yaml " +--- +&A +- *A: *A +") + +(deftest allow-recursive-works + (is (thrown-with-msg? YAMLException #"Recursive" (parse-string recursive-yaml))) + (is (parse-string recursive-yaml :allow-recursive-keys true))) + +(def duplicate-keys-yaml " +a: 1 +a: 1 +") + +#_(deftest duplicate-keys-works + (is (parse-string duplicate-keys-yaml)) + (is (thrown-with-msg? DuplicateKeyException #"found duplicate key" (parse-string duplicate-keys-yaml :allow-duplicate-keys false)))) + +(def namespaced-keys-yaml " +foo/bar: 42 +") + +(deftest namespaced-keys-works + (testing "namespaced keys in yaml can round trip through parse and generate" + (is (= {:foo/bar 42} (-> namespaced-keys-yaml + parse-string + generate-string + parse-string))))) + +(defn to-bytes + "Converts a string to a byte array." + [data] + (.getBytes ^String data StandardCharsets/UTF_8)) + +(defn roundtrip + "Testing roundtrip of string and stream parser, and checking their equivalence." + [data-as-string] + (let [data (parse-string data-as-string) + data-stream (parse-stream (io/reader (ByteArrayInputStream. (to-bytes data-as-string)))) + output-stream (ByteArrayOutputStream.) + writer (OutputStreamWriter. output-stream) + _ (generate-stream writer data) + reader (ByteArrayInputStream. (.toByteArray output-stream))] + (= data ;; string -> edn + (parse-string (generate-string data)) ;; edn -> string -> edn + (parse-stream (io/reader reader)) ;; edn -> stream -> edn + ;; stream -> edn + data-stream))) + +(deftest roundtrip-test + (testing "Roundtrip test" + (is (roundtrip duplicate-keys-yaml)) + (is (roundtrip hashes-of-lists-yaml)) + (is (roundtrip inline-hash-yaml)) + (is (roundtrip inline-list-yaml)) + (is (roundtrip list-of-hashes-yaml)) + (is (roundtrip list-yaml)) + (is (roundtrip nested-hash-yaml)))) + +(def indented-yaml "todo: + - name: Fix issue + responsible: + name: Rita +") + +;; BB-TEST-PATCH - bb generates different indents +#_(deftest indentation-test + (testing "Can use indicator-indent and indent to achieve desired indentation" + (is (not= indented-yaml (generate-string (parse-string indented-yaml) + :dumper-options {:flow-style :block}))) + (is (= indented-yaml + (generate-string (parse-string indented-yaml) + :dumper-options {:indent 5 + :indicator-indent 2 + :flow-style :block}))))) diff --git a/test-resources/lib_tests/clojure/data/json_test.clj b/test-resources/lib_tests/clojure/data/json_test.clj index 61ac8380..0bed8eb4 100644 --- a/test-resources/lib_tests/clojure/data/json_test.clj +++ b/test-resources/lib_tests/clojure/data/json_test.clj @@ -414,6 +414,7 @@ (is (= x (json/read-str (with-out-str (json/pprint x))))))) (deftest pretty-print-nonescaped-unicode + ;; BB-TEST-PATCH: Windows compatability (is (= (str "\"\u1234\u4567\"" (System/lineSeparator)) (with-out-str (json/pprint "\u1234\u4567" :escape-unicode false))))) diff --git a/test-resources/lib_tests/clojure/test_clojure/instr.clj b/test-resources/lib_tests/clojure/test_clojure/instr.clj index e6b1e238..670a1e3c 100644 --- a/test-resources/lib_tests/clojure/test_clojure/instr.clj +++ b/test-resources/lib_tests/clojure/test_clojure/instr.clj @@ -95,6 +95,7 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 2 :not-num 3))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" (try (fail-no-kwargs 1 :not-num) (catch Exception ei @@ -151,14 +152,15 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 2 :a 1 {:b :not-num}))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" - (try (fail-kwargs 1 :not-num) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) + (try (fail-kwargs 1 :not-num) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) - (try (fail-kwargs 1 2 :a 1 {:b :not-num}) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) + (try (fail-kwargs 1 2 :a 1 {:b :not-num}) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) (testing "that the uninstrumented kwargs function operates as the raw function" (stest/unstrument `kwargs-fn) diff --git a/test-resources/lib_tests/clojure/test_clojure/spec.clj b/test-resources/lib_tests/clojure/test_clojure/spec.clj index 290ad43d..8c6fb7e6 100644 --- a/test-resources/lib_tests/clojure/test_clojure/spec.clj +++ b/test-resources/lib_tests/clojure/test_clojure/spec.clj @@ -1,11 +1,3 @@ -; Copyright (c) Rich Hickey. All rights reserved. -; The use and distribution terms for this software are covered by the -; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -; which can be found in the file epl-v10.html at the root of this distribution. -; By using this software in any fashion, you are agreeing to be bound by -; the terms of this license. -; You must not remove this notice, or any other, from this software. - (ns clojure.test-clojure.spec (:require [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] @@ -167,6 +159,7 @@ (is (= (s/describe odd?) 'odd?)) (is (= (s/form odd?) 'clojure.core/odd?)) + ;; BB-TEST-PATCH: Returns sci internal #_(is (= (s/describe #(odd? %)) ::s/unknown)) #_(is (= (s/form #(odd? %)) ::s/unknown))) diff --git a/test-resources/lib_tests/doric/test/core.clj b/test-resources/lib_tests/doric/test/core.clj index 21a327aa..43e75edd 100644 --- a/test-resources/lib_tests/doric/test/core.clj +++ b/test-resources/lib_tests/doric/test/core.clj @@ -2,8 +2,7 @@ (:refer-clojure :exclude [format name when]) (:use [doric.core] [clojure.test] - [doric.org :only [th td render]]) - (:require [clojure.string :as str])) + [doric.org :only [th td render]])) (deftest test-title-case (is (= "Foo" (title-case "foo"))) @@ -73,10 +72,10 @@ ;; TODO (deftest test-body) (deftest test-render - (let [rendered (set (render [["1" "2"]["3" "4"]]))] - (is (contains? rendered "| 1 | 2 |")) - (is (contains? rendered "| 3 | 4 |")) - (is (contains? rendered "|---+---|")))) + (let [rendered (render [["1" "2"]["3" "4"]])] + (is (.contains rendered "| 1 | 2 |")) + (is (.contains rendered "| 3 | 4 |")) + (is (.contains rendered "|---+---|")))) ;; TODO embiggen these tests (deftest test-table diff --git a/test-resources/lib_tests/doric/test/doctest.clj b/test-resources/lib_tests/doric/test/doctest.clj new file mode 100644 index 00000000..f05f1c0f --- /dev/null +++ b/test-resources/lib_tests/doric/test/doctest.clj @@ -0,0 +1,93 @@ +(ns doric.test.doctest + (:use [clojure.java.io :only [file]] + [clojure.test]) + (:import (java.io PushbackReader StringReader))) + +(defn fenced-blocks + "detect and extract github-style fenced blocks in a file" + [s] + (map second + (re-seq #"(?m)(?s)^```clojure\n(.*?)\n^```" s))) + +(def prompt + ;; regex for finding 'foo.bar>' repl prompts + "(?m)\n*^\\S*>\\s*") + +(defn skip? + "is a result skippable?" + ;; if it's a comment, the answer is yes + [s] + (.startsWith s ";")) + +(defn reps + "given a string of read-eval-print sequences, separate the different + 'r-e-p's from each other" + [prompt s] + (rest (.split s prompt))) + +(defn markdown-tests + "extract all the tests from a markdown file" + [f] + (->> f + slurp + fenced-blocks + (mapcat (partial reps prompt)))) + +(defn repl-tests + "extract all the tests from a repl-session-like file" + [f] + (->> f + slurp + (reps prompt))) + +(defn temp-ns + "create a temporary ns, and return its name" + [] + (binding [*ns* *ns*] + (in-ns (gensym)) + (use 'clojure.core) + ;; BB-TEST-PATCH: bb can't .getName on ns + (str *ns*))) + +(defn eval-in-ns + "evaluate a form inside the given ns-name" + [ns form] + (binding [*ns* *ns*] + (in-ns ns) + (eval form))) + +(defn run-doctest + "run a single doctest, reporting success or failure" + [file idx ns test] + (let [r (PushbackReader. (StringReader. test)) + form (read r) + expected (.trim (slurp r)) + actual (when-not (skip? expected) + (.trim (try + (with-out-str + (pr (eval-in-ns ns form)) + (flush)) + (catch Exception _ + (println _) + (.toString (gensym))))))] + (if (or (skip? expected) + (= actual expected)) + (report {:type :pass}) + (report {:type :fail + :file file :line idx + :expected expected :actual actual})))) + +(defn run-doctests + "use text-extract-fn to get all the tests out of file, and run them + all, reporting success or failure" + [test-extract-fn file] + (let [ns (temp-ns)] + (doseq [[idx t] (map-indexed vector (test-extract-fn file))] + (run-doctest file idx ns t)) + (remove-ns ns))) + + +(comment + ;; example usage + (deftest bar-repl + (run-doctests repl-tests "test/bar.repl"))) diff --git a/test-resources/lib_tests/doric/test/readme.clj b/test-resources/lib_tests/doric/test/readme.clj new file mode 100644 index 00000000..615459ed --- /dev/null +++ b/test-resources/lib_tests/doric/test/readme.clj @@ -0,0 +1,6 @@ +(ns doric.test.readme + (:use [clojure.test] + [doric.test.doctest])) + +(deftest readme + (run-doctests markdown-tests "README.md")) diff --git a/test-resources/lib_tests/honey/sql/helpers_test.cljc b/test-resources/lib_tests/honey/sql/helpers_test.cljc index 33ea68c5..76fa2f88 100644 --- a/test-resources/lib_tests/honey/sql/helpers_test.cljc +++ b/test-resources/lib_tests/honey/sql/helpers_test.cljc @@ -2,8 +2,7 @@ (ns honey.sql.helpers-test (:refer-clojure :exclude [filter for group-by partition-by set update]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] [honey.sql :as sql] [honey.sql.helpers :as h :refer [add-column add-index alter-table columns create-table create-table-as create-view diff --git a/test-resources/lib_tests/honey/sql/postgres_test.cljc b/test-resources/lib_tests/honey/sql/postgres_test.cljc index ad173596..9649a665 100644 --- a/test-resources/lib_tests/honey/sql/postgres_test.cljc +++ b/test-resources/lib_tests/honey/sql/postgres_test.cljc @@ -9,8 +9,7 @@ (ns honey.sql.postgres-test (:refer-clojure :exclude [update partition-by set]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] ;; pull in all the PostgreSQL helpers that the nilenso ;; library provided (as well as the regular HoneySQL ones): [honey.sql.helpers :as sqlh :refer @@ -320,7 +319,7 @@ (deftest values-except-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT SELECT id FROM images" 4 5 6] (sql/format {:except [{:values [[4] [5] [6]]} @@ -328,7 +327,7 @@ (deftest select-except-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT SELECT ip FROM ip_location"] (sql/format {:except [{:select [:ip]} @@ -336,7 +335,7 @@ (deftest values-except-all-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT ALL (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT ALL SELECT id FROM images" 4 5 6] (sql/format {:except-all [{:values [[4] [5] [6]]} @@ -344,7 +343,7 @@ (deftest select-except-all-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT ALL (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT ALL SELECT ip FROM ip_location"] (sql/format {:except-all [{:select [:ip]} diff --git a/test-resources/lib_tests/honey/sql_test.cljc b/test-resources/lib_tests/honey/sql_test.cljc index d1043ed7..3c93cac4 100644 --- a/test-resources/lib_tests/honey/sql_test.cljc +++ b/test-resources/lib_tests/honey/sql_test.cljc @@ -3,8 +3,7 @@ (ns honey.sql-test (:refer-clojure :exclude [format]) (:require [clojure.string :as str] - #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + [clojure.test :refer [deftest is testing]] [honey.sql :as sut :refer [format]] [honey.sql.helpers :as h]) #?(:clj (:import (clojure.lang ExceptionInfo)))) @@ -15,17 +14,39 @@ {:dialect :mysql})))) (deftest expr-tests + ;; special-cased = nil: (is (= ["id IS NULL"] (sut/format-expr [:= :id nil]))) (is (= ["id IS NULL"] (sut/format-expr [:is :id nil]))) + (is (= ["id = TRUE"] + (sut/format-expr [:= :id true]))) + (is (= ["id IS TRUE"] + (sut/format-expr [:is :id true]))) + (is (= ["id <> TRUE"] + (sut/format-expr [:<> :id true]))) + (is (= ["id IS NOT TRUE"] + (sut/format-expr [:is-not :id true]))) + (is (= ["id = FALSE"] + (sut/format-expr [:= :id false]))) + (is (= ["id IS FALSE"] + (sut/format-expr [:is :id false]))) + (is (= ["id <> FALSE"] + (sut/format-expr [:<> :id false]))) + (is (= ["id IS NOT FALSE"] + (sut/format-expr [:is-not :id false]))) + ;; special-cased <> nil: (is (= ["id IS NOT NULL"] (sut/format-expr [:<> :id nil]))) + ;; legacy alias: (is (= ["id IS NOT NULL"] (sut/format-expr [:!= :id nil]))) + ;; legacy alias: + (is (= ["id IS NOT NULL"] + (sut/format-expr [:not= :id nil]))) (is (= ["id IS NOT NULL"] (sut/format-expr [:is-not :id nil]))) - ;; degenerate cases: + ;; degenerate (special) cases: (is (= ["NULL IS NULL"] (sut/format-expr [:= nil nil]))) (is (= ["NULL IS NOT NULL"] @@ -185,30 +206,30 @@ ;; ORDER BY foo ASC (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])) + ["SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])) (testing "union complex values" (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6])))) (deftest union-all-test (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2"]))) (deftest intersect-test (is (= (format {:intersect [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) INTERSECT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 INTERSECT SELECT foo FROM bar2"]))) (deftest except-test (is (= (format {:except [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) EXCEPT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 EXCEPT SELECT foo FROM bar2"]))) (deftest inner-parts-test (testing "The correct way to apply ORDER BY to various parts of a UNION" @@ -222,7 +243,7 @@ :order-by [[:amount :desc]] :limit 5}]}] :order-by [[:amount :asc]]}) - ["(SELECT amount, id, created_on FROM transactions) UNION (SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?)) ORDER BY amount ASC" 5])))) + ["SELECT amount, id, created_on FROM transactions UNION SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?) ORDER BY amount ASC" 5])))) (deftest compare-expressions-test (testing "Sequences should be fns when in value/comparison spots" @@ -254,14 +275,14 @@ {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest union-all-with-cte (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest parameterizer-none (testing "array parameter" @@ -277,7 +298,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]} {:inline true}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest inline-was-parameterizer-none (testing "array parameter" @@ -294,7 +315,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values (mapv #(mapv vector (repeat :inline) %) [[1 2] [3 4] [5 6]])}]]}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest similar-regex-tests (testing "basic similar to" @@ -379,11 +400,21 @@ (is (= ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `a` = ? WHERE `bar`.`b` = ?" 1 42] (-> - {:update :foo - :join [:bar [:= :bar.id :foo.bar_id]] - :set {:a 1} - :where [:= :bar.b 42]} - (format {:dialect :mysql}))))) + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + :set {:a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql})))) + ;; issue 344 + (is (= + ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `f`.`a` = ? WHERE `bar`.`b` = ?" 1 42] + (-> + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + ;; do not drop ns in set clause for MySQL: + :set {:f/a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql}))))) (deftest format-arity-test (testing "format can be called with no options" @@ -401,7 +432,8 @@ (-> {:delete-from :foo :where [:= :foo.id 42]} (format :dialect :mysql :pretty true))))) - (when (str/starts-with? #?(:bb "1.11" + ;; BB-TEST-PATCH: bb doesn't have clojure-version + (when (str/starts-with? #?(:bb "1.11" :clj (clojure-version) :cljs *clojurescript-version*) "1.11") (testing "format can be called with mixed arguments" @@ -439,7 +471,7 @@ (format {:dialect :mysql}))))) (deftest inlined-values-are-stringified-correctly - (is (= ["SELECT 'foo', 'It''s a quote!', BAR, NULL"] + (is (= ["SELECT 'foo', 'It''s a quote!', bar, NULL"] (format {:select [[[:inline "foo"]] [[:inline "It's a quote!"]] [[:inline :bar]] @@ -784,3 +816,31 @@ ORDER BY id = ? DESC :from :bar :join [[{:select :a :from :b :where [:= :id 123]} :x] :y] :where [:= :id 456]}))))) + +(deftest fetch-offset-issue-338 + (testing "default offset (with and without limit)" + (is (= ["SELECT foo FROM bar LIMIT ? OFFSET ?" 10 20] + (format {:select :foo :from :bar + :limit 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ?" 20] + (format {:select :foo :from :bar + :offset 20})))) + (testing "default offset / fetch" + (is (= ["SELECT foo FROM bar OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ? ROW FETCH NEXT ? ROW ONLY" 1 1] + (format {:select :foo :from :bar + :fetch 1 :offset 1}))) + (is (= ["SELECT foo FROM bar FETCH FIRST ? ROWS ONLY" 2] + (format {:select :foo :from :bar + :fetch 2})))) + (testing "SQL Server offset" + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20} + {:dialect :sqlserver}))) + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS" 20] + (format {:select :foo :from :bar + :offset 20} + {:dialect :sqlserver}))))) diff --git a/test-resources/lib_tests/honeysql/core_test.cljc b/test-resources/lib_tests/honeysql/core_test.cljc index 4247f1bc..d1fc2f8b 100644 --- a/test-resources/lib_tests/honeysql/core_test.cljc +++ b/test-resources/lib_tests/honeysql/core_test.cljc @@ -3,11 +3,12 @@ (:require [#?@(:clj [clojure.test :refer] :cljs [cljs.test :refer-macros]) [deftest testing is]] [honeysql.core :as sql] + [honeysql.format :as sql-f] [honeysql.helpers :refer [select modifiers from join left-join right-join full-join cross-join where group having order-by limit offset values columns - insert-into with merge-where]] + insert-into with merge-where merge-having]] honeysql.format-test)) ;; TODO: more tests @@ -90,7 +91,7 @@ (-> (insert-into :foo) (columns :bar) - (values [[(honeysql.format/value {:baz "my-val"})]]) + (values [[(sql-f/value {:baz "my-val"})]]) sql/format))) (is (= ["INSERT INTO foo (a, b, c) VALUES (?, ?, ?), (?, ?, ?)" "a" "b" "c" "a" "b" "c"] @@ -217,43 +218,113 @@ sql/format)))) (deftest merge-where-no-params-test - (testing "merge-where called with just the map as parameter - see #228" - (let [sqlmap (-> (select :*) - (from :table) - (where [:= :foo :bar]))] - (is (= ["SELECT * FROM table WHERE foo = bar"] - (sql/format (apply merge-where sqlmap []))))))) + (doseq [[k [f merge-f]] {"WHERE" [where merge-where] + "HAVING" [having merge-having]}] + (testing "merge-where called with just the map as parameter - see #228" + (let [sqlmap (-> (select :*) + (from :table) + (f [:= :foo :bar]))] + (is (= [(str "SELECT * FROM table " k " foo = bar")] + (sql/format (apply merge-f sqlmap [])))))))) (deftest merge-where-test - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar] [:= :quuz :xyzzy]) - sql/format))) - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar]) - (merge-where [:= :quuz :xyzzy]) - sql/format)))) + (doseq [[k sql-keyword f merge-f] [[:where "WHERE" where merge-where] + [:having "HAVING" having merge-having]]] + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar] [:= :quuz :xyzzy]) + sql/format))) + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar]) + (merge-f [:= :quuz :xyzzy]) + sql/format))) + (testing "Should work when first arg isn't a map" + (is (= {k [:and [:x] [:y]]} + (merge-f [:x] [:y])))) + (testing "Shouldn't use conjunction if there is only one clause in the result" + (is (= {k [:x]} + (merge-f {} [:x])))) + (testing "Should be able to specify the conjunction type" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] [:y])))) + (testing "Should ignore nil clauses" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] nil [:y])))))) + +(deftest merge-where-build-clause-test + (doseq [k [:where :having]] + (testing (str "Should be able to build a " k " clause with sql/build") + (is (= {k [:and [:a] [:x] [:y]]} + (sql/build + k [:a] + (keyword (str "merge-" (name k))) [:and [:x] [:y]])))))) + +(deftest merge-where-combine-clauses-test + (doseq [[k f] {:where merge-where + :having merge-having}] + (testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)") + (testing "No existing clause" + (is (= {k [:and [:x] [:y]]} + (f {} + [:x] [:y])))) + (testing "Existing clause is not a conjunction." + (is (= {k [:and [:a] [:x] [:y]]} + (f {k [:a]} + [:x] [:y])))) + (testing "Existing clause IS a conjunction." + (testing "New clause(s) are not conjunctions" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:x] [:y])))) + (testing "New clauses(s) ARE conjunction(s)" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x] [:y]]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:y]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:and [:y]]))))) + (testing "if existing clause isn't the same conjunction, don't merge into it" + (testing "existing conjunction is `:or`" + (is (= {k [:and [:or [:a] [:b]] [:x] [:y]]} + (f {k [:or [:a] [:b]]} + [:x] [:y])))) + (testing "pass conjunction type as a param (override default of :and)" + (is (= {k [:or [:and [:a] [:b]] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + :or + [:x] [:y])))))))) (deftest where-nil-params-test - (testing "where called with nil parameters - see #246" - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where nil nil nil nil) - sql/format))))) + (doseq [[_ sql-keyword f] [[:where "WHERE" where] + [:having "HAVING" having]]] + (testing (str sql-keyword " called with nil parameters - see #246") + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f nil nil nil nil) + sql/format)))))) (deftest cross-join-test (is (= ["SELECT * FROM foo CROSS JOIN bar"] diff --git a/test-resources/lib_tests/honeysql/format_test.cljc b/test-resources/lib_tests/honeysql/format_test.cljc index d7fa8c7b..7ddea793 100644 --- a/test-resources/lib_tests/honeysql/format_test.cljc +++ b/test-resources/lib_tests/honeysql/format_test.cljc @@ -320,3 +320,17 @@ (format {:select [:*] :from [[:foo :f]] :cross-join [[:bar :b]]})))) + +(deftest issue-299-test + (let [name "test field" + ;; this was being rendered inline into the SQL + ;; creating an injection vulnerability (v1 only) + ;; the context for seq->sql here seems to be the + ;; 'regular' one so it tries to treat this as an + ;; alias: 'value alias' -- the fix was to make it + ;; a function context so it becomes (TRUE, ?): + enabled [true, "); SELECT case when (SELECT current_setting('is_superuser'))='off' then pg_sleep(0.2) end; -- "]] + (is (= ["INSERT INTO table (name, enabled) VALUES (?, (TRUE, ?))" name (second enabled)] + (format {:insert-into :table + :values [{:name name + :enabled enabled}]}))))) \ No newline at end of file diff --git a/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc new file mode 100644 index 00000000..5b3072e3 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc @@ -0,0 +1,19 @@ +(ns lambdaisland.regal.malli-test + (:require [clojure.test :refer [deftest is ]] + [malli.core :as m] + [malli.error :as me] + [lambdaisland.regal.malli :as regal-malli])) + +(def malli-opts {:registry {:regal regal-malli/regal-schema}}) + +(def form [:+ "y"]) + +(def schema (m/schema [:regal form] malli-opts)) + +(deftest regal-malli-test + (is (= [:regal [:+ "y"]] (m/form schema))) + (is (= :regal (m/type schema))) + (is (= true (m/validate schema "yyy"))) + (is (= ["Pattern does not match"] (me/humanize (m/explain schema "xxx"))))) + + diff --git a/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc new file mode 100644 index 00000000..2a169516 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc @@ -0,0 +1,29 @@ +(ns lambdaisland.regal.parse-test + (:require [clojure.test :refer [deftest testing is are]] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse])) + +(deftest parse-whitespace-test + (is (= [:class " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\s")))) + + (is (= :whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\s")))) + + (is (= [:not " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\S")))) + + (is (= :non-whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\S"))))) + +(deftest ^{:kaocha/pending + "Needs a special case in the regex generation code"} + whitespace-round-trip + (is (= "\\s" + (regal/with-flavor :java + (regal/pattern + (parse/parse-pattern "\\s")))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/re2_test.clj b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj new file mode 100644 index 00000000..6f26c84c --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj @@ -0,0 +1,45 @@ +(ns lambdaisland.regal.re2-test + (:require [clojure.spec.alpha :as s] + [clojure.test :refer [is]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [com.gfredericks.test.chuck.properties :as prop'] + [lambdaisland.regal :as regal] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :refer [re2-find re2-compile]] + [lambdaisland.regal.spec-alpha :as regal-spec])) + +(defn gen-carefully [fgen else-gen] + (try + (let [gen (fgen)] + (gen/->Generator + (fn [rnd size] + (try + (gen/call-gen gen rnd size) + (catch Exception _ + (gen/call-gen else-gen rnd size)))))) + (catch Exception _ + else-gen))) + +(defn can-generate? [regal] + (try + (gen/sample (regal-gen/gen regal)) + true + (catch Exception _ + false))) + +(defspec re2-matches-like-java 10 + (with-redefs [regal-spec/token-gen #(s/gen (disj regal-spec/known-tokens :line-break :start :end))] + (prop'/for-all [regal (s/gen ::regal/form) + :when (can-generate? regal) + s (gen-carefully #(regal-gen/gen regal) + gen/string) + :let [java-result + (try (re-find (regal/regex regal) s) + (catch Exception _ + :fail))] + :when (not= :fail java-result)] + (is (= java-result + (re2-find (regal/with-flavor :re2 + (re2-compile (regal/pattern regal))) + s)))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj new file mode 100644 index 00000000..20b14f16 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj @@ -0,0 +1,39 @@ +(ns lambdaisland.regal.spec-gen-test + (:require [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as spec-gen] + [clojure.test :refer [deftest is are testing run-tests]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse] + [lambdaisland.regal.spec-alpha])) + +(def form-gen (s/gen ::regal/form)) +(def canonical-form-gen (gen/fmap regal/normalize (s/gen ::regal/form))) + +(defspec generated-forms-can-be-converted 100 + (prop/for-all [regal form-gen] + (try + (regal/regex regal) + (catch Exception _ + false)))) + +(defn- round-trip? [form] + (try + (= form (parse/parse (regal/regex form))) + (catch Exception _ false))) + +(defspec round-trip-property 100 + (prop/for-all* [canonical-form-gen] round-trip?)) + +(deftest round-trip-test + (is (round-trip? [:cat " " [:class "&& "]])) + (is (round-trip? [:class " " [" " "["]])) + (is (round-trip? [:ctrl "A"])) + (is (round-trip? [:class " - "])) + (is (round-trip? [:alt " " [:capture " " :escape]])) + (is (round-trip? :whitespace)) + (is (round-trip? [:? [:? "x"]])) + (is (round-trip? [:cat " " [:class " " :non-whitespace]])) + (is (round-trip? [:cat "-" [:repeat [:repeat "x" 0] 0]]))) diff --git a/test-resources/lib_tests/lambdaisland/regal/test_util.cljc b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc new file mode 100644 index 00000000..04c1d659 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc @@ -0,0 +1,146 @@ +(ns lambdaisland.regal.test-util + (:require [lambdaisland.regal :as regal]) + #?(:cljs (:require-macros [lambdaisland.regal.test-util :refer [inline-resource]]) + :clj (:require [clojure.java.io :as io] + [clojure.test.check.generators :as gen] + [lambdaisland.regal.generator :as regal-gen] + ;; BB-TEST-PATCH: Don't have this dependency + #_[com.gfredericks.test.chuck.regexes.charsets :as charsets]))) + +#?(:clj + (defmacro inline-resource [resource-path] + (read-string (slurp (io/resource resource-path))))) + +(defn read-test-cases [] + #? (:clj (read-string (slurp (io/resource "lambdaisland/regal/test_cases.edn"))) + :cljs (inline-resource "lambdaisland/regal/test_cases.edn"))) + +(defn flavor-parents [flavor] + (->> flavor + (iterate (comp first (partial parents regal/flavor-hierarchy))) + (take-while identity))) + +(defn format-cases [cases] + (for [[form pattern & tests :as case] cases + :let [[props tests] (if (map? (first tests)) + [(first tests) (rest tests)] + [{} tests])]] + (with-meta (merge + {:pattern pattern + :form form + :tests tests} + props) + (meta case)))) + +(defn test-cases + ([] + (let [cases (read-test-cases)] + (loop [[id & cases] cases + result []] + (if id + (recur (drop-while vector? cases) + (conj result + {:id id + :cases (format-cases (take-while vector? cases))})) + result))))) + +;; BB-TEST-PATCH: bb doesn't have Pattern class +#_(:clj + (do + (defn re2-compile ^com.google.re2j.Pattern [s] + (com.google.re2j.Pattern/compile s)) + (defn re2-groups + [^com.google.re2j.Matcher m] + (let [gc (. m (groupCount))] + (if (zero? gc) + (. m (group)) + (loop [ret [] c 0] + (if (<= c gc) + (recur (conj ret (. m (group c))) (inc c)) + ret))))) + (defn re2-find + ([^com.google.re2j.Matcher m] + (when (. m (find)) + (re2-groups m))) + ([^com.google.re2j.Pattern re s] + (let [m (.matcher re s)] + (re2-find m)))))) +;; BB-TEST-PATCH: Uses ns that can't load +#_(:clj + (do + ;; Implementation for generating classes using test.chuck's charsets. + ;; This should eventually be moved to lambdaisland.regal.generator + ;; when we have our own charset implementation + (def token->charset-map + (let [whitespace-charset (apply charsets/union + (map (comp charsets/singleton str char) regal/whitespace-char-codes))] + {:any charsets/all-unicode-but-line-terminators + :digit (charsets/predefined-regex-classes \d) + :non-digit (charsets/predefined-regex-classes \D) + :word (charsets/predefined-regex-classes \w) + :non-word (charsets/predefined-regex-classes \W) + :whitespace whitespace-charset + :non-whitespace (charsets/difference + (charsets/intersection charsets/all-unicode + (charsets/range "\u0000" "\uFFFF")) + whitespace-charset) + :newline (charsets/singleton "\n") + :return (charsets/singleton "\r") + :tab (charsets/singleton "\t") + :form-feed (charsets/singleton "\f") + :alert (charsets/singleton "\u0007") + :escape (charsets/singleton "\u001B") + :vertical-whitespace (charsets/predefined-regex-classes \v) + :vertical-tab (charsets/singleton "\u000B") + :null (charsets/singleton "\u0000")})) + + (defn token->charset [token] + (or (get token->charset-map token) + (throw (ex-info "Unknown token type" {:token token})))) + + (defn class->charset [cls] + (reduce charsets/union* + charsets/empty + (for [c cls] + (try + (cond + (vector? c) + (let [[start end] (map str c)] + (assert (>= 0 (compare start end))) + (charsets/range start end)) + + (simple-keyword? c) + (token->charset c) + + (string? c) + (reduce charsets/union* + (map (comp charsets/singleton str) c)) + + (char? c) + (charsets/singleton (str c))) + (catch Exception e + (throw (ex-info "Failed to translate class element into charset" + {:cls cls + :element c} + e))))))) + + (defn class->gen [[op & elts :as expr]] + (let [cls (class->charset elts) + cls (case op + :not (charsets/difference charsets/all-unicode cls) + :class cls + + (throw (ex-info "Unknown character class op" {:op op})))] + (if (nat-int? (charsets/size cls)) + (gen/fmap #(charsets/nth cls %) (gen/choose 0 (dec (charsets/size cls)))) + (throw (ex-info "Can't generate empty class" {:expr expr}))))) + + (defmethod regal-gen/-generator :not + [r _opts] + (class->gen r)) + + (defmethod regal-gen/-generator :class + [r _opts] + (class->gen r)))) +#_ +(test-cases) diff --git a/test-resources/lib_tests/lambdaisland/regal_test.cljc b/test-resources/lib_tests/lambdaisland/regal_test.cljc new file mode 100644 index 00000000..cdc14b74 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal_test.cljc @@ -0,0 +1,174 @@ +(ns lambdaisland.regal-test + (:require [lambdaisland.regal :as regal] + [lambdaisland.regal.spec-alpha] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :as test-util] + ;; BB-TEST-PATCH: bb can't load ns + #_[lambdaisland.regal.parse :as parse] + [clojure.spec.test.alpha :as stest] + [clojure.test :refer [deftest testing is are]] + [clojure.spec.alpha :as s])) + +(stest/instrument `regal/regex) + +(deftest regex-test + (is (= "abc" + (regal/pattern [:cat "a" "b" "c"]))) + + (is (= "a|b|c" + (regal/pattern [:alt "a" "b" "c"]))) + + (is (= "a*" + (regal/pattern [:* "a"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "ab"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "a" "b"]))) + + (is (= "(?:a|b)*" + (regal/pattern [:* [:alt "a" "b"]]))) + + (is (= "a*?" + (regal/pattern [:*? "a"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "ab"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "a" "b"]))) + + (is (= "(?:a|b)*?" + (regal/pattern [:*? [:alt "a" "b"]]))) + + (is (= "a+" + (regal/pattern [:+ "a"]))) + + (is (= "a+?" + (regal/pattern [:+? "a"]))) + + (is (= "a?" + (regal/pattern [:? "a"]))) + + (is (= "a??" + (regal/pattern [:?? "a"]))) + + (is (= "[a-z0-9_\\-]" + (regal/pattern [:class [\a \z] [\0 \9] \_ \-]))) + + (is (= "[^a-z0-9_\\-]" + (regal/pattern [:not [\a \z] [\0 \9] \_ \-]))) + + (is (= "a{3,5}" + (regal/pattern [:repeat \a 3 5]))) + + (regal/with-flavor :ecma + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (regal/with-flavor :java + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (is (= "a(?:b|c)" + (regal/pattern [:cat "a" [:alt "b" "c"]]))) + + (is (= "(abc)" + (regal/pattern [:capture "abc"]))) + + (is (= "a(b|c)" + (regal/pattern [:cat "a" [:capture [:alt "b" "c"]]])))) + +(deftest escape-test + (are [in out] (= out (regal/escape in)) + "$" "\\$" + "(" "\\(" + ")" "\\)" + "*" "\\*" + "+" "\\+" + "." "\\." + "?" "\\?" + "[" "\\[" + "]" "\\]" + "\\" "\\\\" + "^" "\\^" + "{" "\\{" + "|" "\\|" + "}" "\\}")) + + +(def flavors [:java8 :java9 :ecma :re2]) + +(def parseable-flavor? #{:java8 :java9 :ecma}) + +(deftest data-based-tests + (doseq [{:keys [id cases]} (test-util/test-cases) + {:keys [form pattern equivalent tests] :as test-case} cases + :let [skip? (set (when (map? pattern) + (for [flavor flavors + :when (= (get pattern flavor :skip) :skip)] + flavor))) + throws? (set (when (map? pattern) + (for [[flavor p] pattern + :when (and (vector? p) (= (first p) :throws))] + flavor)))]] + + (testing (str (pr-str form) " -> " (pr-str pattern)) + (is (s/valid? ::regal/form form)) + + (doseq [flavor flavors + :when (not (skip? flavor)) + :let [pattern (if (map? pattern) + (some pattern (test-util/flavor-parents flavor)) + pattern)]] + (if (throws? flavor) + (testing (str "Generating pattern throws (" (name id) ") " (pr-str form) " (" flavor ")") + (if-some [msg (second pattern)] + (is (thrown-with-msg? #?(:clj Exception + :cljs js/Error) (re-pattern msg) + (regal/with-flavor flavor + (regal/pattern form)))) + (is (thrown? #?(:clj Exception + :cljs js/Error) + (regal/with-flavor flavor + (regal/pattern form)))))) + (testing (str "Generated pattern is correct (" (name id) ") " (pr-str form) " (" flavor ")") + (regal/with-flavor flavor + (is (= pattern (regal/pattern form)))))) + + ;; BB-TEST-PATCH: Uses ns that can't load + #_(when (and (parseable-flavor? flavor) + (not-any? (comp :no-parse meta) [test-case cases])) + (testing (str "Pattern parses correctly (" (name id) ") " (pr-str pattern) " (" flavor ")") + (regal/with-flavor flavor + (is (= form (parse/parse-pattern pattern))))))) + + (doseq [[input match] tests] + (testing (str "Test case " (pr-str form) " matches " (pr-str input)) + + (testing "Generated pattern matches" + (is (= match (re-find (regal/regex form) input)))) + ;; BB-TEST-PATCH: Uses ns that can't load + #_(:clj + (when-not (or (skip? :re2) (throws? :re2)) + (testing "Generated pattern matches (re2)" + (is (= match (test-util/re2-find (regal/with-flavor :re2 + (test-util/re2-compile + (regal/pattern form))) + input)))))) + + (doseq [pattern (if (map? equivalent) + (some equivalent (test-util/flavor-parents (regal/runtime-flavor))) + equivalent)] + (testing (str "Alternative equivalent pattern " (pr-str pattern) " matches") + (is (= match (re-find (regal/compile pattern) input))))))) + + (testing (str "creating a generator does not throw exception " (pr-str form)) + (is (regal-gen/gen form))) + + ;; We should do this with proper properties so we get shrinking, just a + ;; basic check for now + (testing (str "generated strings match the given pattern " (pr-str form)) + (doseq [s (regal-gen/sample form)] + (is (re-find (regal/regex form) s))))))) diff --git a/test-resources/lib_tests/medley/core_test.cljc b/test-resources/lib_tests/medley/core_test.cljc new file mode 100644 index 00000000..98f6c505 --- /dev/null +++ b/test-resources/lib_tests/medley/core_test.cljc @@ -0,0 +1,409 @@ +(ns medley.core-test + #?(:clj (:import [clojure.lang ArityException])) + (:require #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [medley.core :as m])) + +(deftest test-find-first + (testing "sequences" + (is (= (m/find-first even? [7 3 3 2 8]) 2)) + (is (nil? (m/find-first even? [7 3 3 7 3])))) + (testing "transducers" + (is (= (transduce (m/find-first even?) + 0 [7 3 3 2 8]) 2)) + (is (= (transduce (m/find-first even?) + 0 [7 3 3 7 3]) 0)))) + +(deftest test-dissoc-in + (is (= (m/dissoc-in {:a {:b {:c 1 :d 2}}} [:a :b :c]) + {:a {:b {:d 2}}})) + (is (= (m/dissoc-in {:a {:b {:c 1}}} [:a :b :c]) + {})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2}} [:a :b :c]) + {:a {:d 2}})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2} :b {:c {:d 2 :e 3}}} [:a :b :c] [:b :c :d]) + {:a {:d 2} :b {:c {:e 3}}})) + (is (= (m/dissoc-in {:a 1} []) + {:a 1}))) + +(deftest test-assoc-some + (is (= (m/assoc-some {:a 1} :b 2) {:a 1 :b 2})) + (is (= (m/assoc-some {:a 1} :b nil) {:a 1})) + (is (= (m/assoc-some {:a 1} :b 2 :c nil :d 3) {:a 1 :b 2 :d 3}))) + +(deftest test-update-existing + (is (= (m/update-existing {:a 1} :a inc) {:a 2})) + (is (= (m/update-existing {:a 1 :b 2} :a inc) {:a 2 :b 2})) + (is (= (m/update-existing {:b 2} :a inc) {:b 2})) + (is (= (m/update-existing {:a nil} :a str) {:a ""})) + (is (= (m/update-existing {} :a str) {}))) + +(deftest test-update-existing-in + (is (= (m/update-existing-in {:a 1} [:a] inc) {:a 2})) + (is (= (m/update-existing-in {:a 1 :b 2} [:a] inc) {:a 2 :b 2})) + (is (= (m/update-existing-in {:b 2} [:a] inc) {:b 2})) + (is (= (m/update-existing-in {:a nil} [:a] str) {:a ""})) + (is (= (m/update-existing-in {} [:a] str) {})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] inc) + {:a [:b {:c 43} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 7) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 4) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 3 1) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] vector 9 10 11 12 13 14) + {:a [:b {:c [42 9 10 11 12 13 14]} :d]}))) + +(deftest test-map-entry + (is (= (key (m/map-entry :a 1)) :a)) + (is (= (val (m/map-entry :a 1)) 1)) + (is (= (first (m/map-entry :a 1)) :a)) + (is (= (second (m/map-entry :a 1)) 1)) + (is (= (type (m/map-entry :a 1)) + (type (first {:a 1}))))) + +(defrecord MyRecord [x]) + +(deftest test-map-kv + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) (sorted-map :a 1 :b 2)) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (testing "map-kv with record" + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) (->MyRecord 1)) {"x" 2})))) + +(deftest test-map-keys + (is (= (m/map-keys name {:a 1 :b 2}) + {"a" 1 "b" 2})) + (is (= (m/map-keys name (sorted-map :a 1 :b 2)) + (sorted-map "a" 1 "b" 2))) + (testing "map-keys with record" + (is (= (m/map-keys name (->MyRecord 1)) {"x" 1})))) + +(deftest test-map-vals + (is (= (m/map-vals inc {:a 1 :b 2}) + {:a 2 :b 3})) + (is (= (m/map-vals inc (sorted-map :a 1 :b 2)) + (sorted-map :a 2 :b 3))) + (testing "map-vals with record" + (is (= (m/map-vals inc (->MyRecord 1)) {:x 2}))) + (testing "multiple collections" + (is (= (m/map-vals + {:a 1 :b 2 :c 3} {:a 4 :c 5 :d 6}) + {:a 5, :c 8})) + (is (= (m/map-vals min + (sorted-map :z 10 :y 8 :x 4) + {:x 7, :y 14, :z 13} + {:x 11, :y 6, :z 9} + {:x 19, :y 3, :z 2} + {:x 4, :y 0, :z 16} + {:x 17, :y 14, :z 13}) + (sorted-map :x 4 :y 0 :z 2))) + (is (= (m/map-vals #(%1 %2) {:a nil? :b some?} {:b nil}) + {:b false})))) + +(deftest test-map-kv-keys + (is (= (m/map-kv-keys + {1 2, 2 4}) + {3 2, 6 4})) + (is (= (m/map-kv-keys + (sorted-map 1 2, 2 4)) + (sorted-map 3 2, 6 4))) + (is (= (m/map-kv-keys str (->MyRecord 1)) + {":x1" 1}))) + +(deftest test-map-kv-vals + (is (= (m/map-kv-vals + {1 2, 2 4}) + {1 3, 2 6})) + (is (= (m/map-kv-vals + (sorted-map 1 2, 2 4)) + (sorted-map 1 3, 2 6))) + (is (= (m/map-kv-vals str (->MyRecord 1)) + {:x ":x1"}))) + +(deftest test-filter-kv + (is (= (m/filter-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {:b 2})) + (is (= (m/filter-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-keys + (is (= (m/filter-keys keyword? {"a" 1 :b 2}) + {:b 2})) + (is (= (m/filter-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-vals + (is (= (m/filter-vals even? {:a 1 :b 2}) + {:b 2})) + (is (= (m/filter-vals even? (sorted-map :a 1 :b 2)) + (sorted-map :b 2)))) + +(deftest test-remove-kv + (is (= (m/remove-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {"a" 1 :c "d"})) + (is (= (m/remove-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "a" 1)))) + +(deftest test-remove-keys + (is (= (m/remove-keys keyword? {"a" 1 :b 2}) + {"a" 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-remove-vals + (is (= (m/remove-vals even? {:a 1 :b 2}) + {:a 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-queue + (testing "empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue)))) + (is (empty? (m/queue)))) + (testing "not empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue [1 2 3]))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue [1 2 3])))) + (is (= (first (m/queue [1 2 3])) 1)))) + +(deftest test-queue? + #?(:clj (is (m/queue? clojure.lang.PersistentQueue/EMPTY)) + :cljs (is (m/queue? cljs.core.PersistentQueue.EMPTY))) + (is (not (m/queue? [])))) + +(deftest test-boolean? + (is (m/boolean? true)) + (is (m/boolean? false)) + (is (not (m/boolean? nil))) + (is (not (m/boolean? "foo"))) + (is (not (m/boolean? 1)))) + +(deftest test-least + (is (= (m/least) nil)) + (is (= (m/least "a") "a")) + (is (= (m/least "a" "b") "a")) + (is (= (m/least 3 2 5 -1 0 2) -1))) + +(deftest test-greatest + (is (= (m/greatest) nil)) + (is (= (m/greatest "a") "a")) + (is (= (m/greatest "a" "b") "b")) + (is (= (m/greatest 3 2 5 -1 0 2) 5))) + +(deftest test-join + (is (= (m/join [[1 2] [] [3] [4 5 6]]) [1 2 3 4 5 6])) + (is (= (m/join (sorted-map :x 1, :y 2, :z 3)) [:x 1 :y 2 :z 3])) + (let [a (atom 0) + s (m/join (iterate #(do (swap! a inc) (range (inc (count %)))) ()))] + (is (= (first s) 0)) + (is (= @a 1)) + (is (= (second s) 0)) + (is (= @a 2)))) + +(deftest test-deep-merge + (is (= (m/deep-merge) nil)) + (is (= (m/deep-merge {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} nil) {:a 1})) + (is (= (m/deep-merge {:a 1} {:a 2 :b 3}) {:a 2 :b 3})) + (is (= (m/deep-merge {:a {:b 1 :c 2}} {:a {:b 2 :d 3}}) {:a {:b 2 :c 2 :d 3}})) + (is (= (m/deep-merge {:a {:b 1}} {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} {:b 2} {:b 3 :c 4}) {:a 1 :b 3 :c 4})) + (is (= (m/deep-merge {:a {:b {:c {:d 1}}}} {:a {:b {:c {:e 2}}}}) {:a {:b {:c {:d 1 :e 2}}}})) + (is (= (m/deep-merge {:a {:b [1 2]}} {:a {:b [3 4]}}) {:a {:b [3 4]}})) + (is (= (m/deep-merge (->MyRecord 1) {:x 2}) (->MyRecord 2))) + (is (= (m/deep-merge {:a (->MyRecord 1)} {:a {:x 2 :y 3}}) {:a (map->MyRecord {:x 2 :y 3})}))) + +(deftest test-mapply + (letfn [(foo [& {:keys [bar]}] bar)] + (is (= (m/mapply foo {}) nil)) + (is (= (m/mapply foo {:baz 1}) nil)) + (is (= (m/mapply foo {:bar 1}) 1))) + (letfn [(foo [bar & {:keys [baz]}] [bar baz])] + (is (= (m/mapply foo 0 {}) [0 nil])) + (is (= (m/mapply foo 0 {:baz 1}) [0 1])) + (is (= (m/mapply foo 0 {:spam 1}) [0 nil])) + (is (= (m/mapply foo 0 nil) [0 nil])) + #?@(:clj [;; BB-TEST-PATCH: bb throws Exception + #_(is (thrown? ArityException (m/mapply foo {}))) + (is (thrown? IllegalArgumentException (m/mapply foo 0)))] + :cljs [(is (thrown? js/Error (m/mapply foo 0)))]))) + +(deftest test-index-by + (is (= (m/index-by identity [1 2 3]) {1 1, 2 2, 3 3})) + (is (= (m/index-by inc [1 2 3]) {2 1, 3 2, 4 3})) + (is (= (m/index-by first ["foo" "bar" "baz"]) {\f "foo", \b "baz"})) + (is (= (m/index-by first []) {}))) + +(deftest test-interleave-all + (is (= (m/interleave-all []) [])) + (is (= (m/interleave-all [1 2 3]) [1 2 3])) + (is (= (m/interleave-all [1 2 3] [4 5 6]) [1 4 2 5 3 6])) + (is (= (m/interleave-all [1 2 3] [4 5 6] [7 8 9]) [1 4 7 2 5 8 3 6 9])) + (is (= (m/interleave-all [1 2] [3]) [1 3 2])) + (is (= (m/interleave-all [1 2 3] [4 5]) [1 4 2 5 3])) + (is (= (m/interleave-all [1] [2 3] [4 5 6]) [1 2 4 3 5 6]))) + +(deftest test-distinct-by + (testing "sequences" + (is (= (m/distinct-by count ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (m/distinct-by count []) + [])) + (is (= (m/distinct-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/distinct-by count) ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (into [] (m/distinct-by count) []) + [])) + (is (= (into [] (m/distinct-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-dedupe-by + (testing "sequences" + (is (= (m/dedupe-by count ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (m/dedupe-by count []) + [])) + (is (= (m/dedupe-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/dedupe-by count) ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (into [] (m/dedupe-by count) []) + [])) + (is (= (into [] (m/dedupe-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-take-upto + (testing "sequences" + (is (= (m/take-upto zero? [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (m/take-upto zero? [0 1 2 3 4 5 6]) [0])) + (is (= (m/take-upto zero? [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7]))) + + (testing "tranducers" + (is (= (into [] (m/take-upto zero?) [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (into [] (m/take-upto zero?) [0 1 2 3 4 5 6]) [0])) + (is (= (into [] (m/take-upto zero?) [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7])) + (is (= (transduce (m/take-upto zero?) + (completing (fn [_ x] (reduced x))) + nil + [0 1 2]) + 0)))) + +(deftest test-drop-upto + (testing "sequences" + (is (= (m/drop-upto zero? [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (m/drop-upto zero? [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (m/drop-upto zero? [1 2 3 4 5 6 7]) []))) + + (testing "transducers" + (is (= (into [] (m/drop-upto zero?) [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (into [] (m/drop-upto zero?) [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (into [] (m/drop-upto zero?) [1 2 3 4 5 6 7]) [])))) + +(deftest test-indexed + (testing "sequences" + (is (= (m/indexed [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (m/indexed []) + []))) + + (testing "transducers" + (is (= (into [] (m/indexed) [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (into [] (m/indexed) []) + [])))) + +(deftest test-insert-nth + (testing "sequences" + (is (= (m/insert-nth 0 :a [1 2 3 4]) [:a 1 2 3 4])) + (is (= (m/insert-nth 1 :a [1 2 3 4]) [1 :a 2 3 4])) + (is (= (m/insert-nth 3 :a [1 2 3 4]) [1 2 3 :a 4])) + (is (= (m/insert-nth 4 :a [1 2 3 4]) [1 2 3 4 :a]))) + + (testing "transducers" + (is (= (into [] (m/insert-nth 0 :a) [1 2 3 4]) [:a 1 2 3 4])) + (is (= (into [] (m/insert-nth 1 :a) [1 2 3 4]) [1 :a 2 3 4])) + (is (= (into [] (m/insert-nth 3 :a) [1 2 3 4]) [1 2 3 :a 4])) + (is (= (into [] (m/insert-nth 4 :a) [1 2 3 4]) [1 2 3 4 :a])))) + +(deftest test-remove-nth + (testing "sequences" + (is (= (m/remove-nth 0 [1 2 3 4]) [2 3 4])) + (is (= (m/remove-nth 1 [1 2 3 4]) [1 3 4])) + (is (= (m/remove-nth 3 [1 2 3 4]) [1 2 3]))) + + (testing "transducers" + (is (= (into [] (m/remove-nth 0) [1 2 3 4]) [2 3 4])) + (is (= (into [] (m/remove-nth 1) [1 2 3 4]) [1 3 4])) + (is (= (into [] (m/remove-nth 3) [1 2 3 4]) [1 2 3])))) + +(deftest test-replace-nth + (testing "sequences" + (is (= (m/replace-nth 0 :a [1 2 3 4]) [:a 2 3 4])) + (is (= (m/replace-nth 1 :a [1 2 3 4]) [1 :a 3 4])) + (is (= (m/replace-nth 3 :a [1 2 3 4]) [1 2 3 :a]))) + + (testing "transducers" + (is (= (into [] (m/replace-nth 0 :a) [1 2 3 4]) [:a 2 3 4])) + (is (= (into [] (m/replace-nth 1 :a) [1 2 3 4]) [1 :a 3 4])) + (is (= (into [] (m/replace-nth 3 :a) [1 2 3 4]) [1 2 3 :a])))) + +(deftest test-abs + (is (= (m/abs -3) 3)) + (is (= (m/abs 2) 2)) + (is (= (m/abs -2.1) 2.1)) + (is (= (m/abs 1.8) 1.8)) + #?@(:clj [(is (= (m/abs -1/3) 1/3)) + (is (= (m/abs 1/2) 1/2)) + (is (= (m/abs 3N) 3N)) + (is (= (m/abs -4N) 4N))])) + +(deftest test-deref-swap! + (let [a (atom 0)] + (is (= (m/deref-swap! a inc) 0)) + (is (= @a 1)) + (is (= (m/deref-swap! a inc) 1)) + (is (= @a 2)))) + +(deftest test-deref-reset! + (let [a (atom 0)] + (is (= (m/deref-reset! a 3) 0)) + (is (= @a 3)) + (is (= (m/deref-reset! a 1) 3)) + (is (= @a 1)))) + +(deftest test-ex-message + (is (= (m/ex-message (ex-info "foo" {})) "foo")) + (is (= (m/ex-message (new #?(:clj Exception :cljs js/Error) "bar")) "bar"))) + +(deftest test-ex-cause + (let [cause (new #?(:clj Exception :cljs js/Error) "foo")] + (is (= (m/ex-cause (ex-info "foo" {} cause)) cause)) + #?(:clj (is (= (m/ex-cause (Exception. "foo" cause)) cause))))) + +(deftest test-uuid? + (let [x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6"] + (is (m/uuid? x)) + (is (not (m/uuid? 2))) + (is (not (m/uuid? (str x)))) + (is (not (m/uuid? nil))))) + +(deftest test-uuid + (let [x (m/uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (= x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")))) + +(deftest test-random-uuid + (let [x (m/random-uuid) + y (m/random-uuid)] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) y)) + (is (not= x y)))) + +;; BB-TEST-PATCH: Not available yet for latest maven release +#_(deftest test-regexp? + (is (m/regexp? #"x")) + (is (not (m/regexp? "x"))) + (is (not (m/regexp? nil)))) diff --git a/test-resources/lib_tests/medley/test_runner.cljs b/test-resources/lib_tests/medley/test_runner.cljs new file mode 100644 index 00000000..4cc95109 --- /dev/null +++ b/test-resources/lib_tests/medley/test_runner.cljs @@ -0,0 +1,5 @@ +(ns medley.test-runner + (:require [doo.runner :refer-macros [doo-tests]] + [medley.core-test])) + +(doo-tests 'medley.core-test) diff --git a/test-resources/lib_tests/table/core_test.clj b/test-resources/lib_tests/table/core_test.clj index c2e609bf..336f85e1 100644 --- a/test-resources/lib_tests/table/core_test.clj +++ b/test-resources/lib_tests/table/core_test.clj @@ -310,7 +310,7 @@ ") (table-str [[1 2] [:c :d] [:a :b]] :sort true)))) -;; BB-TEST-PATCH: Intermittent failing test +;; TODO: Intermittent failing test #_(deftest test-table-with-sort-option-as-field-name (is (= (unindent