deps: make the .cpcache key stable and keep git fetch off stdout

The cache key was built with janet's (hash ...), which is seeded per
process, so it never matched across invocations and every jolt-deps run
re-resolved and re-fetched. Store the raw key material instead.

Run the jpm git calls silenced (:silent) with a one-line progress note
on stderr — the checkout chatter ("HEAD is now at ...") was landing on
stdout and corrupting the documented JOLT_PATH=$(jolt-deps path) capture.

Covered by two new deps-resolve checks: a cross-process cache-hit probe
(sentinel-tampered cache file) and a stdout-cleanliness check against a
local file:// git dep.
This commit is contained in:
Yogthos 2026-06-11 01:31:37 -04:00
parent 9cb3369f50
commit c2511fee7e
2 changed files with 87 additions and 10 deletions

View file

@ -30,11 +30,17 @@
# spec is a deps.edn dep value: {:git/url ... :git/sha/:git/tag ...}
(def resolve-bundle (jpm-fn "jpm/pm" 'resolve-bundle))
(def download-bundle (jpm-fn "jpm/pm" 'download-bundle))
(def b (resolve-bundle {:url (get spec :git/url)
:sha (get spec :git/sha)
:tag (get spec :git/tag)
:shallow false}))
(download-bundle (b :url) (b :type) (b :tag) (b :shallow)))
# Run git silenced (jpm's shell honors :silent): its checkout chatter
# ("HEAD is now at …") otherwise lands on STDOUT and corrupts the
# documented `JOLT_PATH=$(jolt-deps path)` capture. Progress goes to stderr.
(eprintf "jolt-deps: fetching %s @ %s"
(get spec :git/url) (or (get spec :git/sha) (get spec :git/tag) "HEAD"))
(with-dyns [:silent true]
(def b (resolve-bundle {:url (get spec :git/url)
:sha (get spec :git/sha)
:tag (get spec :git/tag)
:shallow false}))
(download-bundle (b :url) (b :type) (b :tag) (b :shallow))))
(defn- src-roots
"Source dirs of a project/dep at `dir`: its deps.edn :paths joined to dir
@ -210,14 +216,16 @@
(os/mkdir ".cpcache")
(def cache-file ".cpcache/jolt-deps.jdn")
(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 [])))]))
# The raw key material, not (hash …): janet's hash is seeded per process,
# so a hashed key never matches across invocations and the cache never hit.
(def key [(slurp deps-edn-path)
(or (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)))
(if (and cached (deep= key (get cached :key)))
(get cached :roots)
(let [roots (resolve-deps deps-edn-path tree aliases)]
(spit cache-file (string/format "%j" {:hash h :roots roots}))
(spit cache-file (string/format "%j" {:key key :roots roots}))
roots))))
# --- :tasks (the honest subset of babashka's) ----------------------------------

View file

@ -6,6 +6,9 @@
(use ../../src/jolt/types)
(import ../../src/jolt/deps :as deps)
# Captured before any os/cd: subprocess tests below re-import src/jolt/deps.
(def repo-root (os/cwd))
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-resolve-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
@ -53,9 +56,75 @@
(deep= roots (deps/resolve-deps-cached "deps.edn" (string base "/proj/jpm_tree")))
true)
# The cache must hit across PROCESSES: janet's (hash ...) is seeded per process,
# so a key built with it never matches a cached one and every invocation
# re-resolved (and re-fetched git deps). Detection: plant a sentinel root in the
# cache file — a fresh process that hits the cache returns it; a process that
# misses re-resolves and overwrites it.
(os/cd (string base "/proj"))
(def cache-file ".cpcache/jolt-deps.jdn")
(def cached-now (parse (slurp cache-file)))
(spit cache-file
(string/format "%j" (merge cached-now
{:roots [;(get cached-now :roots) "/SENTINEL"]})))
(defn subprocess-roots []
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` base "/proj" `") `
`(print (string/join (deps/resolve-deps-cached "deps.edn" "` base "/proj/jpm_tree" `") ":"))`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(check "cache hits across processes"
(string/has-suffix? "/SENTINEL" (subprocess-roots))
true)
(os/cd "/")
(rmrf base)
# Git-dep resolution must keep stdout clean: `JOLT_PATH=$(jolt-deps path)` is
# the documented capture, and git's checkout chatter ("HEAD is now at …") was
# corrupting it. Uses a file:// git dep so no network is needed.
(def gbase (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-gitout-" (os/time)))
(rmrf gbase)
(each d ["lib/src/glib" "proj2"] (mkdirs (string gbase "/" d)))
(spit (string gbase "/lib/src/glib/core.clj") "(ns glib.core)\n(defn n [] 7)\n")
(spit (string gbase "/lib/deps.edn") `{:paths ["src"]}`)
(defn sh-out [args &opt cwd]
(def p (os/spawn args :px {:out :pipe :err :pipe :cd (or cwd ".")}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(def git-ok
(truthy?
(protect
(do (sh-out ["git" "-c" "init.defaultBranch=master" "init"] (string gbase "/lib"))
(sh-out ["git" "add" "-A"] (string gbase "/lib"))
(sh-out ["git" "-c" "user.email=t@t" "-c" "user.name=t" "commit" "-m" "init" "-q"]
(string gbase "/lib"))))))
(if (not git-ok)
(print " skip git-dep stdout test (git unavailable)")
(do
(def sha (sh-out ["git" "rev-parse" "HEAD"] (string gbase "/lib")))
(spit (string gbase "/proj2/deps.edn")
(string `{:paths ["src"] :deps {my/glib {:git/url "file://` gbase `/lib" :git/sha "` sha `"}}}`))
(os/setenv "JOLT_GITLIBS" (string gbase "/gitlibs"))
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` gbase "/proj2" `") `
`(deps/resolve-deps "deps.edn" "` gbase "/proj2/jpm_tree" `") `
`(eprint "done")`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(os/setenv "JOLT_GITLIBS" nil)
(check "git-dep resolution keeps stdout clean" (string (or out "")) ""))
)
(rmrf gbase)
(if (> fails 0)
(error (string "deps-resolve-test: " fails " failing check(s)"))
(print "\nAll deps-resolve tests passed!"))