From 1870e2729e8f5b80329e4d946e8d39f45b4772e9 Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Sun, 4 Apr 2021 16:22:45 +0200 Subject: [PATCH] [#769] rewrite-clj support --- deps.edn | 4 +- .../babashka/impl/rewrite_clj.clj | 67 ++ project.clj | 6 +- sci | 2 +- script/compile | 4 +- script/uberjar | 7 + script/uberjar.bat | 7 + src/babashka/impl/clojure/core.clj | 37 +- src/babashka/impl/clojure/test.clj | 20 +- src/babashka/impl/features.clj | 4 + src/babashka/main.clj | 18 +- .../lib_tests/babashka/run_all_libtests.clj | 7 + .../rewrite_clj/node/coercer_test.cljc | 192 ++++++ .../lib_tests/rewrite_clj/node_test.cljc | 212 +++++++ .../lib_tests/rewrite_clj/paredit_test.cljc | 556 +++++++++++++++++ .../lib_tests/rewrite_clj/parser_test.cljc | 578 ++++++++++++++++++ .../rewrite_clj/zip/subedit_test.cljc | 51 ++ .../lib_tests/rewrite_clj/zip_test.cljc | 172 ++++++ test/babashka/test_test.clj | 9 + 19 files changed, 1938 insertions(+), 15 deletions(-) create mode 100644 feature-rewrite-clj/babashka/impl/rewrite_clj.clj create mode 100644 test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc create mode 100644 test-resources/lib_tests/rewrite_clj/node_test.cljc create mode 100644 test-resources/lib_tests/rewrite_clj/paredit_test.cljc create mode 100644 test-resources/lib_tests/rewrite_clj/parser_test.cljc create mode 100644 test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc create mode 100644 test-resources/lib_tests/rewrite_clj/zip_test.cljc diff --git a/deps.edn b/deps.edn index 797ec822..02b93153 100644 --- a/deps.edn +++ b/deps.edn @@ -7,6 +7,7 @@ "feature-hiccup" "feature-test-check" "feature-spec-alpha" + "feature-rewrite-clj" "pods/src" "babashka.nrepl/src" "depstar/src" "process/src" @@ -33,7 +34,8 @@ http-kit/http-kit {:mvn/version "2.5.3"} babashka/clojure-lanterna {:mvn/version "0.9.8-SNAPSHOT"} org.clojure/core.match {:mvn/version "1.0.0"} - hiccup/hiccup {:mvn/version "2.0.0-alpha2"}} + hiccup/hiccup {:mvn/version "2.0.0-alpha2"} + rewrite-clj/rewrite-clj {:mvn/version "1.0.605-alpha"}} :aliases {:babashka/dev {:main-opts ["-m" "babashka.main"]} :profile diff --git a/feature-rewrite-clj/babashka/impl/rewrite_clj.clj b/feature-rewrite-clj/babashka/impl/rewrite_clj.clj new file mode 100644 index 00000000..6b7fddf8 --- /dev/null +++ b/feature-rewrite-clj/babashka/impl/rewrite_clj.clj @@ -0,0 +1,67 @@ +(ns babashka.impl.rewrite-clj + {:no-doc true} + (:require [rewrite-clj.node] + [rewrite-clj.paredit] + [rewrite-clj.parser] + [rewrite-clj.zip] + [rewrite-clj.zip.subedit] + [sci.core :as sci])) + +(def nns (sci/create-ns 'rewrite-clj.node nil)) +(def pens (sci/create-ns 'rewrite-clj.paredit nil)) +(def pns (sci/create-ns 'rewrite-clj.parser nil)) +(def zns (sci/create-ns 'rewrite-clj.zip nil)) +(def zsns (sci/create-ns 'rewrite-clj.zip.subedit nil)) + +#_(defmacro copy-var + "Copies contents from var `sym` to a new sci var. The value `ns` is an + object created with `sci.core/create-ns`." + ([sym ns] + `(let [ns# ~ns + var# (var ~sym) + val# (deref var#) + m# (-> var# meta) + ns-name# (vars/getName ns#) + name# (:name m#) + name-sym# (symbol (str ns-name#) (str name#)) + new-m# {:doc (:doc m#) + :name name# + :arglists (:arglists m#) + :ns ns#}] + (cond (:dynamic m#) + (new-dynamic-var name# val# new-m#) + (:macro m#) + (new-macro-var name# val# new-m#) + :else (new-var name# val# new-m#))))) + +(defn make-ns [ns sci-ns] + (reduce (fn [ns-map [var-name var]] + (let [m (meta var) + no-doc (:no-doc m) + doc (:doc m) + arglists (:arglists m)] + (if no-doc ns-map + (assoc ns-map var-name + (sci/new-var (symbol var-name) @var + (cond-> {:ns sci-ns + :name (:name m)} + (:macro m) (assoc :macro true) + doc (assoc :doc doc) + arglists (assoc :arglists arglists))))))) + {} + (ns-publics ns))) + +(def node-namespace + (make-ns 'rewrite-clj.node nns)) + +(def parser-namespace + (make-ns 'rewrite-clj.parser pns)) + +(def paredit-namespace + (make-ns 'rewrite-clj.paredit pens)) + +(def zip-namespace + (make-ns 'rewrite-clj.zip zns)) + +(def subedit-namespace + (make-ns 'rewrite-clj.zip.subedit zsns)) diff --git a/project.clj b/project.clj index 5f98126c..8f88485a 100644 --- a/project.clj +++ b/project.clj @@ -52,6 +52,8 @@ :dependencies [[hiccup/hiccup "2.0.0-alpha2"]]} :feature/test-check {:source-paths ["feature-test-check"]} :feature/spec-alpha {:source-paths ["feature-spec-alpha"]} + :feature/rewrite-clj {:source-paths ["feature-rewrite-clj"] + :dependencies [[rewrite-clj/rewrite-clj "1.0.605-alpha"]]} :test [:feature/xml :feature/lanterna :feature/yaml @@ -67,11 +69,13 @@ :feature/hiccup :feature/test-check :feature/spec-alpha + :feature/rewrite-clj {:dependencies [[com.clojure-goes-fast/clj-async-profiler "0.4.1"] [com.opentable.components/otj-pg-embedded "0.13.3"]]}] :uberjar {:global-vars {*assert* false} :jvm-opts ["-Dclojure.compiler.direct-linking=true" - "-Dclojure.spec.skip-macros=true"] + "-Dclojure.spec.skip-macros=true" + "-Dborkdude.dynaload.aot=true"] :main babashka.main :aot :all} :reflection {:main babashka.impl.classes/generate-reflection-file}} diff --git a/sci b/sci index 106919aa..386ff4c3 160000 --- a/sci +++ b/sci @@ -1 +1 @@ -Subproject commit 106919aad41062055828df832acb863080e4b5bd +Subproject commit 386ff4c3d4f8d0aba11947beccb8320d75c5fcf8 diff --git a/script/compile b/script/compile index da9d08a2..95291f3f 100755 --- a/script/compile +++ b/script/compile @@ -41,8 +41,7 @@ BABASHKA_BINARY=${BABASHKA_BINARY:-"bb"} args=( "-jar" "$BABASHKA_JAR" "-H:Name=$BABASHKA_BINARY" "-H:+ReportExceptionStackTraces" - "-J-Dclojure.spec.skip-macros=true" - "-J-Dclojure.compiler.direct-linking=true" + "-J-Dborkdude.dynaload.aot=true" "-H:IncludeResources=BABASHKA_VERSION" "-H:IncludeResources=SCI_VERSION" "-H:ReflectionConfigurationFiles=reflection.json" @@ -104,6 +103,7 @@ then export BABASHKA_FEATURE_HICCUP="${BABASHKA_FEATURE_HICCUP:-false}" export BABASHKA_FEATURE_TEST_CHECK="${BABASHKA_FEATURE_TEST_CHECK:-false}" export BABASHKA_FEATURE_SPEC_ALPHA="${BABASHKA_FEATURE_SPEC_ALPHA:-false}" + export BABASHKA_FEATURE_REWRITE_CLJ="${BABASHKA_FEATURE_REWRITE_CLJ:-false}" fi "$GRAALVM_HOME/bin/native-image" "${args[@]}" diff --git a/script/uberjar b/script/uberjar index 56e64669..cc699bab 100755 --- a/script/uberjar +++ b/script/uberjar @@ -146,6 +146,13 @@ else BABASHKA_LEIN_PROFILES+=",-feature/spec-alpha" fi +if [ "$BABASHKA_FEATURE_REWRITE_CLJ" != "false" ] +then + BABASHKA_LEIN_PROFILES+=",+feature/rewrite-clj" +else + BABASHKA_LEIN_PROFILES+=",-feature/rewrite-clj" +fi + if [ -z "$BABASHKA_JAR" ]; then lein with-profiles "$BABASHKA_LEIN_PROFILES,+reflection,-uberjar" do run lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar diff --git a/script/uberjar.bat b/script/uberjar.bat index 6e71856f..fba9e27c 100755 --- a/script/uberjar.bat +++ b/script/uberjar.bat @@ -112,6 +112,13 @@ set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/spec-alpha set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/spec-alpha ) +if not "%BABASHKA_FEATURE_REWRITE_CLJ%"=="false" ( +set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/rewrite-clj +) else ( +set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/rewrite-clj +) + + call lein with-profiles %BABASHKA_LEIN_PROFILES% bb "(+ 1 2 3)" call lein with-profiles %BABASHKA_LEIN_PROFILES%,+reflection,-uberjar do run diff --git a/src/babashka/impl/clojure/core.clj b/src/babashka/impl/clojure/core.clj index a0f3e946..adee7793 100644 --- a/src/babashka/impl/clojure/core.clj +++ b/src/babashka/impl/clojure/core.clj @@ -1,11 +1,11 @@ (ns babashka.impl.clojure.core {:no-doc true} - (:refer-clojure :exclude [future read+string]) + (:refer-clojure :exclude [future read+string clojure-version]) (:require [babashka.impl.common :as common] [borkdude.graal.locking :as locking] [clojure.string :as str] [sci.core :as sci] - [sci.impl.namespaces :refer [copy-core-var]])) + [sci.impl.namespaces :refer [copy-core-var #_clojure-core-ns]])) (defn locking* [form bindings v f & args] (apply @#'locking/locking form bindings v f args)) @@ -23,6 +23,33 @@ (def command-line-args (sci/new-dynamic-var '*command-line-args* nil)) (def warn-on-reflection (sci/new-dynamic-var '*warn-on-reflection* false)) +;; (def major (:major *clojure-version*)) +;; (def minor (:minor *clojure-version*)) +;; (def incremental (:incremental *clojure-version*)) +;; (def qualifier (str "sci" (when-let [q (:qualifier *clojure-version*)] +;; (str "+" q)))) + +;; (def clojure-ver {:major major +;; :minor minor +;; :incremental incremental +;; :qualifier qualifier}) + +;; (defn clojure-version +;; "Returns clojure version as a printable string." +;; {:added "1.0"} +;; [] +;; (str major +;; "." +;; minor +;; (when-let [i incremental] +;; (str "." i)) +;; (when-let [q qualifier] +;; (when (pos? (count q)) (str "-" q))) +;; (when incremental +;; "-SNAPSHOT"))) + +;; (def clojure-version-var (sci/new-dynamic-var '*clojure-version* clojure-ver)) + (defn read+string "Added for compatibility. Must be used with clojure.lang.LineNumberingPushbackReader. Does not support all of @@ -63,4 +90,8 @@ 'read+string (fn [& args] (apply read+string @common/ctx args)) '*command-line-args* command-line-args - '*warn-on-reflection* warn-on-reflection}) + '*warn-on-reflection* warn-on-reflection + ;;'*clojure-version* clojure-version-var + ;;'clojure-version (sci/copy-var clojure-version clojure-core-ns) + } + ) diff --git a/src/babashka/impl/clojure/test.clj b/src/babashka/impl/clojure/test.clj index a0ef82a4..e714e3df 100644 --- a/src/babashka/impl/clojure/test.clj +++ b/src/babashka/impl/clojure/test.clj @@ -387,15 +387,26 @@ ;;; UTILITIES FOR ASSERTIONS +(defn get-possibly-unbound-var + "Like var-get but returns nil if the var is unbound." + {:added "1.1"} + [v] + (try (deref v) + (catch IllegalStateException _ + nil))) + (defn function? "Returns true if argument is a function or a symbol that resolves to a function (not a macro)." {:added "1.1"} [x] - (if (symbol? x) ;; TODO + (if (symbol? x) (when-let [v (second (resolve/lookup @ctx x false))] - (when-let [value (if (vars/var? v) @v v)] + (when-let [value (if (vars/var? v) + (get-possibly-unbound-var v) + v)] (and (fn? value) + (not (:macro (meta v))) (not (:sci/macro (meta v)))))) (fn? x))) @@ -444,7 +455,7 @@ ;; symbol in the test expression. (defmulti assert-expr - (fn [msg form] + (fn [_msg form] (cond (nil? form) :always-fail (seq? form) (first form) @@ -548,7 +559,8 @@ {:added "1.1"} ([form] `(clojure.test/is ~form nil)) - ([form msg] `(clojure.test/try-expr ~msg ~form))) + ([form msg] + `(clojure.test/try-expr ~msg ~form))) (defmacro are "Checks multiple assertions with a template expression. diff --git a/src/babashka/impl/features.clj b/src/babashka/impl/features.clj index ee097903..acca92fa 100644 --- a/src/babashka/impl/features.clj +++ b/src/babashka/impl/features.clj @@ -14,6 +14,7 @@ (def core-match? (not= "false" (System/getenv "BABASHKA_FEATURE_CORE_MATCH"))) (def hiccup? (not= "false" (System/getenv "BABASHKA_FEATURE_HICCUP"))) (def test-check? (not= "false" (System/getenv "BABASHKA_FEATURE_TEST_CHECK"))) +(def rewrite-clj? (not= "false" (System/getenv "BABASHKA_FEATURE_REWRITE_CLJ"))) ;; excluded by default (def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC"))) @@ -66,3 +67,6 @@ (when spec-alpha? (require '[babashka.impl.spec])) + +(when rewrite-clj? + (require '[babashka.impl.rewrite-clj])) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index b5ec5dc5..280497e9 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -191,7 +191,8 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.") :feature/core-match %s :feature/hiccup %s :feature/test-check %s - :feature/spec-alpha %s}") + :feature/spec-alpha %s + :feature/rewrite-clj %s}") version features/core-async? features/csv? @@ -208,7 +209,8 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.") features/core-match? features/hiccup? features/test-check? - features/spec-alpha?))) + features/spec-alpha? + features/rewrite-clj?))) (defn read-file [file] (let [f (io/file file)] @@ -337,7 +339,17 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.") features/spec-alpha? (-> (assoc ;; spec 'clojure.spec.alpha @(resolve 'babashka.impl.spec/spec-namespace) 'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-namespace) - 'clojure.spec.test.alpha @(resolve 'babashka.impl.spec/test-namespace))))) + 'clojure.spec.test.alpha @(resolve 'babashka.impl.spec/test-namespace))) + features/rewrite-clj? (assoc 'rewrite-clj.node + @(resolve 'babashka.impl.rewrite-clj/node-namespace) + 'rewrite-clj.paredit + @(resolve 'babashka.impl.rewrite-clj/paredit-namespace) + 'rewrite-clj.parser + @(resolve 'babashka.impl.rewrite-clj/parser-namespace) + 'rewrite-clj.zip + @(resolve 'babashka.impl.rewrite-clj/zip-namespace) + 'rewrite-clj.zip.subedit + @(resolve 'babashka.impl.rewrite-clj/subedit-namespace)))) (def imports '{ArithmeticException java.lang.ArithmeticException diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index 317ab5c7..9154f989 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -189,6 +189,13 @@ (test-namespaces 'failjure.test-core) +(test-namespaces 'rewrite-clj.parser-test + 'rewrite-clj.node-test + 'rewrite-clj.zip-test + 'rewrite-clj.paredit-test + 'rewrite-clj.zip.subedit-test + 'rewrite-clj.node.coercer-test) + ;;;; final exit code (let [{:keys [:test :fail :error] :as m} @status] diff --git a/test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc b/test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc new file mode 100644 index 00000000..f0e858e3 --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc @@ -0,0 +1,192 @@ +(ns rewrite-clj.node.coercer-test + (:require [clojure.test :refer [deftest testing is are]] + [rewrite-clj.node :as node] + [rewrite-clj.parser :as p])) + +(deftest t-sexpr->node->sexpr-roundtrip + (testing "simple cases roundtrip" + (are [?sexpr expected-tag ] + (let [n (node/coerce ?sexpr)] + (is (node/node? n)) + (is (= ?sexpr (node/sexpr n))) + (is (string? (node/string n))) + (is (= expected-tag (node/tag n)) "tag") + (is (not (meta n))) + (is (= (type ?sexpr) (type (node/sexpr n))))) + + ;; numbers + + ;; note that we do have an integer-node, but rewrite-clj never parses to it + ;; so we never coerce to it either + 3 :token ;;:token + 3N :token ;;:token + 3.14 :token ;;:token + 3.14M :token ;;:token + 3e14 :token ;;:token + + ;; ratios are not valid in cljs + #?@(:clj [3/4 :token ;;:token + ] + ) + + ;; symbol/keyword/string/... + 'symbol :token ;;:symbol + 'namespace/symbol :token ;;:symbol + :keyword :token ;;:keyword + :1.5.1 :token ;;:keyword + ::keyword :token ;;:keyword + ::1.5.1 :token ;;:keyword + :namespace/keyword :token ;;:keyword + + "" :token ;;:string + "hello, over there!" :token ;;:string + "multi\nline" :multi-line ;;:string + " " :token ;;:string + "\n" :multi-line ;;:string + "\n\n" :multi-line ;;:string + "," :token ;;:string + + ;; seqs + [] :vector ;;:seq + [1 2 3] :vector ;;:seq + () :list ;;:seq + '() :list ;;:seq + (list 1 2 3) :list ;;:seq + #{} :set ;;:seq + #{1 2 3} :set ;;:seq + + ;; date + #inst "2014-11-26T00:05:23" :token ;; :token + )) + (testing "multi-line string newline variants are normalized" + (let [s "hey\nyou\rover\r\nthere" + n (node/coerce s)] + (is (= "hey\nyou\nover\nthere" (node/sexpr n)))))) + +(deftest + t-quoted-list-reader-location-metadata-elided + (are [?sexpr expected-meta-keys] + (let [n (node/coerce ?sexpr)] + (is (node/node? n)) + (is (= expected-meta-keys (node/string n))) + (is (string? (node/string n))) + (is (= ?sexpr (node/sexpr n))) + (is (not (meta n))) + (is (= (type ?sexpr) (type (node/sexpr n))))) + '(1 2 3) "(1 2 3)" + '^:other-meta (4 5 6) "^{:other-meta true} (4 5 6)")) + +(deftest t-maps + (are [?sexpr] + (let [n (node/coerce ?sexpr)] + (is (node/node? n)) + (is (= :map (node/tag n))) + ;; (is (= :seq protocols/node-type n)) + (is (string? (node/string n))) + (is (= ?sexpr (node/sexpr n))) + ;; we do not restore to original map (hash-map or array-map), + ;; checking if we convert to any map is sufficient + (is (map? (node/sexpr n)))) + {} + {:a 1 :b 2} + (hash-map) + (hash-map :a 0 :b 1) + (array-map) + (array-map :d 4 :e 5))) + +(deftest t-namespaced-maps-coerce-to-maps + (are [?sexpr] + (let [n (node/coerce ?sexpr)] + (is (node/node? n)) + (is (= :map (node/tag n))) + ;; (is (= :seq (protocols/node-type n))) + (is (string? (node/string n))) + (is (= ?sexpr (node/sexpr n))) + (is (map? (node/sexpr n)))) + #:prefix {:a 1 :b 2} + #::{:c 3 :d 4} + #::p{:e 5 :f 6})) + +(deftest t-sexpr->node->sexpr-roundtrip-for-regex + (are [?in] + (let [n (node/coerce ?in)] + (is (node/node? n)) + (is (= :regex (node/tag n))) + ;; (is (= :regex (protocols/node-type n))) + (is (string? (node/string n))) + #_(is (= (list 're-pattern (regex/pattern-string-for-regex ?in)) + (node/sexpr n)))) + #"abc" + #"a\nb\nc" + #"a\.\s*" + #"[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?")) + +#_(deftest + ^:skip-for-sci ;; sci, by design has its own var type, so skip this one for sci + t-vars + (let [n (node/coerce #'identity)] + (is (node/node? n)) + (is (= :var (node/tag n))) + #_(is (= :reader (protocols/node-type n))) + (is (= '(var #?(:clj clojure.core/identity :cljs cljs.core/identity)) (node/sexpr n))))) + +(deftest t-nil + (let [n (node/coerce nil)] + (is (node/node? n)) + (is (= :token (node/tag n))) + #_(is (= :token (protocols/node-type n))) + (is (= nil (node/sexpr n))) + (is (= n (p/parse-string "nil"))))) + +(defrecord Foo-Bar [a]) + +#_(deftest + ^:skip-for-sci ;; records have special metadata in sci, so skip this one for sci + t-records + (let [v (Foo-Bar. 0) + n (node/coerce v)] + (is (node/node? n)) + ;; records are represented by rewrite-clj reader macro nodes + (is (= :reader-macro (node/tag n))) + (is (= (pr-str v) (node/string n))))) + +(deftest t-nodes-coerce-to-themselves + (testing "parsed nodes" + ;; lean on the parser to create node structures + (are [?s ?tag #_?type] + (let [n (p/parse-string ?s)] + (is (= n (node/coerce n))) + (is (= ?tag (node/tag n))) + #_(is (= ?type (protocols/node-type n)))) + ";; comment" :comment ;;:comment + "#! comment" :comment ;;:comment + "#(+ 1 %)" :fn ;;:fn + ":my-kw" :token ;;:keyword + "^:m1 [1 2 3]" :meta ;;:meta + "#:p1{:a 1 :b 2}" :namespaced-map ;;:namespaced-map + "'a" :quote ;;:quote + "#'var" :var ;;:reader + "#=eval" :eval ;;:reader + "@deref" :deref ;;:deref + "#mymacro 44" :reader-macro ;;:reader-macro + "#\"regex\"" :regex ;;:regex + "[1 2 3]" :vector ;;:seq + "42" :token ;;:token + "sym" :token ;;:symbol + "#_ 99" :uneval ;;:uneval + " " :whitespace ;;:whitespace + "," :comma ;;:comma + "\n" :newline ;;:newline + )) + (testing "parsed forms nodes" + (let [n (p/parse-string-all "(def a 1)")] + (is (= n (node/coerce n))) + (is (= :forms (node/tag n))))) + (testing "map qualifier node" + (let [n (node/map-qualifier-node false "prefix")] + (is (= n (node/coerce n))))) + (testing "nodes that are not parsed, but can be created manually" + (let [n (node/integer-node 10)] + (is (= n (node/coerce n)))) + (let [n (node/string-node "my-string")] + (is (= n (node/coerce n)))))) diff --git a/test-resources/lib_tests/rewrite_clj/node_test.cljc b/test-resources/lib_tests/rewrite_clj/node_test.cljc new file mode 100644 index 00000000..0edf2af0 --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/node_test.cljc @@ -0,0 +1,212 @@ +(ns rewrite-clj.node-test + "This test namespace originated from rewrite-cljs." + (:require [clojure.test :refer [deftest is are testing]] + [rewrite-clj.node :as n] + ;; [rewrite-clj.node.protocols :as proto] + [rewrite-clj.parser :as p])) + +(deftest nodes-convert-to-strings-and-sexpr-ability + (testing "easily parseable" + (are [?in ?expected-tag #_#_?expected-type ?expected-sexpr-able?] + (let [n (p/parse-string ?in)] + (is (= ?in (str n))) + (is (= ?expected-tag (n/tag n))) + #_(is (= ?expected-type (proto/node-type n))) + #_(is (= ?expected-sexpr-able? (n/sexpr-able? n)))) + "," :comma ;;:comma false + "; comment" :comment ;;:comment false + "#! comment" :comment ;;:comment false + "@deref" :deref ;;:deref true + "#(fn %1)" :fn ;;:fn true + ":my-kw" :token ;;:keyword true + "^:meta b" :meta ;;:meta true + "#:prefix {:a 1}" :namespaced-map ;;:namespaced-map true + "\n" :newline ;;:newline false + "'quoted" :quote ;;:quote true + "#booya 32" :reader-macro ;;:reader-macro true + "#'myvar" :var ;;:reader true + "#\"regex\"" :regex ;;:regex true + "[1 2 3]" :vector ;;:seq true + "\"string\"" :token ;;:string true + "symbol" :token ;;:symbol true + "43" :token ;;:token true + "#_ nope" :uneval ;;:uneval false + " " :whitespace ;;:whitespace false + ) + ) + (testing "map qualifier" + (are [?auto-resolved ?prefix ?expected-str] + (let [n (n/map-qualifier-node ?auto-resolved ?prefix)] + (is (= ?expected-str (str n))) + (is (= :map-qualifier (n/tag n))) + #_(is (= :map-qualifier (proto/node-type n))) + (is (= true (n/sexpr-able? n)))) + false "prefix" ":prefix" + true nil "::" + true "nsalias" "::nsalias")) + (testing "integer" + (let [n (n/integer-node 42)] + (is (= :token (n/tag n))) + #_(is (= :int (proto/node-type n))) + (is (= "42" (str n))) + (is (n/sexpr-able? n)))) + (testing "forms node" + (let [n (p/parse-string-all "5 7")] + (is (= "5 7" (str n))) + (is (n/sexpr-able? n))))) + + +(deftest namespaced-keyword + (is (= ":dill/dall" + (n/string (n/keyword-node :dill/dall))))) + +(deftest funky-keywords + (is (= ":%dummy.*" + (n/string (n/keyword-node :%dummy.*))))) + +(deftest regex-node + (let [sample "(re-find #\"(?i)RUN\" s)" + sample2 "(re-find #\"(?m)^rss\\s+(\\d+)$\")" + sample3 "(->> (str/split container-name #\"/\"))"] + (is (= sample (-> sample p/parse-string n/string))) + (is (= sample2 (-> sample2 p/parse-string n/string))) + (is (= sample3 (-> sample3 p/parse-string n/string))))) + +(deftest regex-with-newlines + (let [sample "(re-find #\"Hello + \\nJalla\")"] + (is (= sample (-> sample p/parse-string n/string))))) + +(deftest reader-conditionals + (testing "Simple reader conditional" + (let [sample "#?(:clj bar)" + res (p/parse-string sample)] + (is (= sample (n/string res))) + (is (= :reader-macro (n/tag res))) + (is (= [:token :list] (map n/tag (n/children res)))))) + + (testing "Reader conditional with space before list" + (let [sample "#? (:clj bar)" + sample2 "#?@ (:clj bar)"] + (is (= sample (-> sample p/parse-string n/string))) + (is (= sample2 (-> sample2 p/parse-string n/string))))) + + + (testing "Reader conditional with splice" + (let [sample +"(:require [clojure.string :as s] + #?@(:clj [[clj-time.format :as tf] + [clj-time.coerce :as tc]] + :cljs [[cljs-time.coerce :as tc] + [cljs-time.format :as tf]]))" + res (p/parse-string sample)] + (is (= sample (n/string res)))))) + +(deftest t-node? + (is (not (n/node? nil))) + (is (not (n/node? 42))) + (is (not (n/node? "just a string"))) + (is (not (n/node? {:a 1}))) + (is (not (n/node? (first {:a 1})))) + (is (n/node? (n/list-node (list 1 2 3)))) + (is (n/node? (n/string-node "123")))) + +(deftest t-sexpr-on-map-qualifiable-nodes + (let [opts {:auto-resolve (fn [alias] + (if (= :current alias) + 'my.current.ns + (get {'my-alias 'my.aliased.ns + 'nsmap-alias 'nsmap.aliased.ns} + alias + (symbol (str alias "-unresolved")))))} + sexpr-default n/sexpr + sexpr-custom #(n/sexpr % opts) + map-qualifier (n/map-qualifier-node false "nsmap-prefix") + map-qualifier-current-ns (n/map-qualifier-node true nil) + map-qualifier-ns-alias (n/map-qualifier-node true "nsmap-alias")] + (testing "qualified nodes are unaffected by resolver" + (are [?result ?node] + (do + (is (= ?result (-> ?node sexpr-default))) + (is (= ?result (-> ?node sexpr-custom)))) + :my-kw (n/keyword-node :my-kw) + 'my-sym (n/token-node 'my-sym) + :_/my-kw (n/keyword-node :_/my-kw) + '_/my-sym (n/token-node '_/my-sym) + :my-prefix/my-kw (n/keyword-node :my-prefix/my-kw) + 'my-prefix/my-sym (n/token-node 'my-prefix/my-sym))) + (testing "auto-resolve qualified key nodes are affected by resolver" + (are [?result-default ?result-custom ?node] + (do + (is (= ?result-default (-> ?node sexpr-default))) + (is (= ?result-custom (-> ?node sexpr-custom)))) + :?_current-ns_?/my-kw :my.current.ns/my-kw (n/keyword-node :my-kw true) + :??_my-alias_??/my-kw :my.aliased.ns/my-kw (n/keyword-node :my-alias/my-kw true))) + (testing "map qualified nodes can be affected by resolver" + (are [?result ?node] + (do + (is (= ?result (-> ?node (n/map-context-apply map-qualifier) sexpr-default))) + (is (= ?result (-> ?node (n/map-context-apply map-qualifier) sexpr-custom))) ) + :nsmap-prefix/my-kw (n/keyword-node :my-kw) + 'nsmap-prefix/my-sym (n/token-node 'my-sym))) + (testing "map qualified auto-resolve current-ns nodes can be affected by resolver" + (are [?result-default ?result-custom ?node] + (do + (is (= ?result-default (-> ?node (n/map-context-apply map-qualifier-current-ns) sexpr-default))) + (is (= ?result-custom (-> ?node (n/map-context-apply map-qualifier-current-ns) sexpr-custom)))) + :?_current-ns_?/my-kw :my.current.ns/my-kw (n/keyword-node :my-kw) + '?_current-ns_?/my-sym 'my.current.ns/my-sym (n/token-node 'my-sym))) + (testing "map qualified auto-resolve ns-alias nodes can be affected by resolver" + (are [?result-default ?result-custom ?node] + (do + (is (= ?result-default (-> ?node (n/map-context-apply map-qualifier-ns-alias) sexpr-default))) + (is (= ?result-custom (-> ?node (n/map-context-apply map-qualifier-ns-alias) sexpr-custom)))) + :??_nsmap-alias_??/my-kw :nsmap.aliased.ns/my-kw (n/keyword-node :my-kw) + '??_nsmap-alias_??/my-sym 'nsmap.aliased.ns/my-sym (n/token-node 'my-sym))) + (testing "map qualified nodes that are unaffected by resolver" + (are [?result ?node] + (do + (is (= ?result (-> ?node (n/map-context-apply map-qualifier) sexpr-default))) + (is (= ?result (-> ?node (n/map-context-apply map-qualifier) sexpr-custom))) + + (is (= ?result (-> ?node (n/map-context-apply map-qualifier-current-ns) sexpr-default))) + (is (= ?result (-> ?node (n/map-context-apply map-qualifier-current-ns) sexpr-custom))) + + (is (= ?result (-> ?node (n/map-context-apply map-qualifier-ns-alias) sexpr-default))) + (is (= ?result (-> ?node (n/map-context-apply map-qualifier-ns-alias) sexpr-custom))) ) + :my-kw (n/keyword-node :_/my-kw) + 'my-sym (n/token-node '_/my-sym) + :my-prefix/my-kw (n/keyword-node :my-prefix/my-kw) + 'my-prefix/my-sym (n/token-node 'my-prefix/my-sym))) + (testing "when auto-resolver returns nil, bare or already qualified kw is returned" + (let [opts {:auto-resolve (fn [_alias])}] + (is (= :my-kw (-> (n/keyword-node :my-kw true) (n/sexpr opts)))) + (is (= :my-kw (-> (n/keyword-node :my-alias/my-kw true) (n/sexpr opts)))) + (is (= :my-kw + (-> (n/keyword-node :foo/my-kw true) + (assoc :map-qualifier {:auto-resolved? true :prefix "nsmap-alias"}) + (n/sexpr opts)))) + (is (= :foo/my-kw + (-> (n/keyword-node :foo/my-kw false) + (assoc :map-qualifier {:auto-resolved? true :prefix "nsmap-alias"}) + (n/sexpr opts)))) )))) + +(deftest t-sexpr-on-map-qualifier-node + (testing "with default auto-resolve" + (let [default-mqn-sexpr (fn [s] (-> s p/parse-string n/children first n/sexpr))] + (is (= 'prefix (default-mqn-sexpr "#:prefix {:a 1 :b 2}"))) + (is (= '?_current-ns_? (default-mqn-sexpr "#:: {:a 1 :b 2}"))) + (is (= '??_my-ns-alias_?? (default-mqn-sexpr "#::my-ns-alias {:a 1 :b 2}"))))) + (testing "with custom auto-resolve" + (let [opts {:auto-resolve (fn [alias] + (if (= :current alias) + 'my.current.ns + (get {'my-alias 'my.aliased.ns + 'nsmap-alias 'nsmap.aliased.ns} + alias + (symbol (str alias "-unresolved")))))} + custom-mqn-sexpr (fn [s] (-> s p/parse-string n/children first (n/sexpr opts)))] + (is (= 'prefix (custom-mqn-sexpr "#:prefix {:a 1 :b 2}"))) + (is (= 'my.current.ns (custom-mqn-sexpr "#:: {:a 1 :b 2}"))) + (is (= 'my.aliased.ns (custom-mqn-sexpr "#::my-alias {:a 1 :b 2}"))) + (is (= 'my-alias-nope-unresolved (custom-mqn-sexpr "#::my-alias-nope {:a 1 :b 2}")))))) diff --git a/test-resources/lib_tests/rewrite_clj/paredit_test.cljc b/test-resources/lib_tests/rewrite_clj/paredit_test.cljc new file mode 100644 index 00000000..0dad34d3 --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/paredit_test.cljc @@ -0,0 +1,556 @@ +(ns rewrite-clj.paredit-test + (:require [clojure.test :refer [deftest is]] + [rewrite-clj.paredit :as pe] + [rewrite-clj.zip :as z])) + +;; helper +(defn move-n [loc f n] + (->> loc (iterate f) (take n) last)) + + +(deftest kill-to-end-of-sexpr + (let [res (-> "[1 2 3 4]" + z/of-string + z/down z/right* + pe/kill)] + (is (= "[1]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest kill-to-end-of-line + (let [res (-> "[1 2] ; useless comment" + z/of-string + z/right* + pe/kill)] + (is (= "[1 2]" (-> res z/root-string))) + (is (= "[1 2]" (-> res z/string))))) + +(deftest kill-to-wipe-all-sexpr-contents + (let [res (-> "[1 2 3 4]" + z/of-string + z/down + pe/kill)] + (is (= "[]" (-> res z/root-string))) + (is (= "[]" (-> res z/string))))) + +(deftest kill-to-wipe-all-sexpr-contents-in-nested-seq + (let [res (-> "[[1 2 3 4]]" + z/of-string + z/down + pe/kill)] + (is (= "[]" (-> res z/root-string))) + (is (= "[]" (-> res z/string))))) + +(deftest kill-when-left-is-sexpr + (let [res (-> "[1 2 3 4] 2" + z/of-string + z/right* + pe/kill)] + (is (= "[1 2 3 4]" (-> res z/root-string))) + (is (= "[1 2 3 4]" (-> res z/string))))) + +(deftest kill-it-all + (let [res (-> "[1 2 3 4] 5" + z/of-string + pe/kill)] + (is (= "" (-> res z/root-string))) + (is (= "" (-> res z/string))))) + + + +(deftest kill-at-pos-when-in-empty-seq + (let [res (-> "[] 5" + (z/of-string {:track-position? true}) + (pe/kill-at-pos {:row 1 :col 2}))] + (is (= "5" (-> res z/root-string))) + (is (= "5" (-> res z/string))))) + + +(deftest kill-inside-comment + (is (= "; dill" (-> "; dilldall" + (z/of-string {:track-position? true}) + (pe/kill-at-pos {:row 1 :col 7}) + z/root-string)))) + +(deftest kill-at-pos-when-string + (let [res (-> "(str \"Hello \" \"World!\")" + (z/of-string {:track-position? true}) + z/down + (pe/kill-at-pos {:row 1 :col 9}))] + (is (= "(str \"He\" \"World!\")" (-> res z/root-string))))) + + +(deftest kill-at-pos-when-string-multiline + (let [sample "(str \" +First line + Second Line + Third Line + \")" + expected "(str \" +First line + Second\")" + + res (-> (z/of-string sample {:track-position? true}) + z/down + (pe/kill-at-pos {:row 3 :col 9}))] + (is (= expected (-> res z/root-string))))) + + + +(deftest kill-at-pos-multiline-aligned + (let [sample " +(println \"Hello + There + World\")"] + (is (= "\n(println \"Hello\")" (-> (z/of-string sample {:track-position? true}) + (pe/kill-at-pos {:row 2 :col 16}) + (z/root-string)))))) + + + +(deftest kill-at-pos-when-empty-string + (is (= "" (-> (z/of-string "\"\"" {:track-position? true}) + (pe/kill-at-pos {:row 1 :col 1}) z/root-string)))) + + + +(deftest kill-one-at-pos + (let [sample "[10 20 30]" ] + (is (= "[10 30]" + (-> (z/of-string sample {:track-position? true}) + (pe/kill-one-at-pos {:row 1 :col 4}) ; at whitespace + z/root-string))) + (is (= "[10 30]" + (-> (z/of-string sample {:track-position? true}) + (pe/kill-one-at-pos {:row 1 :col 5}) + z/root-string))))) + +(deftest kill-one-at-pos-new-zloc-is-left-node + (let [sample "[[10] 20 30]"] + (is (= "[10]" + (-> (z/of-string sample {:track-position? true}) + (pe/kill-one-at-pos {:row 1 :col 6}) + z/string))) + (is (= "[10]" + (-> (z/of-string sample {:track-position? true}) + (pe/kill-one-at-pos {:row 1 :col 7}) + z/string))))) + +(deftest kill-one-at-pos-keep-linebreaks + (let [sample (z/of-string "[10\n 20\n 30]" {:track-position? true})] + (is (= "[20\n 30]" + (-> sample (pe/kill-one-at-pos {:row 1 :col 2}) z/root-string))) + (is (= "[10\n 30]" + (-> sample (pe/kill-one-at-pos {:row 2 :col 1}) z/root-string))) + (is (= "[10\n 20]" + (-> sample (pe/kill-one-at-pos {:row 3 :col 1}) z/root-string))))) + +(deftest kill-one-at-pos-in-comment + (let [sample (z/of-string "; hello world" {:track-position? true})] + (is (= "; hello " + (-> (pe/kill-one-at-pos sample {:row 1 :col 8}) z/root-string))) + (is (= "; hello " + (-> (pe/kill-one-at-pos sample {:row 1 :col 9}) z/root-string))) + (is (= "; hello " + (-> (pe/kill-one-at-pos sample {:row 1 :col 13}) z/root-string))) + (is (= "; world" + (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))))) + +(deftest kill-one-at-pos-in-string + (let [sample (z/of-string "\"hello world\"" {:track-position? true})] + (is (= "\"hello \"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 7}) z/root-string))) + (is (= "\"hello \"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 8}) z/root-string))) + (is (= "\"hello \"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 12}) z/root-string))) + (is (= "\" world\"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))))) + + +(deftest kill-one-at-pos-in-multiline-string + (let [sample (z/of-string "\"foo bar do\n lorem\"" {:track-position? true})] + (is (= "\" bar do\n lorem\"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 2}) z/root-string))) + (is (= "\"foo bar do\n \"" + (-> (pe/kill-one-at-pos sample {:row 2 :col 1}) z/root-string))) + (is (= "\"foo bar \n lorem\"" + (-> (pe/kill-one-at-pos sample {:row 1 :col 10}) z/root-string))))) + + + +(deftest slurp-forward-and-keep-loc-rightmost + (let [res (-> "[[1 2] 3 4]" + z/of-string + z/down z/down z/right + pe/slurp-forward)] + (is (= "[[1 2 3] 4]" (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + +(deftest slurp-forward-and-keep-loc-leftmost + (let [res (-> "[[1 2] 3 4]" + z/of-string + z/down z/down + pe/slurp-forward)] + (is (= "[[1 2 3] 4]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest slurp-forward-from-empty-sexpr + (let [res (-> "[[] 1 2 3]" + z/of-string + z/down + pe/slurp-forward)] + (is (= "[[1] 2 3]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest slurp-forward-from-whitespace-node + (let [res (-> "[[1 2] 3 4]" + z/of-string + z/down z/down z/right* + pe/slurp-forward)] + (is (= "[[1 2 3] 4]" (-> res z/root-string))) + (is (= " " (-> res z/string))))) + +(deftest slurp-forward-nested + (let [res (-> "[[[1 2]] 3 4]" + z/of-string + z/down z/down z/down + pe/slurp-forward)] + (is (= "[[[1 2] 3] 4]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest slurp-forward-nested-silly + (let [res (-> "[[[[[1 2]]]] 3 4]" + z/of-string + z/down z/down z/down z/down z/down + pe/slurp-forward)] + (is (= "[[[[[1 2]]] 3] 4]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest slurp-forward-when-last-is-sexpr + (let [res (-> "[1 [2 [3 4]] 5]" + z/of-string + z/down z/right z/down ;at 2 + pe/slurp-forward)] + (is (= "[1 [2 [3 4] 5]]" (-> res z/root-string)) + (= "2" (-> res z/string))))) + +(deftest slurp-forward-keep-linebreak + (let [sample " +(let [dill] + {:a 1} + {:b 2})" + expected "\n(let [dill \n{:a 1}]\n {:b 2})"] + (is (= expected (-> sample + z/of-string + z/down z/right z/down + pe/slurp-forward + z/root-string))))) + +(deftest slurp-forward-fully + (is (= "[1 [2 3 4]]" (-> (z/of-string "[1 [2] 3 4]") + z/down z/right z/down + pe/slurp-forward-fully + z/root-string)))) + + + +(deftest slurp-backward-and-keep-loc-leftmost + (let [res (-> "[1 2 [3 4]]" + z/of-string + z/down z/rightmost z/down + pe/slurp-backward)] + (is (= "[1 [2 3 4]]" (-> res z/root-string))) + (is (= "3" (-> res z/string))))) + +(deftest slurp-backward-and-keep-loc-rightmost + (let [res (-> "[1 2 [3 4]]" + z/of-string + z/down z/rightmost z/down z/rightmost + pe/slurp-backward)] + (is (= "[1 [2 3 4]]" (-> res z/root-string))) + (is (= "4" (-> res z/string))))) + +(deftest slurp-backward-from-empty-sexpr + (let [res (-> "[1 2 3 4 []]" + z/of-string + z/down z/rightmost + pe/slurp-backward)] + (is (= "[1 2 3 [4]]" (-> res z/root-string))) + (is (= "4" (-> res z/string))))) + +(deftest slurp-backward-nested + (let [res (-> "[1 2 [[3 4]]]" + z/of-string + z/down z/rightmost z/down z/down z/rightmost + pe/slurp-backward)] + (is (= "[1 [2 [3 4]]]" (-> res z/root-string))) + (is (= "4" (-> res z/string))))) + +(deftest slurp-backward-nested-silly + (let [res (-> "[1 2 [[[3 4]]]]" + z/of-string + z/down z/rightmost z/down z/down z/down z/rightmost + pe/slurp-backward)] + (is (= "[1 [2 [[3 4]]]]" (-> res z/root-string))) + (is (= "4" (-> res z/string))))) + +(deftest slurp-backward-keep-linebreaks-and-comments + (let [res (-> "[1 2 ;dill\n [3 4]]" + z/of-string + z/down z/rightmost z/down + pe/slurp-backward)] + (is (= "[1 [2 ;dill\n 3 4]]" (-> res z/root-string))))) + + +(deftest slurp-backward-fully + (is (= "[[1 2 3 4] 5]" (-> (z/of-string "[1 2 3 [4] 5]") + z/down z/rightmost z/left z/down + pe/slurp-backward-fully + z/root-string)))) + + +(deftest barf-forward-and-keep-loc + (let [res (-> "[[1 2 3] 4]" + z/of-string + z/down z/down z/right; position at 2 + pe/barf-forward)] + (is (= "[[1 2] 3 4]" (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + +(deftest barf-forward-at-leftmost + (let [res (-> "[[1 2 3] 4]" + z/of-string + z/down z/down + pe/barf-forward)] + (is (= "[[1 2] 3 4]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + + +(deftest barf-forward-at-rightmost-moves-out-of-sexrp + (let [res (-> "[[1 2 3] 4]" + z/of-string + z/down z/down z/rightmost; position at 3 + pe/barf-forward)] + + (is (= "[[1 2] 3 4]" (-> res z/root-string))) + (is (= "3" (-> res z/string))))) + +(deftest barf-forward-at-rightmost-which-is-a-whitespace-haha + (let [res (-> "[[1 2 3 ] 4]" + z/of-string + z/down z/down z/rightmost*; position at space at the end + pe/barf-forward)] + + (is (= "[[1 2] 3 4]" (-> res z/root-string))) + (is (= "3" (-> res z/string))))) + + +(deftest barf-forward-at-when-only-one + (let [res (-> "[[1] 2]" + z/of-string + z/down z/down + pe/barf-forward)] + + (is (= "[[] 1 2]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + + + + +(deftest barf-backward-and-keep-current-loc + (let [res (-> "[1 [2 3 4]]" + z/of-string + z/down z/rightmost z/down z/rightmost ; position at 4 + pe/barf-backward)] + (is (= "[1 2 [3 4]]" (-> res z/root-string))) + (is (= "4" (-> res z/string))))) + +(deftest barf-backward-at-leftmost-moves-out-of-sexpr + (let [res (-> "[1 [2 3 4]]" + z/of-string + z/down z/rightmost z/down ; position at 2 + pe/barf-backward)] + (is (= "[1 2 [3 4]]" (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + + +(deftest wrap-around + (is (= "(1)" (-> (z/of-string "1") (pe/wrap-around :list) z/root-string))) + (is (= "[1]" (-> (z/of-string "1") (pe/wrap-around :vector) z/root-string))) + (is (= "{1}" (-> (z/of-string "1") (pe/wrap-around :map) z/root-string))) + (is (= "#{1}" (-> (z/of-string "1") (pe/wrap-around :set) z/root-string)))) + +(deftest wrap-around-keeps-loc + (let [res (-> "1" + z/of-string + (pe/wrap-around :list))] + (is (= "1" (-> res z/string))))) + +(deftest wrap-around-keeps-newlines + (is (= "[[1]\n 2]" (-> (z/of-string "[1\n 2]") z/down (pe/wrap-around :vector) z/root-string)))) + + + +(deftest wrap-around-fn + (is (= "(-> (#(+ 1 1)))" (-> (z/of-string "(-> #(+ 1 1))") + z/down z/right + (pe/wrap-around :list) + z/root-string)))) + + +(deftest wrap-fully-forward-slurp + (is (= "[1 [2 3 4]]" + (-> (z/of-string "[1 2 3 4]") + z/down z/right + (pe/wrap-fully-forward-slurp :vector) + z/root-string)))) + +(deftest splice-killing-backward [] + (let [res (-> (z/of-string "(foo (let ((x 5)) (sqrt n)) bar)") + z/down z/right z/down z/right z/right + pe/splice-killing-backward)] + (is (= "(foo (sqrt n) bar)" (z/root-string res))) + (is (= "(sqrt n)" (z/string res))))) + + +(deftest splice-killing-forward [] + (let [res (-> (z/of-string "(a (b c d e) f)") + z/down z/right z/down z/right z/right + pe/splice-killing-forward)] + (is (= "(a b c f)" (z/root-string res))) + (is (= "c" (z/string res))))) + +(deftest splice-killing-forward-at-leftmost [] + (let [res (-> (z/of-string "(a (b c d e) f)") + z/down z/right z/down + pe/splice-killing-forward)] + (is (= "(a f)" (z/root-string res))) + (is (= "a" (z/string res))))) + + +(deftest split + (let [res (-> "[1 2]" + z/of-string + z/down + pe/split)] + (is (= "[1] [2]" (-> res z/root-string))) + (is (= "1" (-> res z/string))))) + +(deftest split-includes-node-at-loc-as-left + (let [res (-> "[1 2 3 4]" + z/of-string + z/down z/right + pe/split)] + (is (= "[1 2] [3 4]" (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + + +(deftest split-at-whitespace + (let [res (-> "[1 2 3 4]" + z/of-string + z/down z/right z/right* + pe/split)] + (is (= "[1 2] [3 4]" (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + + + + +(deftest split-includes-comments-and-newlines + (let [sexpr " +[1 ;dill + 2 ;dall + 3 ;jalla +]" + expected " +[1 ;dill + 2 ;dall +] [3 ;jalla +]" + res (-> sexpr + z/of-string + z/down z/right + pe/split)] + (is (= expected (-> res z/root-string))) + (is (= "2" (-> res z/string))))) + +(deftest split-when-only-one-returns-self + (is (= "[1]" (-> (z/of-string "[1]") + z/down + pe/split + z/root-string))) + (is (= "[1 ;dill\n]" (-> (z/of-string "[1 ;dill\n]") + z/down + pe/split + z/root-string)))) + + +(deftest split-at-pos-when-string + (is (= "(\"Hello \" \"World\")" + (-> (z/of-string "(\"Hello World\")" {:track-position? true}) + (pe/split-at-pos {:row 1 :col 9}) + z/root-string)))) + + +(deftest join-simple + (let [res (-> "[1 2] [3 4]" + z/of-string + ;z/down + z/right* + pe/join)] + (is (= "[1 2 3 4]" (-> res z/root-string))) + (is (= "3" (-> res z/string))))) + +(deftest join-with-comments + (let [sexpr " +[[1 2] ; the first stuff + [3 4] ; the second stuff +]" expected " +[[1 2 ; the first stuff + 3 4]; the second stuff +]" + res (-> sexpr + z/of-string + z/down z/right* + pe/join)] + (is (= expected (-> res z/root-string))))) + + +(deftest join-strings + (is (= "(\"Hello World\")" (-> (z/of-string "(\"Hello \" \"World\")") + z/down z/rightmost + pe/join + z/root-string)))) + + +(deftest raise + (is (= "[1 3]" + (-> (z/of-string "[1 [2 3 4]]") + z/down z/right z/down z/right + pe/raise + z/root-string)))) + + +(deftest move-to-prev-flat + (is (= "(+ 2 1)" (-> "(+ 1 2)" + z/of-string + z/down + z/rightmost + pe/move-to-prev + z/root-string)))) + +(deftest move-to-prev-when-prev-is-seq + (is (= "(+ 1 (+ 2 3 4))" (-> "(+ 1 (+ 2 3) 4)" + z/of-string + z/down + z/rightmost + pe/move-to-prev + z/root-string)))) + +(deftest move-to-prev-out-of-seq + (is (= "(+ 1 4 (+ 2 3))" (-> "(+ 1 (+ 2 3) 4)" + z/of-string + z/down + z/rightmost + (move-n pe/move-to-prev 6) + z/root-string)))) diff --git a/test-resources/lib_tests/rewrite_clj/parser_test.cljc b/test-resources/lib_tests/rewrite_clj/parser_test.cljc new file mode 100644 index 00000000..fa448216 --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/parser_test.cljc @@ -0,0 +1,578 @@ +(ns ^{:doc "Tests for EDN parser." + :author "Yannick Scherer"} + rewrite-clj.parser-test + (:refer-clojure :exclude [read-string]) + (:require [clojure.edn :as edn] + [clojure.test :refer [deftest is are]] + ;; not available in bb (yet): + #_[clojure.tools.reader.edn :refer [read-string]] + [rewrite-clj.node :as node] + [rewrite-clj.parser :as p]) + #?(:clj (:import [clojure.lang ExceptionInfo] + [java.io File]))) + +(deftest t-parsing-the-first-few-whitespaces + (are [?ws ?parsed] + (let [n (p/parse-string ?ws)] + (is (= :whitespace (node/tag n))) + (is (= ?parsed (node/string n)))) + " " " " + " \n " " ")) + +(deftest t-parsing-whitespace-strings + (are [?ws ?children] + (let [n (p/parse-string-all ?ws)] + (is (= :forms (node/tag n))) + (is (= (.replace ?ws "\r\n" "\n") (node/string n))) + (is (= ?children (map (juxt node/tag node/string) (node/children n))))) + " \n " [[:whitespace " "] + [:newline "\n"] + [:whitespace " "]] + " \t \r\n \t " [[:whitespace " \t "] + [:newline "\n"] + [:whitespace " \t "]])) + +#?(:clj + (deftest t-parsing-unicode-whitespace-strings + (are [?ws ?children] + (let [n (p/parse-string-all ?ws)] + (is (= :forms (node/tag n))) + (is (= (.replace ?ws "\r\n" "\n") (node/string n))) + (is (= ?children (map (juxt node/tag node/string) (node/children n))))) + "\u2028" [[:whitespace "\u2028"]]))) + +(deftest t-parsing-simple-data + (are [?s ?r] + (let [n (p/parse-string ?s)] + (is (= :token (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?r (node/sexpr n)))) + "0" 0 + "0.1" 0.1 + "12e10" 1.2e11 + "2r1100" 12 + "1N" 1N + ":key" :key + "\\\\" \\ + "\\a" \a + "\\space" \space + "\\'" \' + ":1.5" :1.5 + ":1.5.0" :1.5.0 + ":ns/key" :ns/key + ":key:key" :key:key + ":x'" :x' + "sym" 'sym + "sym#" 'sym# + "sym'" 'sym' + "sym'sym" 'sym'sym + "sym:sym" 'sym:sym + "\"string\"" "string")) + +(deftest t-parsing-garden-selectors + ;; https://github.com/noprompt/garden + (are [?s ?r] + (let [n (p/parse-string ?s) + r (node/sexpr n)] + (is (= ?s (node/string n))) + (is (= :token (node/tag n))) + (is (keyword? r)) + (is (= ?r r))) + ":&:hover" :&:hover + ;; clj clojure reader can't parse :&::before but we can create a keyword for it + ":&::before" (keyword "&::before"))) + +(deftest t-ratios + (are [?s ?r] + (let [n (p/parse-string ?s)] + (is (= :token (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?r (node/sexpr n)))) + "3/4" #?(:clj 3/4 + ;; no ratios in cljs; they are evaluated on sexpr + :cljs 0.75))) + +(deftest t-big-integers + (are [?s ?r] + (let [n (p/parse-string ?s)] + (is (= :token (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?r (node/sexpr n)))) + "1234567890123456789012345678901234567890" 1234567890123456789012345678901234567890N)) + +(deftest t-parsing-symbolic-inf-values + (are [?s ?r] + (let [n (p/parse-string ?s)] + (is (= :token (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?r (node/sexpr n)))) + "##Inf" '##Inf + "##-Inf" '##-Inf)) + +(deftest t-parsing-symbolic-NaN-value + (let [n (p/parse-string "##NaN") + e (node/sexpr n)] + (is (= :token (node/tag n))) + (is (= "##NaN" (node/string n))) + #?(:cljs (is (js/Number.isNaN e)) + :default (is (Double/isNaN e))))) + +(deftest t-parsing-reader-prefixed-data + (are [?s ?t ?ws ?sexpr] + (let [n (p/parse-string ?s) + children (node/children n) + c (map node/tag children)] + (is (= ?t (node/tag n))) + (is (= :token (last c))) + (is (= ?sexpr (node/sexpr n))) + (is (= 'sym (node/sexpr (last children)))) + (is (= ?ws (vec (butlast c))))) + "@sym" :deref [] '(deref sym) + "@ sym" :deref [:whitespace] '(deref sym) + "'sym" :quote [] '(quote sym) + "' sym" :quote [:whitespace] '(quote sym) + "`sym" :syntax-quote [] '(quote sym) + "` sym" :syntax-quote [:whitespace] '(quote sym) + "~sym" :unquote [] '(unquote sym) + "~ sym" :unquote [:whitespace] '(unquote sym) + "~@sym" :unquote-splicing [] '(unquote-splicing sym) + "~@ sym" :unquote-splicing [:whitespace] '(unquote-splicing sym) + "#=sym" :eval [] '(eval 'sym) + "#= sym" :eval [:whitespace] '(eval 'sym) + "#'sym" :var [] '(var sym) + "#'\nsym" :var [:newline] '(var sym))) + +(deftest t-eval + (let [n (p/parse-string "#=(+ 1 2)")] + (is (= :eval (node/tag n))) + (is (= "#=(+ 1 2)" (node/string n))) + (is (= '(eval '(+ 1 2)) (node/sexpr n))))) + +(deftest t-uneval + (let [s "#' #_ (+ 1 2) sym" + n (p/parse-string s) + [ws0 uneval ws1 sym] (node/children n)] + (is (= :var (node/tag n))) + (is (= s (node/string n))) + (is (= :whitespace (node/tag ws0))) + (is (= :whitespace (node/tag ws1))) + (is (= :token (node/tag sym))) + (is (= 'sym (node/sexpr sym))) + (is (= :uneval (node/tag uneval))) + (is (= "#_ (+ 1 2)" (node/string uneval))) + (is (node/printable-only? uneval)) + (is (thrown-with-msg? ExceptionInfo #"unsupported operation" (node/sexpr uneval))))) + +(deftest t-parsing-regular-expressions + (are [?s ?expected-sexpr] + (let [n (p/parse-string ?s)] + (is (= :regex (node/tag n))) + (is (= (count ?s) (node/length n))) + (is (= ?expected-sexpr (node/sexpr n)))) + "#\"regex\"" '(re-pattern "regex") + "#\"regex\\.\"" '(re-pattern "regex\\.") + "#\"[reg|k].x\"" '(re-pattern "[reg|k].x") + "#\"a\\nb\"" '(re-pattern "a\\nb") + "#\"a\nb\"" '(re-pattern "a\nb") + + "#\"[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\"" + '(re-pattern "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"))) + +(deftest t-parsing-strings + (are [?s ?tag ?sexpr] + (let [n (p/parse-string ?s)] + (is (= ?tag (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?sexpr (node/sexpr n)))) + "\"123\"" :token "123" + "\"123\\n456\"" :token "123\n456" + "\"123\n456\"" :multi-line "123\n456")) + +(deftest t-parsing-seqs + (are [?s ?t ?w ?c] + (let [n (p/parse-string ?s) + children (node/children n) + fq (frequencies (map node/tag children))] + (is (= ?t (node/tag n))) + (is (= (.trim ?s) (node/string n))) + (is (= (node/sexpr n) (edn/read-string ?s))) + (is (= ?w (:whitespace fq 0))) + (is (= ?c (:token fq 0)))) + "(1 2 3)" :list 2 3 + "()" :list 0 0 + "( )" :list 1 0 + "() " :list 0 0 + "[1 2 3]" :vector 2 3 + "[]" :vector 0 0 + "[ ]" :vector 1 0 + "[] " :vector 0 0 + "#{1 2 3}" :set 2 3 + "#{}" :set 0 0 + "#{ }" :set 1 0 + "#{} " :set 0 0 + "{:a 0 :b 1}" :map 3 4 + "{}" :map 0 0 + "{ }" :map 1 0 + "{} " :map 0 0)) + +(deftest t-parsing-invalid-maps + ;; I don't know if this ability is intentional, but libraries + ;; have come to rely on the behavior of parsing invalid maps. + ;; Note: sexpr won't be possible on invalid Clojure + (are [?s ?t] + (let [n (p/parse-string ?s)] + (is (= ?t (node/tag n))) + (is (= ?s (node/string n)))) + "{:a}" :map + "{:r 1 :u}" :map)) + +(deftest t-parsing-metadata + (are [?s ?t ?mt] + (let [s (str ?s " s") + n (p/parse-string s) + [mta ws sym] (node/children n)] + (is (= ?t (node/tag n))) + (is (= s (node/string n))) + (is (= 's (node/sexpr n))) + (is (= {:private true} (meta (node/sexpr n)))) + (is (= ?mt (node/tag mta))) + (is (= :whitespace (node/tag ws))) + (is (= :token (node/tag sym))) + (is (= 's (node/sexpr sym)))) + "^:private" :meta :token + "^{:private true}" :meta :map + "#^:private" :meta* :token + "#^{:private true}" :meta* :map)) + +(deftest t-parsing-multiple-metadata-forms + (are [?s ?expected-meta-tag ?expected-tag-on-metadata] + (let [s (str ?s " s") + n (p/parse-string s) + [mdata ws inner-n] (node/children n) + [inner-mdata inner-ws sym] (node/children inner-n)] + ;; outer meta + (is (= ?expected-meta-tag (node/tag n))) + (is (= {:private true :awe true} (meta (node/sexpr n)))) + (is (= ?expected-tag-on-metadata (node/tag mdata))) + (is (= :whitespace (node/tag ws))) + + ;; inner meta + (is (= ?expected-meta-tag (node/tag inner-n))) + (is (= {:awe true} (meta (node/sexpr inner-n)))) + (is (= ?expected-tag-on-metadata (node/tag inner-mdata))) + (is (= :whitespace (node/tag inner-ws))) + + ;; symbol + (is (= s (node/string n))) + (is (= 's (node/sexpr sym)))) + "^:private ^:awe" :meta :token + "^{:private true} ^{:awe true}" :meta :map + "#^:private #^:awe" :meta* :token + "#^{:private true} #^{:awe true}" :meta* :map)) + +(deftest t-parsing-reader-macros + (are [?s ?t ?children] + (let [n (p/parse-string ?s)] + (is (= ?t (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?children (map node/tag (node/children n))))) + "#'a" :var [:token] + "#=(+ 1 2)" :eval [:list] + "#macro 1" :reader-macro [:token :whitespace :token] + "#macro (* 2 3)" :reader-macro [:token :whitespace :list] + "#?(:clj bar)" :reader-macro [:token :list] + "#? (:clj bar)" :reader-macro [:token :whitespace :list] + "#?@ (:clj bar)" :reader-macro [:token :whitespace :list] + "#?foo baz" :reader-macro [:token :whitespace :token] + "#_abc" :uneval [:token] + "#_(+ 1 2)" :uneval [:list])) + +(deftest t-parsing-anonymous-fn + (are [?s ?t ?sexpr-match ?children] + (let [n (p/parse-string ?s)] + (is (= ?t (node/tag n))) + (is (= ?s (node/string n))) + (is (re-matches ?sexpr-match (str (node/sexpr n)))) + (is (= ?children (map node/tag (node/children n))))) + "#(+ % 1)" + :fn #"\(fn\* \[p1_.*#\] \(\+ p1_.*# 1\)\)" + [:token :whitespace + :token :whitespace + :token] + + "#(+ %& %2 %1)" + :fn #"\(fn\* \[p1_.*# p2_.*# & rest_.*#\] \(\+ rest_.*# p2_.*# p1_.*#\)\)" + [:token :whitespace + :token :whitespace + :token :whitespace + :token])) + +(deftest t-parsing-comments + (are [?s] + (let [n (p/parse-string ?s)] + (is (node/printable-only? n)) + (is (= :comment (node/tag n))) + (is (= ?s (node/string n)))) + "; this is a comment\n" + ";; this is a comment\n" + "; this is a comment" + ";; this is a comment" + ";" + ";;" + ";\n" + ";;\n" + "#!shebang comment\n" + "#! this is a comment" + "#!\n")) + +(deftest t-parsing-auto-resolve-keywords + (are [?s ?sexpr-default ?sexpr-custom] + (let [n (p/parse-string ?s)] + (is (= :token (node/tag n))) + (is (= ?s (node/string n))) + (is (= ?sexpr-default (node/sexpr n))) + (is (= ?sexpr-custom (node/sexpr n {:auto-resolve #(if (= :current %) + 'my.current.ns + (get {'xyz 'my.aliased.ns} % 'alias-unresolved))})))) + "::key" :?_current-ns_?/key :my.current.ns/key + "::xyz/key" :??_xyz_??/key :my.aliased.ns/key)) + +(deftest t-parsing-qualified-maps + (are [?s ?sexpr] + (let [n (p/parse-string ?s)] + (is (= :namespaced-map (node/tag n))) + (is (= (count ?s) (node/length n))) + (is (= ?s (node/string n))) + (is (= ?sexpr (node/sexpr n)))) + "#:abc{:x 1, :y 1}" + {:abc/x 1, :abc/y 1} + + "#:abc {:x 1, :y 1}" + {:abc/x 1, :abc/y 1} + + "#:abc ,,, \n\n {:x 1 :y 2}" + {:abc/x 1, :abc/y 2} + + "#:foo{:kw 1, :n/kw 2, :_/bare 3, 0 4}" + {:foo/kw 1, :n/kw 2, :bare 3, 0 4} + + "#:abc{:a {:b 1}}" + {:abc/a {:b 1}} + + "#:abc{:a #:def{:b 1}}" + {:abc/a {:def/b 1}})) + +(deftest t-parsing-auto-resolve-current-ns-maps + (are [?s ?sexpr-default ?sexpr-custom] + (let [n (p/parse-string ?s)] + (is (= :namespaced-map (node/tag n))) + (is (= (count ?s) (node/length n))) + (is (= ?s (node/string n))) + (is (= ?sexpr-default (node/sexpr n))) + (is (= ?sexpr-custom (node/sexpr n {:auto-resolve #(if (= :current %) + 'booya.fooya + 'alias-unresolved)})))) + "#::{:x 1, :y 1}" + {:?_current-ns_?/x 1, :?_current-ns_?/y 1} + {:booya.fooya/x 1, :booya.fooya/y 1} + + "#:: {:x 1, :y 1}" + {:?_current-ns_?/x 1, :?_current-ns_?/y 1} + {:booya.fooya/x 1, :booya.fooya/y 1} + + "#:: \n,,\n,, {:x 1, :y 1}" + {:?_current-ns_?/x 1, :?_current-ns_?/y 1} + {:booya.fooya/x 1, :booya.fooya/y 1} + + "#::{:kw 1, :n/kw 2, :_/bare 3, 0 4}" + {:?_current-ns_?/kw 1, :n/kw 2, :bare 3, 0 4} + {:booya.fooya/kw 1, :n/kw 2, :bare 3, 0 4} + + "#::{:a {:b 1}}" + {:?_current-ns_?/a {:b 1}} + {:booya.fooya/a {:b 1}} + + "#::{:a #::{:b 1}}" + {:?_current-ns_?/a {:?_current-ns_?/b 1}} + {:booya.fooya/a {:booya.fooya/b 1}})) + +(deftest parsing-auto-resolve-ns-alias-maps + (are [?s ?sexpr-default ?sexpr-custom] + (let [n (p/parse-string ?s)] + (is (= :namespaced-map (node/tag n))) + (is (= (count ?s) (node/length n))) + (is (= ?s (node/string n))) + (is (= ?sexpr-default (node/sexpr n))) + (is (= ?sexpr-custom (node/sexpr n {:auto-resolve #(if (= :current %) + 'my.current.ns + (get {'nsalias 'bing.bang + 'nsalias2 'woopa.doopa} % 'alias-unresolved))})))) + "#::nsalias{:x 1, :y 1}" + '{:??_nsalias_??/x 1, :??_nsalias_??/y 1} + '{:bing.bang/x 1, :bing.bang/y 1} + + "#::nsalias {:x 1, :y 1}" + '{:??_nsalias_??/x 1, :??_nsalias_??/y 1} + '{:bing.bang/x 1, :bing.bang/y 1} + + "#::nsalias ,,,,,,,,,,\n,,,,,,\n,,,,, {:x 1, :y 1}" + '{:??_nsalias_??/x 1, :??_nsalias_??/y 1} + '{:bing.bang/x 1, :bing.bang/y 1} + + "#::nsalias{:kw 1, :n/kw 2, :_/bare 3, 0 4}" + '{:??_nsalias_??/kw 1, :n/kw 2, :bare 3, 0 4} + '{:bing.bang/kw 1, :n/kw 2, :bare 3, 0 4} + + "#::nsalias{:a {:b 1}}" + '{:??_nsalias_??/a {:b 1}} + '{:bing.bang/a {:b 1}} + + "#::nsalias{:a #::nsalias2{:b 1}}" + '{:??_nsalias_??/a {:??_nsalias2_??/b 1}} + '{:bing.bang/a {:woopa.doopa/b 1}})) + +(deftest t-parsing-exceptions + (are [?s ?p] + (is (thrown-with-msg? ExceptionInfo ?p (p/parse-string ?s))) + "#" #".*Unexpected EOF.*" + "#(" #".*Unexpected EOF.*" + "(def" #".*Unexpected EOF.*" + "[def" #".*Unexpected EOF.*" + "#{def" #".*Unexpected EOF.*" + "{:a 0" #".*Unexpected EOF.*" + "\"abc" #".*EOF.*" + "#\"abc" #".*Unexpected EOF.*" + "(def x 0]" #".*Unmatched delimiter.*" + "##wtf" #".*Invalid token: ##wtf" + "#=" #".*:eval node expects 1 value.*" + "#^" #".*:meta node expects 2 values.*" + "^:private" #".*:meta node expects 2 values.*" + "#^:private" #".*:meta node expects 2 values.*" + "#_" #".*:uneval node expects 1 value.*" + "#'" #".*:var node expects 1 value.*" + "#macro" #".*:reader-macro node expects 2 values.*" + "#:" #".*namespaced map expects a namespace*" + "#::" #".*namespaced map expects a map*" + "#::nsarg" #".*namespaced map expects a map*" + "#:{:a 1}" #".*namespaced map expects a namespace*" + "#::[a]" #".*namespaced map expects a map*" + "#:[a]" #".*namespaced map expects a namespace*" + "#:: token" #".*namespaced map expects a map*" + "#::alias [a]" #".*namespaced map expects a map*" + "#:prefix [a]" #".*namespaced map expects a map.*")) + +(deftest t-sexpr-exceptions + (are [?s] + (is (thrown-with-msg? ExceptionInfo #"unsupported operation.*" (node/sexpr (p/parse-string ?s)))) + "#_42" ;; reader ignore/discard + ";; can't sexpr me!" ;; comment + " " ;; whitespace + )) + +(deftest t-parsing-multiple-forms + (let [s "1 2 3" + n (p/parse-string-all s) + children (node/children n)] + (is (= :forms (node/tag n))) + (is (= s (node/string n))) + (is (= '(do 1 2 3) (node/sexpr n))) + (is (= [:token :whitespace + :token :whitespace + :token] + (map node/tag children)))) + (let [s ";; Hi!\n(def pi 3.14)" + n (p/parse-string-all s) + children (node/children n)] + (is (= :forms (node/tag n))) + (is (= s (node/string n))) + (is (= '(def pi 3.14) (node/sexpr n))) + (is (= [:comment :list] (map node/tag children))) + (node/string (first children)))) + +#?(:clj + (deftest t-parsing-files + (let [f (doto (java.io.File/createTempFile "rewrite.test" "") + (.deleteOnExit)) + s "âbcdé" + c ";; Hi" + o (str c "\n\n" (pr-str s))] + (spit f o) + (is (= o (slurp f))) + (let [n (p/parse-file-all f) + children (node/children n)] + (is (= :forms (node/tag n))) + (is (= o (node/string n))) + (is (= s (node/sexpr n))) + (is (= [:comment :newline :token] (map node/tag children))) + (is (= [";; Hi\n" "\n" (pr-str s)] (map node/string children))))))) + +(defn- nodes-with-meta + "Create map associating row/column number pairs with the node at that position." + [n] + (let [start-pos ((juxt :row :col) (meta n)) + end-pos ((juxt :end-row :end-col) (meta n)) + entry {start-pos {:node n, :end-pos end-pos}}] + (if (node/inner? n) + (->> (node/children n) + (map nodes-with-meta) + (into entry)) + entry))) + +(deftest t-rowcolumn-metadata-from-clojure-tools-reader + ;; if you update this test, please also review/update: + ;; rewrite-clj.zip-test.t-rowcolumn-positions-from-position-tracking-zipper + (let [s (str + ;12345678901234 + "(defn f\n" + " [x]\n" + " (println x))") + positions (->> (p/parse-string-all s) + (nodes-with-meta))] + (are [?pos ?end ?t ?s ?sexpr] + (let [{:keys [node end-pos]} (positions ?pos)] + (is (= ?t (node/tag node))) + (is (= ?s (node/string node))) + (is (= ?sexpr (node/sexpr node))) + (is (= ?end end-pos))) + [1 1] [3 15] :list s '(defn f [x] (println x)) + [1 2] [1 6] :token "defn" 'defn + [1 7] [1 8] :token "f" 'f + [2 3] [2 6] :vector "[x]" '[x] + [2 4] [2 5] :token "x" 'x + [3 3] [3 14] :list "(println x)" '(println x) + [3 4] [3 11] :token "println" 'println + [3 12] [3 13] :token "x" 'x))) + + +(deftest t-os-specific-line-endings + (are [?in ?expected] + (let [str-actual (-> ?in p/parse-string-all node/string)] + (is (= ?expected str-actual) "from string") + #?(:clj + (is (= ?expected (let [t-file (File/createTempFile "rewrite-clj-parse-test" ".clj")] + (.deleteOnExit t-file) + (spit t-file ?in) + (-> t-file p/parse-file-all node/string))) "from file"))) + "heya\r\nplaya\r\n" + "heya\nplaya\n" + + ";; comment\r\n(+ 1 2 3)\r\n" + ";; comment\n(+ 1 2 3)\n" + + "1\r2\r\n3\r\f4" + "1\n2\n3\n4" + + "\n\n\n\n" + "\n\n\n\n" + + "\r\r\r\r\r" + "\n\n\n\n\n" + + "\r\n\r\n\r\n\r\n\r\n\r\n" + "\n\n\n\n\n\n" + + ;1 2 3 4 5 6 7 + "\r\n\r\r\f\r\n\r\r\n\r" + "\n\n\n\n\n\n\n")) + + diff --git a/test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc b/test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc new file mode 100644 index 00000000..cf73f613 --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc @@ -0,0 +1,51 @@ +(ns rewrite-clj.zip.subedit-test + (:require [clojure.test :refer [deftest testing is]] + [rewrite-clj.zip :as z] + ;; not available in bb: + #_[rewrite-clj.zip.base :as zbase])) + +(deftest t-trees + (let [root (z/of-string "[1 #{2 [3 4] 5} 6]")] + (testing "modifying subtrees" + (let [loc (z/subedit-> root + z/next + z/next + z/next + (z/replace* 'x))] + (is (= :vector (z/tag loc))) + (is (= "[1 #{x [3 4] 5} 6]" (z/string loc))))) + (testing "modifying the whole tree" + (let [loc (z/edit-> (-> root z/next z/next z/next) + z/prev z/prev + (z/replace* 'x))] + (is (= :token (z/tag loc))) + (is (= "2" (z/string loc))) + (is (= "[x #{2 [3 4] 5} 6]" (z/root-string loc))))))) + +(deftest zipper-retains-options + (let [zloc (z/of-string "(1 (2 (3 4 ::my-kw)))" {:auto-resolve (fn [_x] 'custom-resolved)}) + #_#_orig-opts (zbase/get-opts zloc)] + (testing "sanity - without subzip" + (is (= :custom-resolved/my-kw (-> zloc + z/down z/right + z/down z/right + z/down z/rightmost z/sexpr)))) + (testing "subzip" + (let [sub-zloc (-> zloc z/up* z/subzip z/down*)] + ;; (is (= orig-opts (zbase/get-opts sub-zloc))) + (is (= :custom-resolved/my-kw (-> sub-zloc + z/down z/right + z/down z/right + z/down z/rightmost z/sexpr))))) + (testing "edit-node" + (let [edited-zloc (-> zloc (z/edit-node + (fn [zloc-edit] + (-> zloc-edit + z/down z/right + z/down (z/replace* 'x)))))] + (is (= 'x (-> edited-zloc z/down z/right z/down z/sexpr))) + ;; (is (= orig-opts (zbase/get-opts edited-zloc))) + (is (= :custom-resolved/my-kw (-> edited-zloc + z/down z/right + z/down z/right + z/down z/rightmost z/sexpr))))))) diff --git a/test-resources/lib_tests/rewrite_clj/zip_test.cljc b/test-resources/lib_tests/rewrite_clj/zip_test.cljc new file mode 100644 index 00000000..975e96dd --- /dev/null +++ b/test-resources/lib_tests/rewrite_clj/zip_test.cljc @@ -0,0 +1,172 @@ +(ns rewrite-clj.zip-test + "This test namespace originated from rewrite-cljs." + (:require [clojure.string :as string] + [clojure.test :refer [deftest testing is are]] + [rewrite-clj.node :as n] + [rewrite-clj.zip :as z])) + +(deftest of-string-simple-sexpr + (let [sexpr "(+ 1 2)"] + (is (= sexpr (-> sexpr z/of-string z/root-string))))) + +(deftest manipulate-sexpr + (let [sexpr + (string/join + "\n" ["" + " ^{:dynamic true} (+ 1 1" + " (+ 2 2)" + " (reduce + [1 3 4]))"]) + expected + (string/join + "\n" ["" + " ^{:dynamic true} (+ 1 1" + " (+ 2 2)" + " (reduce + [6 7 [1 2]]))"])] + (is (= expected (-> (z/of-string sexpr {:track-position? true}) + (z/find-tag-by-pos {:row 4 :col 19} :vector) ;; should find [1 3 4] col 19 points to element 4 in vector + (z/replace [5 6 7]) ;; replaces [1 3 4] with [5 6 7] + (z/append-child [1 2]) ;; appends [1 2] to [5 6 7] giving [5 6 [1 2]] + z/down ;; navigate to 5 + z/remove ;; remove 5 giving [6 7 [1 2]] + z/root-string))))) + +(deftest t-rowcolumn-positions-from-position-tracking-zipper + ;; if you update this test, please also review/update: + ;; rewrite-clj.parser-test.t-rowcolumn-metadata-from-clojure-tools-reader + (let [s (str + ;12345678901234 + "(defn f\n" + " [x]\n" + " (println x))") + positions (->> (z/of-string s {:track-position? true}) + (iterate z/next) + (take-while #(not (z/end? %))) + (reduce (fn [acc zloc] + (let [[start end] (z/position-span zloc)] + (assoc acc start {:node (z/node zloc) :end-pos end}))) + {}))] + (are [?pos ?end ?t ?s ?sexpr] + (let [{:keys [node end-pos]} (positions ?pos)] + (is (= ?t (n/tag node))) + (is (= ?s (n/string node))) + (is (= ?sexpr (n/sexpr node))) + (is (= ?end end-pos))) + [1 1] [3 15] :list s '(defn f [x] (println x)) + [1 2] [1 6] :token "defn" 'defn + [1 7] [1 8] :token "f" 'f + [2 3] [2 6] :vector "[x]" '[x] + [2 4] [2 5] :token "x" 'x + [3 3] [3 14] :list "(println x)" '(println x) + [3 4] [3 11] :token "println" 'println + [3 12] [3 13] :token "x" 'x))) + +(deftest namespaced-keywords + (is (= ":dill" (-> ":dill" z/of-string z/root-string))) + (is (= "::dill" (-> "::dill" z/of-string z/root-string))) + (is (= ":dill/dall" (-> ":dill/dall" z/of-string z/root-string))) + (is (= "::dill/dall" (-> "::dill/dall" z/of-string z/root-string))) + (is (= ":%dill.*" (-> ":%dill.*" z/of-string z/root-string)))) + + +(deftest sexpr-udpates-correctly-for-namespaced-map-keys + (testing "on parse" + (is (= '(:prefix/a 1 :prefix/b 2 prefix/c 3) + (-> "#:prefix {:a 1 :b 2 c 3}" + z/of-string + z/down + z/rightmost + z/child-sexprs)))) + (testing "on insert new key val" + (is (= '(:prefix/a 1 :prefix/b 2 prefix/c 3 prefix/d 4) + (-> "#:prefix {:a 1 :b 2 c 3}" + z/of-string + z/down + z/rightmost + (z/append-child 'd) + (z/append-child 4) + z/up ;; changes and also nsmap context are applied when moving up to nsmap + z/down + z/rightmost + z/child-sexprs)))) + (testing "on update existing key val" + (is (= '(:prefix/a 1 :prefix/b2 2 prefix/c 3) + (-> "#:prefix {:a 1 :b 2 c 3}" + z/of-string + z/down + z/rightmost + z/down + z/right + z/right + (z/replace :b2) + z/up ;; changes and also nsmap context are applied when moving up to nsmap + z/up + z/down + z/rightmost + z/child-sexprs)))) + (testing "on update creating unbalanced map (which rewrite-clj allows) context is cleared/applied as appropriate" + (is (= '(:prefix/hi :a prefix/b :c prefix/d e prefix/f) + (-> "#:prefix {:a b :c d e f}" + z/of-string + z/down + z/rightmost + (z/insert-child :hi) + z/up ;; changes and also nsmap context are applied when moving up to nsmap + z/down + z/rightmost + z/child-sexprs)))) + (testing "namespaced map qualifier can be changed and affect sexpr of its map keys" + (is (= '(:??_ns-alias_??/a 1 :??_ns-alias_??/b 2 :c 3) + (-> "#:prefix {:a 1 :b 2 :_/c 3}" + z/of-string + z/down + (z/replace (n/map-qualifier-node true "ns-alias")) + z/up + z/down + z/rightmost + z/child-sexprs)))) + (testing "node context can be be explicitly removed when moving node out of namespaced map" + (is (= '[{:prefix/b 2 :prefix/c 3} + {:a 1 :z 99}] + (let [zloc (-> "[#:prefix {:a 1 :b 2 :c 3}{:z 99}]" + z/of-string + z/down + z/down + z/rightmost + z/down) + move-me1 (-> zloc z/node n/map-context-clear) ;; if we don't clear the map context it will remain + zloc (-> zloc z/remove z/down) + move-me2 (-> zloc z/node) + zloc (z/remove zloc)] + (-> zloc + z/up + z/right + (z/insert-child move-me2) + (z/insert-child move-me1) + z/up + z/sexpr))))) + (testing "node context can be explicitly reapplied to entire zloc downward" + (is (= '[{:prefix/b 2 :prefix/c 3} + {:a 1 :z 99}] + (let [zloc (-> "[#:prefix {:a 1 :b 2 :c 3}{:z 99}]" + z/of-string + z/down + z/down + z/rightmost + z/down) + move-me1 (-> zloc z/node) ;; notice we don't clear context here + zloc (-> zloc z/remove z/down) + move-me2 (-> zloc z/node) + zloc (z/remove zloc)] + (-> zloc + z/up + z/right + (z/insert-child move-me2) + (z/insert-child move-me1) + z/up + z/reapply-context ;; but we do reapply context to tree before doing a sexpr + z/sexpr)))))) + +(deftest t-sexpr-able + ;; spot check, more thorough testing done on node tests + (is (= false (-> "," z/of-string z/next* z/sexpr-able?))) + (is (= true (-> "heyy" z/of-string z/sexpr-able?)))) diff --git a/test/babashka/test_test.clj b/test/babashka/test_test.clj index df97ff21..e3b9a736 100644 --- a/test/babashka/test_test.clj +++ b/test/babashka/test_test.clj @@ -83,3 +83,12 @@ (is (= (:message m2) "1 is not equal to 2")) (is (= (:line m2) 6)) (is (= m3 '{:type :end-test-var, :var bar})))) + +(deftest are-with-is-test + (let [output (bb " +(do (require '[clojure.test :as t]) +(t/deftest foo (t/are [x] +(t/is (thrown-with-msg? Exception #\"\" x)) +(throw (ex-info \"\" {}))))) +(t/run-tests *ns*)")] + (is (str/includes? output "Ran 1 tests containing 2 assertions."))))