[#769] rewrite-clj support
This commit is contained in:
Michiel Borkent
GitHub
parent
2aa8c88822
commit
1870e2729e
19 changed files with 1938 additions and 15 deletions
4
deps.edn
4
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
|
||||
|
|
|
|||
67
feature-rewrite-clj/babashka/impl/rewrite_clj.clj
Normal file
67
feature-rewrite-clj/babashka/impl/rewrite_clj.clj
Normal file
|
|
@ -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))
|
||||
|
|
@ -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}}
|
||||
|
|
|
|||
2
sci
2
sci
|
|
@ -1 +1 @@
|
|||
Subproject commit 106919aad41062055828df832acb863080e4b5bd
|
||||
Subproject commit 386ff4c3d4f8d0aba11947beccb8320d75c5fcf8
|
||||
|
|
@ -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[@]}"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
192
test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc
Normal file
192
test-resources/lib_tests/rewrite_clj/node/coercer_test.cljc
Normal file
|
|
@ -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))))))
|
||||
212
test-resources/lib_tests/rewrite_clj/node_test.cljc
Normal file
212
test-resources/lib_tests/rewrite_clj/node_test.cljc
Normal file
|
|
@ -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}"))))))
|
||||
556
test-resources/lib_tests/rewrite_clj/paredit_test.cljc
Normal file
556
test-resources/lib_tests/rewrite_clj/paredit_test.cljc
Normal file
|
|
@ -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))))
|
||||
578
test-resources/lib_tests/rewrite_clj/parser_test.cljc
Normal file
578
test-resources/lib_tests/rewrite_clj/parser_test.cljc
Normal file
|
|
@ -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"))
|
||||
|
||||
|
||||
51
test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc
Normal file
51
test-resources/lib_tests/rewrite_clj/zip/subedit_test.cljc
Normal file
|
|
@ -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)))))))
|
||||
172
test-resources/lib_tests/rewrite_clj/zip_test.cljc
Normal file
172
test-resources/lib_tests/rewrite_clj/zip_test.cljc
Normal file
|
|
@ -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?))))
|
||||
|
|
@ -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."))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue