Merge pull request #68 from jolt-lang/deps-aliases
deps: aliases, user config merge, tools.deps conflict semantics
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
0a01afe595
4 changed files with 358 additions and 44 deletions
|
|
@ -42,50 +42,153 @@
|
|||
[dir edn]
|
||||
(map |(string dir "/" $) (or (and edn (get edn :paths)) ["src"])))
|
||||
|
||||
# --- user config + aliases (tools.deps-shaped, scoped to git/:local) -----------
|
||||
|
||||
(defn config-dir
|
||||
"User-level config dir: $JOLT_CONFIG, else $XDG_CONFIG_HOME/jolt, else
|
||||
~/.jolt — the same fallback chain the Clojure CLI uses for ~/.clojure."
|
||||
[]
|
||||
(or (os/getenv "JOLT_CONFIG")
|
||||
(when-let [x (os/getenv "XDG_CONFIG_HOME")]
|
||||
(when (> (length x) 0) (string x "/jolt")))
|
||||
(string (os/getenv "HOME") "/.jolt")))
|
||||
|
||||
(defn- merge-per-key [a b] # dictionary union, b's entries win
|
||||
(def out @{})
|
||||
(each m [a b] (when (dictionary? m) (eachp [k v] m (put out k v))))
|
||||
out)
|
||||
|
||||
(defn load-config
|
||||
"The project deps.edn merged over the user-level one (config-dir)/deps.edn.
|
||||
tools.deps merge semantics: scalar keys and :paths replace (project wins),
|
||||
:deps and :aliases merge per key with the project winning. Relative
|
||||
:local/root in the USER file is resolved against the cwd — prefer absolute
|
||||
paths there."
|
||||
[deps-edn-path]
|
||||
(def proj (read-edn deps-edn-path))
|
||||
(def user (read-edn (string (config-dir) "/deps.edn")))
|
||||
(cond
|
||||
(nil? user) proj
|
||||
(nil? proj) user
|
||||
(let [out (merge-per-key user proj)]
|
||||
(put out :deps (merge-per-key (get user :deps) (get proj :deps)))
|
||||
(put out :aliases (merge-per-key (get user :aliases) (get proj :aliases)))
|
||||
out)))
|
||||
|
||||
(defn combine-aliases
|
||||
"Combine the selected alias keywords against `edn`'s :aliases:
|
||||
:extra-paths and :extra-deps accumulate in order, :main-opts is last-wins
|
||||
(the tools.deps CLI rules). Unknown alias -> error."
|
||||
[edn aliases]
|
||||
(def als (or (and (dictionary? edn) (get edn :aliases)) {}))
|
||||
(def extra-paths @[])
|
||||
(def extra-deps @{})
|
||||
(var main-opts nil)
|
||||
(each a (or aliases [])
|
||||
(def spec (get als a))
|
||||
(when (nil? spec) (error (string "unknown alias: " a)))
|
||||
(each p (or (get spec :extra-paths) []) (array/push extra-paths p))
|
||||
(when (dictionary? (get spec :extra-deps))
|
||||
(eachp [lib coord] (get spec :extra-deps) (put extra-deps lib coord)))
|
||||
(when-let [mo (get spec :main-opts)]
|
||||
(set main-opts (tuple ;(map string mo)))))
|
||||
{:extra-paths extra-paths :extra-deps extra-deps :main-opts main-opts})
|
||||
|
||||
(defn alias-main-opts
|
||||
"The :main-opts the selected aliases produce (last alias with the key wins),
|
||||
or nil. Reads the merged user+project config."
|
||||
[deps-edn-path aliases]
|
||||
(get (combine-aliases (load-config deps-edn-path) aliases) :main-opts))
|
||||
|
||||
(defn resolve-deps
|
||||
"Resolve the git/:local deps of `deps-edn-path` into an ordered, de-duplicated
|
||||
array of source dirs (the project's own :paths first, then each dependency's,
|
||||
transitively). `tree` is where jpm's clone cache lives (default ./jpm_tree)."
|
||||
[deps-edn-path &opt tree]
|
||||
transitively). `tree` is where jpm's clone cache lives (default ./jpm_tree).
|
||||
`aliases` (keywords) pull :extra-paths/:extra-deps from the merged config's
|
||||
:aliases. The user-level deps.edn (see load-config) merges under the project."
|
||||
[deps-edn-path &opt tree aliases]
|
||||
(default tree (string (os/cwd) "/jpm_tree"))
|
||||
(os/mkdir tree)
|
||||
(ensure-jpm-config tree)
|
||||
(def edn (load-config deps-edn-path))
|
||||
(def extra (combine-aliases edn aliases))
|
||||
(def roots @[])
|
||||
(def seen @{})
|
||||
(def seen @{}) # lib name -> chosen coordinate (for conflict reporting)
|
||||
(defn add-root [r] (unless (index-of r roots) (array/push roots r)))
|
||||
(defn process [edn base-dir own-paths?]
|
||||
(when (dictionary? edn)
|
||||
(when own-paths? (each r (src-roots base-dir edn) (add-root r)))
|
||||
(eachp [lib spec] (or (get edn :deps) {})
|
||||
(def k (string lib))
|
||||
(unless (get seen k)
|
||||
(put seen k true)
|
||||
(def dir
|
||||
(cond
|
||||
(and (dictionary? spec) (get spec :git/url)) (clone-git spec)
|
||||
(and (dictionary? spec) (get spec :local/root))
|
||||
(let [lr (get spec :local/root)]
|
||||
(if (string/has-prefix? "/" lr) lr (string base-dir "/" lr)))
|
||||
nil)) # :mvn/* and anything else: skip
|
||||
(when dir
|
||||
(def dep-edn (read-edn (string dir "/deps.edn")))
|
||||
(each r (src-roots dir dep-edn) (add-root r))
|
||||
(process dep-edn dir false))))))
|
||||
(process (read-edn deps-edn-path) (os/cwd) true)
|
||||
# Reader symbols carry position metadata, so dedup/conflict keys must use the
|
||||
# NAME, never (string lib) — two my/b symbols from different files differ.
|
||||
(defn lib-name [lib]
|
||||
(if (and (dictionary? lib) (get lib :name))
|
||||
(if-let [ns (get lib :ns)]
|
||||
(string ns "/" (get lib :name))
|
||||
(get lib :name))
|
||||
(string lib)))
|
||||
(defn coord-str [spec]
|
||||
(cond
|
||||
(and (dictionary? spec) (get spec :local/root))
|
||||
(string ":local/root " (get spec :local/root))
|
||||
(and (dictionary? spec) (get spec :git/url))
|
||||
(string (get spec :git/url) " @ " (or (get spec :git/sha) (get spec :git/tag)))
|
||||
(string/format "%j" spec)))
|
||||
(defn coord= [a b]
|
||||
(and (deep= (get a :local/root) (get b :local/root))
|
||||
(deep= (get a :git/url) (get b :git/url))
|
||||
(deep= (get a :git/sha) (get b :git/sha))
|
||||
(deep= (get a :git/tag) (get b :git/tag))))
|
||||
(def queue @[])
|
||||
(defn discover [lib spec base-dir]
|
||||
(def k (lib-name lib))
|
||||
(if-let [prev (get seen k)]
|
||||
(unless (coord= prev spec)
|
||||
(eprintf "WARNING: %s: conflicting coordinates — using %s, ignoring %s"
|
||||
k (coord-str prev) (coord-str spec)))
|
||||
(do
|
||||
(put seen k spec)
|
||||
(def dir
|
||||
(cond
|
||||
(and (dictionary? spec) (get spec :git/url)) (clone-git spec)
|
||||
(and (dictionary? spec) (get spec :local/root))
|
||||
(let [lr (get spec :local/root)]
|
||||
(if (string/has-prefix? "/" lr) lr (string base-dir "/" lr)))
|
||||
nil)) # :mvn/* and anything else: skip
|
||||
(when dir
|
||||
(def dep-edn (read-edn (string dir "/deps.edn")))
|
||||
(each r (src-roots dir dep-edn) (add-root r))
|
||||
(array/push queue [dep-edn dir])))))
|
||||
# the project's own paths (+ alias extra paths) lead the roots
|
||||
(each r (src-roots (os/cwd) edn) (add-root r))
|
||||
(each pp (extra :extra-paths) (add-root (string (os/cwd) "/" pp)))
|
||||
# breadth-first: every top-level dep (incl. alias :extra-deps) registers
|
||||
# before any transitive dep — so a top-level coordinate always wins,
|
||||
# matching tools.deps
|
||||
(eachp [lib spec] (or (and (dictionary? edn) (get edn :deps)) {})
|
||||
(discover lib spec (os/cwd)))
|
||||
(eachp [lib spec] (extra :extra-deps)
|
||||
(discover lib spec (os/cwd)))
|
||||
(while (> (length queue) 0)
|
||||
(def [dep-edn dir] (get queue 0))
|
||||
(array/remove queue 0)
|
||||
(when (dictionary? dep-edn)
|
||||
(eachp [lib spec] (or (get dep-edn :deps) {})
|
||||
(discover lib spec dir))))
|
||||
roots)
|
||||
|
||||
(defn resolve-deps-cached
|
||||
"Like resolve-deps, but caches the resolved roots in the tree keyed on a hash
|
||||
of the deps.edn, so an unchanged deps.edn resolves without re-fetching."
|
||||
[deps-edn-path &opt tree]
|
||||
of the project deps.edn + the user deps.edn + the selected aliases, so an
|
||||
unchanged config resolves without re-fetching."
|
||||
[deps-edn-path &opt tree aliases]
|
||||
(default tree (string (os/cwd) "/jpm_tree"))
|
||||
(when (os/stat deps-edn-path)
|
||||
(os/mkdir tree)
|
||||
(def cache-file (string tree "/.jolt-deps-roots.jdn"))
|
||||
(def h (hash (slurp deps-edn-path)))
|
||||
(def user-path (string (config-dir) "/deps.edn"))
|
||||
(def h (hash [(slurp deps-edn-path)
|
||||
(when (os/stat user-path) (slurp user-path))
|
||||
(string/format "%j" (map string (or aliases [])))]))
|
||||
(def cached (when (os/stat cache-file) (try (parse (slurp cache-file)) ([_] nil))))
|
||||
(if (and cached (= h (get cached :hash)))
|
||||
(get cached :roots)
|
||||
(let [roots (resolve-deps deps-edn-path tree)]
|
||||
(let [roots (resolve-deps deps-edn-path tree aliases)]
|
||||
(spit cache-file (string/format "%j" {:hash h :roots roots}))
|
||||
roots))))
|
||||
|
|
|
|||
|
|
@ -5,40 +5,63 @@
|
|||
# api/init). This tool does the resolution (git + :local deps, via jpm's fetch
|
||||
# cache) and either prints the roots or launches jolt with JOLT_PATH set.
|
||||
#
|
||||
# jolt-deps path print the resolved roots (':'-joined), e.g. for
|
||||
# JOLT_PATH=$(jolt-deps path) jolt file.clj
|
||||
# jolt-deps run FILE [args] resolve, then run `jolt FILE args` with JOLT_PATH set
|
||||
# jolt-deps repl resolve, then start a jolt REPL with JOLT_PATH set
|
||||
# jolt-deps -e EXPR [args] resolve, then `jolt -e EXPR ...` with JOLT_PATH set
|
||||
# jolt-deps uberscript OUT -m NS
|
||||
# resolve, then bundle NS + its deps into one .clj
|
||||
# jolt-deps [-A:a:b] path print the resolved roots (':'-joined), e.g.
|
||||
# JOLT_PATH=$(jolt-deps path) jolt file.clj
|
||||
# jolt-deps [-A:a:b] run FILE [args]
|
||||
# resolve, then `jolt FILE args` with JOLT_PATH set
|
||||
# jolt-deps [-A:a:b] repl resolve, then a jolt REPL with JOLT_PATH set
|
||||
# jolt-deps [-A:a:b] -e EXPR resolve, then `jolt -e EXPR ...`
|
||||
# jolt-deps -M:a[:b] [args] resolve with the aliases, then run jolt with
|
||||
# the last alias's :main-opts ++ args
|
||||
# jolt-deps uberscript OUT -m NS resolve, then bundle NS + deps into one .clj
|
||||
#
|
||||
# -A:dev:test selects aliases (tools.deps style): their :extra-paths and
|
||||
# :extra-deps join the resolution. A user-level deps.edn ($JOLT_CONFIG, else
|
||||
# $XDG_CONFIG_HOME/jolt, else ~/.jolt) merges under the project's.
|
||||
# The jolt binary is found via $JOLT_BIN, else `jolt` on PATH.
|
||||
|
||||
(import ./deps :as deps)
|
||||
|
||||
(defn- roots []
|
||||
(if (os/stat "deps.edn") (deps/resolve-deps-cached "deps.edn") @[]))
|
||||
(defn- parse-alias-flag
|
||||
"\"-A:dev:test\" -> [:dev :test] (also accepts -M:...)."
|
||||
[arg]
|
||||
(map keyword (filter |(not= "" $) (string/split ":" (string/slice arg 2)))))
|
||||
|
||||
(defn- exec-jolt [extra-args]
|
||||
(defn- roots [aliases]
|
||||
(if (os/stat "deps.edn") (deps/resolve-deps-cached "deps.edn" nil aliases) @[]))
|
||||
|
||||
(defn- exec-jolt [aliases extra-args]
|
||||
# Set JOLT_PATH in our own env and let the child inherit it (os/execute's env
|
||||
# arg isn't honored here; inheriting is reliable).
|
||||
(def rs (string/join (roots) ":"))
|
||||
(def rs (string/join (roots aliases) ":"))
|
||||
(def existing (os/getenv "JOLT_PATH"))
|
||||
(os/setenv "JOLT_PATH" (if (and existing (> (length existing) 0)) (string rs ":" existing) rs))
|
||||
(os/execute [(os/getenv "JOLT_BIN" "jolt") ;extra-args] :p))
|
||||
|
||||
(defn- usage []
|
||||
(print "usage: jolt-deps [path | run FILE [args] | repl | -e EXPR [args]]"))
|
||||
(print "usage: jolt-deps [-A:alias[:alias]] [path | run FILE [args] | repl | -e EXPR [args]]")
|
||||
(print " jolt-deps -M:alias[:alias] [args] (runs the alias :main-opts)")
|
||||
(print " jolt-deps uberscript OUT -m NS"))
|
||||
|
||||
(defn main [&]
|
||||
(def argv (tuple/slice (or (dyn :args) @[]) 1))
|
||||
(var argv (tuple/slice (or (dyn :args) @[]) 1))
|
||||
(var aliases nil)
|
||||
# leading -A:... selects aliases for whatever command follows
|
||||
(while (string/has-prefix? "-A" (or (get argv 0) ""))
|
||||
(set aliases (array/concat (or aliases @[]) (parse-alias-flag (get argv 0))))
|
||||
(set argv (tuple/slice argv 1)))
|
||||
(def cmd (get argv 0))
|
||||
(cond
|
||||
(or (nil? cmd) (= cmd "help") (= cmd "-h") (= cmd "--help")) (usage)
|
||||
(= cmd "path") (print (string/join (roots) ":"))
|
||||
(= cmd "run") (os/exit (exec-jolt (tuple/slice argv 1)))
|
||||
(= cmd "repl") (os/exit (exec-jolt []))
|
||||
(= cmd "-e") (os/exit (exec-jolt argv))
|
||||
(= cmd "uberscript") (os/exit (exec-jolt argv))
|
||||
(string/has-prefix? "-M" cmd)
|
||||
(let [als (array/concat (or aliases @[]) (parse-alias-flag cmd))
|
||||
mo (or (deps/alias-main-opts "deps.edn" als)
|
||||
(do (eprint "jolt-deps: no :main-opts in aliases " (string/format "%j" (map string als)))
|
||||
(os/exit 1)))]
|
||||
(os/exit (exec-jolt als [;mo ;(tuple/slice argv 1)])))
|
||||
(= cmd "path") (print (string/join (roots aliases) ":"))
|
||||
(= cmd "run") (os/exit (exec-jolt aliases (tuple/slice argv 1)))
|
||||
(= cmd "repl") (os/exit (exec-jolt aliases []))
|
||||
(= cmd "-e") (os/exit (exec-jolt aliases argv))
|
||||
(= cmd "uberscript") (os/exit (exec-jolt aliases argv))
|
||||
(do (eprint "jolt-deps: unknown command " cmd) (usage) (os/exit 1))))
|
||||
|
|
|
|||
119
test/integration/deps-aliases-test.janet
Normal file
119
test/integration/deps-aliases-test.janet
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
# deps.edn aliases + user-level config merge (jolt-4go).
|
||||
#
|
||||
# Mirrors tools.deps semantics scoped to what jolt supports (git/:local, no
|
||||
# maven): :aliases with :extra-paths / :extra-deps / :main-opts selected by
|
||||
# keyword; a user deps.edn (under $JOLT_CONFIG, else $XDG_CONFIG_HOME/jolt,
|
||||
# else ~/.jolt) merged UNDER the project file — :deps and :aliases merge per
|
||||
# key with the project winning, :paths replaces. Local deps only: no network.
|
||||
|
||||
(import ../../src/jolt/deps :as deps)
|
||||
|
||||
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-aliases-" (os/time)))
|
||||
(defn rmrf [p]
|
||||
(when (os/stat p)
|
||||
(if (= :directory (os/stat p :mode))
|
||||
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
|
||||
(os/rm p))))
|
||||
(rmrf base)
|
||||
|
||||
(defn mkdirs [p]
|
||||
(def abs (string/has-prefix? "/" p))
|
||||
(var acc nil)
|
||||
(each seg (filter |(not= "" $) (string/split "/" p))
|
||||
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
|
||||
(unless (os/stat acc) (os/mkdir acc))))
|
||||
|
||||
(each d ["proj/src" "proj/dev" "proj/test" "a/src" "c/src" "u/src" "config"]
|
||||
(mkdirs (string base "/" d)))
|
||||
|
||||
# project: src + dep a; :dev alias adds dev/ + dep c; :test alias adds test/
|
||||
(spit (string base "/proj/deps.edn")
|
||||
`{:paths ["src"]
|
||||
:deps {my/a {:local/root "../a"}}
|
||||
:aliases {:dev {:extra-paths ["dev"]
|
||||
:extra-deps {my/c {:local/root "../c"}}}
|
||||
:test {:extra-paths ["test"]
|
||||
:main-opts ["-e" "(run-tests)"]}
|
||||
:bench {:main-opts ["-e" "(bench)"]}}}`)
|
||||
(spit (string base "/a/deps.edn") `{:paths ["src"]}`)
|
||||
(spit (string base "/c/deps.edn") `{:paths ["src"]}`)
|
||||
(spit (string base "/u/deps.edn") `{:paths ["src"]}`)
|
||||
|
||||
# user-level config: a :user-tool alias the project file doesn't have, plus a
|
||||
# :dev alias that the PROJECT's :dev must shadow (per-key merge, project wins)
|
||||
(spit (string base "/config/deps.edn")
|
||||
`{:aliases {:user-tool {:extra-deps {my/u {:local/root "BASE/u"}}}
|
||||
:dev {:extra-paths ["should-not-win"]}}}`)
|
||||
# :local/root in the user file is relative to... nothing useful; use absolute
|
||||
(spit (string base "/config/deps.edn")
|
||||
(string/replace "BASE" base (slurp (string base "/config/deps.edn"))))
|
||||
|
||||
(var fails 0)
|
||||
(defn check [label got expected]
|
||||
(if (= got expected) (print " ok " label)
|
||||
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
|
||||
(defn has-suffix-root [roots suff]
|
||||
(truthy? (some |(string/has-suffix? suff $) roots)))
|
||||
|
||||
(os/cd (string base "/proj"))
|
||||
(os/setenv "JOLT_CONFIG" (string base "/config"))
|
||||
(def tree (string base "/proj/jpm_tree"))
|
||||
|
||||
# --- no aliases: plain resolution, dev/test/c absent ---------------------------
|
||||
(def plain (deps/resolve-deps "deps.edn" tree))
|
||||
(check "plain: project src present" (has-suffix-root plain "/proj/src") true)
|
||||
(check "plain: dep a present" (has-suffix-root plain "/a/src") true)
|
||||
(check "plain: alias path absent" (has-suffix-root plain "/proj/dev") false)
|
||||
(check "plain: alias dep absent" (has-suffix-root plain "/c/src") false)
|
||||
|
||||
# --- :dev alias: extra-paths + extra-deps --------------------------------------
|
||||
(def dev (deps/resolve-deps "deps.edn" tree [:dev]))
|
||||
(check "dev: extra path present" (has-suffix-root dev "/proj/dev") true)
|
||||
(check "dev: extra dep present" (has-suffix-root dev "/c/src") true)
|
||||
(check "dev: base dep still present" (has-suffix-root dev "/a/src") true)
|
||||
(check "dev: project :dev shadows user :dev"
|
||||
(has-suffix-root dev "/proj/should-not-win") false)
|
||||
|
||||
# --- multiple aliases combine ---------------------------------------------------
|
||||
(def both (deps/resolve-deps "deps.edn" tree [:dev :test]))
|
||||
(check "multi: both extra paths"
|
||||
(and (has-suffix-root both "/proj/dev") (has-suffix-root both "/proj/test")) true)
|
||||
|
||||
# --- alias from the USER deps.edn ----------------------------------------------
|
||||
(def ut (deps/resolve-deps "deps.edn" tree [:user-tool]))
|
||||
(check "user alias resolves its dep" (has-suffix-root ut "/u/src") true)
|
||||
|
||||
# --- main-opts: from alias, last alias wins ------------------------------------
|
||||
(check "main-opts from alias"
|
||||
(deps/alias-main-opts "deps.edn" [:test]) ["-e" "(run-tests)"])
|
||||
(check "main-opts last alias wins"
|
||||
(deps/alias-main-opts "deps.edn" [:test :bench]) ["-e" "(bench)"])
|
||||
(check "main-opts absent is nil"
|
||||
(deps/alias-main-opts "deps.edn" [:dev]) nil)
|
||||
|
||||
# --- cached resolution keys on aliases + user config ----------------------------
|
||||
(check "cache: aliased result differs from plain"
|
||||
(deep= (deps/resolve-deps-cached "deps.edn" tree)
|
||||
(deps/resolve-deps-cached "deps.edn" tree [:dev]))
|
||||
false)
|
||||
(check "cache: same key returns same roots"
|
||||
(deep= (deps/resolve-deps-cached "deps.edn" tree [:dev])
|
||||
(deps/resolve-deps-cached "deps.edn" tree [:dev]))
|
||||
true)
|
||||
|
||||
# --- unknown alias errors --------------------------------------------------------
|
||||
(check "unknown alias errors"
|
||||
(let [r (protect (deps/resolve-deps "deps.edn" tree [:nope]))] (r 0))
|
||||
false)
|
||||
|
||||
# --- works without a user config (env unset) ------------------------------------
|
||||
(os/setenv "JOLT_CONFIG" (string base "/no-such-dir"))
|
||||
(check "no user config still resolves"
|
||||
(has-suffix-root (deps/resolve-deps "deps.edn" tree) "/a/src") true)
|
||||
|
||||
(os/cd "/")
|
||||
(rmrf base)
|
||||
|
||||
(if (> fails 0)
|
||||
(error (string "deps-aliases-test: " fails " failing check(s)"))
|
||||
(print "\nAll deps-aliases tests passed!"))
|
||||
69
test/integration/deps-conflicts-test.janet
Normal file
69
test/integration/deps-conflicts-test.janet
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
# deps.edn conflict semantics (jolt-42f), tools.deps-shaped:
|
||||
# a TOP-LEVEL :deps entry beats any transitive coordinate for the same lib
|
||||
# (resolution is breadth-first, top level enqueued first), and when two
|
||||
# DIFFERENT coordinates for one lib meet, a warning naming both goes to stderr.
|
||||
# Local deps only: no network.
|
||||
|
||||
(import ../../src/jolt/deps :as deps)
|
||||
|
||||
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-conflicts-" (os/time)))
|
||||
(defn rmrf [p]
|
||||
(when (os/stat p)
|
||||
(if (= :directory (os/stat p :mode))
|
||||
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
|
||||
(os/rm p))))
|
||||
(rmrf base)
|
||||
(defn mkdirs [p]
|
||||
(def abs (string/has-prefix? "/" p))
|
||||
(var acc nil)
|
||||
(each seg (filter |(not= "" $) (string/split "/" p))
|
||||
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
|
||||
(unless (os/stat acc) (os/mkdir acc))))
|
||||
|
||||
# proj depends on A and on B@b2 (top level). A depends on B@b1 (transitive).
|
||||
# DFS-first-wins would pick b1; tools.deps semantics pick the top-level b2.
|
||||
(each d ["proj/src" "a/src" "b1/src" "b2/src"] (mkdirs (string base "/" d)))
|
||||
(spit (string base "/proj/deps.edn")
|
||||
`{:paths ["src"]
|
||||
:deps {my/a {:local/root "../a"}
|
||||
my/b {:local/root "../b2"}}}`)
|
||||
(spit (string base "/a/deps.edn")
|
||||
`{:paths ["src"] :deps {my/b {:local/root "../b1"}}}`)
|
||||
(spit (string base "/b1/deps.edn") `{:paths ["src"]}`)
|
||||
(spit (string base "/b2/deps.edn") `{:paths ["src"]}`)
|
||||
|
||||
(var fails 0)
|
||||
(defn check [label got expected]
|
||||
(if (= got expected) (print " ok " label)
|
||||
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
|
||||
(defn has-suffix-root [roots suff]
|
||||
(truthy? (some |(string/has-suffix? suff $) roots)))
|
||||
|
||||
(os/cd (string base "/proj"))
|
||||
(def tree (string base "/proj/jpm_tree"))
|
||||
|
||||
(def warn-buf @"")
|
||||
(def roots (with-dyns [:err warn-buf] (deps/resolve-deps "deps.edn" tree)))
|
||||
|
||||
(check "top-level coordinate wins" (has-suffix-root roots "/b2/src") true)
|
||||
(check "transitive loser not on path" (has-suffix-root roots "/b1/src") false)
|
||||
(check "dep a still resolved" (has-suffix-root roots "/a/src") true)
|
||||
(check "conflict warning names the lib"
|
||||
(truthy? (string/find "my/b" (string warn-buf))) true)
|
||||
(check "conflict warning names both coordinates"
|
||||
(and (truthy? (string/find "../b1" (string warn-buf)))
|
||||
(truthy? (string/find "../b2" (string warn-buf)))) true)
|
||||
|
||||
# same coordinate twice from different parents: no warning
|
||||
(spit (string base "/a/deps.edn")
|
||||
`{:paths ["src"] :deps {my/b {:local/root "../b2"}}}`)
|
||||
(def warn2 @"")
|
||||
(with-dyns [:err warn2] (deps/resolve-deps "deps.edn" tree))
|
||||
(check "agreeing coordinates warn nothing" (string warn2) "")
|
||||
|
||||
(os/cd "/")
|
||||
(rmrf base)
|
||||
|
||||
(if (> fails 0)
|
||||
(error (string "deps-conflicts-test: " fails " failing check(s)"))
|
||||
(print "\nAll deps-conflicts tests passed!"))
|
||||
Loading…
Add table
Add a link
Reference in a new issue