summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-03 21:11:26 -0500
committerCraig Jennings <c@cjennings.net>2026-05-03 21:11:26 -0500
commit31edc86a54d20c3c73d0ebad247fde2c35e6a964 (patch)
tree3b4af9056b22d2ee09e9a7a9bb9196e9a60d89b7
parentba1a0249bfbc61ba3590ec0c9cd8b5568980ab22 (diff)
downloaddotemacs-31edc86a54d20c3c73d0ebad247fde2c35e6a964.tar.gz
dotemacs-31edc86a54d20c3c73d0ebad247fde2c35e6a964.zip
fix: scope projectile cache revert state to each compile
The projectile compile/test/run cache-revert protection in `dev-fkeys.el` used a single global variable, `cj/--projectile-revert-state`. Two overlapping compiles could clobber each other's state. The second compile's capture would overwrite the first's. So when the first compile finished and ran the global finish-hook, it'd act on the wrong project's state, or revert nothing because the keys had drifted. I moved the state into a closure. `cj/--projectile-capture-cmd` now returns the state plist instead of mutating the global. `cj/--projectile-around-revert` captures the state into a local, calls the projectile cmd-runner, and installs a one-shot buffer-local finish hook on the returned compilation buffer. The hook closes over its own state plist, so two compiles can finish in any order and each one acts on the right project. I extracted three small helpers along the way. `cj/--projectile-revert-state-on-fail` is the pure decision (revert when failed AND modified AND prior was non-nil). `cj/--projectile-make-revert-on-fail-hook` builds the closure-based one-shot hook. `cj/--projectile-compilation-buffer` normalizes a buffer-or-process result from projectile into a buffer. The legacy `cj/--projectile-revert-on-fail` function still reads the global `cj/--projectile-revert-state`. It stays around for the existing direct tests, but its core logic now delegates to the extracted state-on-fail helper. No production caller adds it to `compilation-finish-functions` anymore. I added one regression test in `test-dev-fkeys--projectile-around-revert.el`: two projectile invocations on different projects, finishes triggered out of order, each compile reverts its own project's cache and leaves the other alone. The capture and around-advice tests were rewritten to match the new return-style API and to assert hooks land buffer-locally rather than globally. 19 projectile-related tests pass together.
-rw-r--r--modules/dev-fkeys.el81
-rw-r--r--tests/test-dev-fkeys--projectile-around-revert.el79
-rw-r--r--tests/test-dev-fkeys--projectile-capture-cmd.el28
3 files changed, 138 insertions, 50 deletions
diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el
index 836b7cf6..0b973470 100644
--- a/modules/dev-fkeys.el
+++ b/modules/dev-fkeys.el
@@ -175,26 +175,40 @@ a single Compile entry that calls plain `compile'."
;; the three projectile cmd-runners reverts the cache to its prior value
;; if the compile fails AND the cmd was modified. A test that fails
;; because of a real code bug (cmd unchanged) leaves the cache alone.
+;; Revert state is captured before Projectile runs, then closed over by a
+;; buffer-local compilation finish hook so overlapping compiles cannot
+;; overwrite or consume one another's revert metadata.
(defvar cj/--projectile-revert-state nil
- "Plist describing the projectile cache state to potentially revert.
-Set by `cj/--projectile-capture-cmd' before each invocation; read and
-cleared by `cj/--projectile-revert-on-fail' after the compile finishes.
-Keys: :map (cmd-map symbol), :root (project root), :prior (cached cmd
-before invocation, may be nil).")
+ "Legacy dynamic state used by direct tests of `cj/--projectile-revert-on-fail'.
+The around advice no longer stores live compile metadata here; it closes
+over the plist returned by `cj/--projectile-capture-cmd' instead.")
(defun cj/--projectile-capture-cmd (map-symbol)
"Capture the cached cmd at the project root in MAP-SYMBOL.
MAP-SYMBOL is the symbol of a projectile cmd-map (e.g.
-`projectile-compile-cmd-map'). Stashes a plist in
-`cj/--projectile-revert-state' for the finish hook to read. No-op when
-the project root cannot be resolved or MAP-SYMBOL is unbound (projectile
-not loaded)."
+`projectile-compile-cmd-map'). Return nil when the project root cannot
+be resolved or MAP-SYMBOL is unbound (projectile not loaded)."
(let ((root (cj/--f4-project-root)))
(when (and root (boundp map-symbol))
(let ((prior (gethash root (symbol-value map-symbol))))
- (setq cj/--projectile-revert-state
- (list :map map-symbol :root root :prior prior))))))
+ (list :map map-symbol :root root :prior prior)))))
+
+(defun cj/--projectile-revert-state-on-fail (state status)
+ "Apply projectile cache revert STATE when STATUS is a failed compile.
+Reverts the cmd-map entry only when the compile failed AND the cmd was
+modified from the captured prior value AND that prior was non-nil. The
+unchanged-and-failed case (test fails because of a real bug) leaves the
+cache alone."
+ (when (and state (stringp status)
+ (not (string-prefix-p "finished" status)))
+ (let* ((map (plist-get state :map))
+ (root (plist-get state :root))
+ (prior (plist-get state :prior))
+ (current (and (boundp map) (gethash root (symbol-value map)))))
+ (when (and root prior (boundp map)
+ (not (equal prior current)))
+ (puthash root prior (symbol-value map))))))
(defun cj/--projectile-revert-on-fail (_buf status)
"Compilation-finish hook: revert projectile cache on failed-and-modified.
@@ -206,24 +220,41 @@ because of a real bug) leaves the cache alone."
(remove-hook 'compilation-finish-functions #'cj/--projectile-revert-on-fail)
(let ((state cj/--projectile-revert-state))
(setq cj/--projectile-revert-state nil)
- (when (and state (stringp status)
- (not (string-prefix-p "finished" status)))
- (let* ((map (plist-get state :map))
- (root (plist-get state :root))
- (prior (plist-get state :prior))
- (current (and (boundp map) (gethash root (symbol-value map)))))
- (when (and root prior (boundp map)
- (not (equal prior current)))
- (puthash root prior (symbol-value map)))))))
+ (cj/--projectile-revert-state-on-fail state status)))
+
+(defun cj/--projectile-make-revert-on-fail-hook (state)
+ "Return a one-shot buffer-local finish hook for projectile revert STATE."
+ (let (hook)
+ (setq hook
+ (lambda (buf status)
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (remove-hook 'compilation-finish-functions hook t)))
+ (cj/--projectile-revert-state-on-fail state status)))
+ hook))
+
+(defun cj/--projectile-compilation-buffer (result)
+ "Return the compilation buffer represented by RESULT, or nil."
+ (cond
+ ((bufferp result) result)
+ ((processp result) (process-buffer result))
+ (t nil)))
(defun cj/--projectile-around-revert (map-symbol orig-fn &rest args)
"Around-advice for projectile cmd-runners.
MAP-SYMBOL identifies which cmd-map to capture (compile / test / run).
-Captures the prior cached cmd, installs the one-shot revert-on-failure
-hook, then invokes ORIG-FN with ARGS."
- (cj/--projectile-capture-cmd map-symbol)
- (add-hook 'compilation-finish-functions #'cj/--projectile-revert-on-fail)
- (apply orig-fn args))
+Captures the prior cached cmd, invokes ORIG-FN with ARGS, then installs a
+one-shot buffer-local revert-on-failure hook on the returned compilation
+buffer when possible."
+ (let* ((state (cj/--projectile-capture-cmd map-symbol))
+ (result (apply orig-fn args))
+ (buffer (cj/--projectile-compilation-buffer result)))
+ (when (and state (buffer-live-p buffer))
+ (with-current-buffer buffer
+ (add-hook 'compilation-finish-functions
+ (cj/--projectile-make-revert-on-fail-hook state)
+ nil t)))
+ result))
(defun cj/projectile-reset-cmds ()
"Clear projectile's cached compile/test/run cmds for the current project.
diff --git a/tests/test-dev-fkeys--projectile-around-revert.el b/tests/test-dev-fkeys--projectile-around-revert.el
index bdcb11a1..012c4258 100644
--- a/tests/test-dev-fkeys--projectile-around-revert.el
+++ b/tests/test-dev-fkeys--projectile-around-revert.el
@@ -33,29 +33,81 @@
(should (equal calls '((arg1 arg2))))))
(ert-deftest test-dev-fkeys-projectile-around-revert-captures-prior ()
- "Normal: advice captures the prior cmd into the revert state."
+ "Normal: advice captures the prior cmd into the buffer-local hook."
(let ((cj/--projectile-revert-state nil)
(compilation-finish-functions nil)
(projectile-compile-cmd-map (make-hash-table :test 'equal)))
(puthash "/p/" "make build" projectile-compile-cmd-map)
(cl-letf (((symbol-function 'cj/--f4-project-root) (lambda () "/p/")))
- (cj/--projectile-around-revert
- 'projectile-compile-cmd-map
- (lambda (&rest _) nil)))
- (should (equal (plist-get cj/--projectile-revert-state :prior)
- "make build"))))
+ (let ((compile-buffer (get-buffer-create " *compile-capture*")))
+ (unwind-protect
+ (progn
+ (cj/--projectile-around-revert
+ 'projectile-compile-cmd-map
+ (lambda (&rest _) compile-buffer))
+ (puthash "/p/" "make typo" projectile-compile-cmd-map)
+ (with-current-buffer compile-buffer
+ (run-hook-with-args 'compilation-finish-functions
+ compile-buffer "exited abnormally\n"))
+ (should (equal (gethash "/p/" projectile-compile-cmd-map)
+ "make build")))
+ (kill-buffer compile-buffer))))))
(ert-deftest test-dev-fkeys-projectile-around-revert-installs-finish-hook ()
- "Normal: advice adds the revert-on-fail hook to compilation-finish-functions."
+ "Normal: advice adds a buffer-local revert hook to the compilation buffer."
(let ((cj/--projectile-revert-state nil)
(compilation-finish-functions nil)
(projectile-compile-cmd-map (make-hash-table :test 'equal)))
+ (puthash "/p/" "make build" projectile-compile-cmd-map)
(cl-letf (((symbol-function 'cj/--f4-project-root) (lambda () "/p/")))
- (cj/--projectile-around-revert
- 'projectile-compile-cmd-map
- (lambda (&rest _) nil)))
- (should (member #'cj/--projectile-revert-on-fail
- compilation-finish-functions))))
+ (with-current-buffer (get-buffer-create " *compile-a*")
+ (setq-local compilation-finish-functions nil))
+ (unwind-protect
+ (let ((compile-buffer
+ (cj/--projectile-around-revert
+ 'projectile-compile-cmd-map
+ (lambda (&rest _) (get-buffer-create " *compile-a*")))))
+ (should-not compilation-finish-functions)
+ (with-current-buffer compile-buffer
+ (should compilation-finish-functions)))
+ (kill-buffer " *compile-a*")))))
+
+(ert-deftest test-dev-fkeys-projectile-around-revert-overlapping-compiles-use-own-state ()
+ "Regression: overlapping compiles finishing out of order use their own state."
+ (let ((cj/--projectile-revert-state nil)
+ (compilation-finish-functions nil)
+ (projectile-compile-cmd-map (make-hash-table :test 'equal))
+ (roots '("/one/" "/two/")))
+ (puthash "/one/" "make one" projectile-compile-cmd-map)
+ (puthash "/two/" "make two" projectile-compile-cmd-map)
+ (cl-letf (((symbol-function 'cj/--f4-project-root)
+ (lambda () (pop roots))))
+ (let ((buf-one (get-buffer-create " *compile-one*"))
+ (buf-two (get-buffer-create " *compile-two*")))
+ (unwind-protect
+ (progn
+ (cj/--projectile-around-revert
+ 'projectile-compile-cmd-map
+ (lambda (&rest _) buf-one))
+ (cj/--projectile-around-revert
+ 'projectile-compile-cmd-map
+ (lambda (&rest _) buf-two))
+ (puthash "/one/" "make one typo" projectile-compile-cmd-map)
+ (puthash "/two/" "make two typo" projectile-compile-cmd-map)
+ (with-current-buffer buf-two
+ (run-hook-with-args 'compilation-finish-functions
+ buf-two "exited abnormally\n"))
+ (should (string= (gethash "/two/" projectile-compile-cmd-map)
+ "make two"))
+ (should (string= (gethash "/one/" projectile-compile-cmd-map)
+ "make one typo"))
+ (with-current-buffer buf-one
+ (run-hook-with-args 'compilation-finish-functions
+ buf-one "exited abnormally\n"))
+ (should (string= (gethash "/one/" projectile-compile-cmd-map)
+ "make one")))
+ (kill-buffer buf-one)
+ (kill-buffer buf-two))))))
;;; Boundary Cases
@@ -70,7 +122,8 @@ The state stays nil so the finish hook will be a no-op too."
'projectile-compile-cmd-map
(lambda (&rest _) (cl-incf calls))))
(should (= calls 1))
- (should (null cj/--projectile-revert-state))))
+ (should (null cj/--projectile-revert-state))
+ (should-not compilation-finish-functions)))
(provide 'test-dev-fkeys--projectile-around-revert)
;;; test-dev-fkeys--projectile-around-revert.el ends here
diff --git a/tests/test-dev-fkeys--projectile-capture-cmd.el b/tests/test-dev-fkeys--projectile-capture-cmd.el
index 92309198..bc4c7684 100644
--- a/tests/test-dev-fkeys--projectile-capture-cmd.el
+++ b/tests/test-dev-fkeys--projectile-capture-cmd.el
@@ -2,9 +2,9 @@
;;; Commentary:
;; Tests for the prior-cmd capture helper used by the auto-revert advice.
-;; Captures the current cached cmd at the project root into
-;; `cj/--projectile-revert-state' so a later finish-hook can restore it
-;; if the compile fails after the cmd was modified.
+;; Captures the current cached cmd at the project root into a plist so a
+;; later finish-hook can restore it if the compile fails after the cmd was
+;; modified.
;;; Code:
@@ -24,25 +24,29 @@
(ert-deftest test-dev-fkeys-projectile-capture-cmd-stores-prior-value ()
"Normal: captures the cached cmd at the project root into the state plist."
(let* ((cj/--projectile-revert-state nil)
- (projectile-compile-cmd-map (make-hash-table :test 'equal)))
+ (projectile-compile-cmd-map (make-hash-table :test 'equal))
+ state)
(puthash "/p/" "make build" projectile-compile-cmd-map)
(cl-letf (((symbol-function 'cj/--f4-project-root) (lambda () "/p/")))
- (cj/--projectile-capture-cmd 'projectile-compile-cmd-map))
- (should (equal (plist-get cj/--projectile-revert-state :map)
+ (setq state (cj/--projectile-capture-cmd 'projectile-compile-cmd-map)))
+ (should (equal (plist-get state :map)
'projectile-compile-cmd-map))
- (should (equal (plist-get cj/--projectile-revert-state :root) "/p/"))
- (should (equal (plist-get cj/--projectile-revert-state :prior) "make build"))))
+ (should (equal (plist-get state :root) "/p/"))
+ (should (equal (plist-get state :prior) "make build"))
+ (should (null cj/--projectile-revert-state))))
(ert-deftest test-dev-fkeys-projectile-capture-cmd-no-prior-stores-nil ()
"Normal: when no cmd is cached, captures :prior nil — distinct from
\"didn't capture at all\" because :map and :root are still set."
(let* ((cj/--projectile-revert-state nil)
- (projectile-test-cmd-map (make-hash-table :test 'equal)))
+ (projectile-test-cmd-map (make-hash-table :test 'equal))
+ state)
(cl-letf (((symbol-function 'cj/--f4-project-root) (lambda () "/p/")))
- (cj/--projectile-capture-cmd 'projectile-test-cmd-map))
- (should (eq (plist-get cj/--projectile-revert-state :map)
+ (setq state (cj/--projectile-capture-cmd 'projectile-test-cmd-map)))
+ (should (eq (plist-get state :map)
'projectile-test-cmd-map))
- (should (null (plist-get cj/--projectile-revert-state :prior)))))
+ (should (null (plist-get state :prior)))
+ (should (null cj/--projectile-revert-state))))
;;; Boundary Cases