diff options
| -rw-r--r-- | pearl.el | 21 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 31 |
2 files changed, 49 insertions, 3 deletions
@@ -3447,6 +3447,15 @@ Surface BUFFER when any field pushed. The shared close-out for (message "%s: %s" label (pearl--save-summary-message outcomes)) (when pushed (pearl--surface-buffer buffer)))) +(defun pearl--marker-live-p (marker) + "Non-nil if MARKER is nil, or points into a still-live buffer. +A nil MARKER (synthetic callers with no buffer) passes; a marker into a killed +buffer fails. Guards async commit callbacks that touch the buffer after a push +the buffer may not have survived." + (or (null marker) + (let ((buffer (marker-buffer marker))) + (and buffer (buffer-live-p buffer))))) + (defun pearl--run-atomic-field-save (spec callback) "Save one atomic (enum/relation) field per SPEC, calling CALLBACK once. SPEC keys: :issue-id :identifier :field :marker :label; :live and :baseline @@ -3467,11 +3476,15 @@ baseline is `unchanged'; otherwise the remote is fetched (`:error' -> (let* ((live (plist-get spec :live)) (baseline (plist-get spec :baseline)) (equal-fn (or (plist-get spec :equal) #'equal)) + (marker (plist-get spec :marker)) (push-then-commit (lambda (cb) (funcall (plist-get spec :push) (lambda (r) - (when (plist-get r :success) + ;; The push can land after the buffer was killed; only run + ;; the buffer-touching commit when it's still live, but + ;; still report the remote success either way. + (when (and (plist-get r :success) (pearl--marker-live-p marker)) (funcall (plist-get spec :commit-local))) (funcall cb (plist-get r :success))))))) (cond @@ -3487,7 +3500,8 @@ baseline is `unchanged'; otherwise the remote is fetched (`:error' -> ((eq remote :error) (funcall callback (pearl--save-outcome spec 'failed 'fetch-failed))) ((funcall equal-fn remote live) - (funcall (plist-get spec :commit-local)) + (when (pearl--marker-live-p marker) + (funcall (plist-get spec :commit-local))) (funcall callback (pearl--save-outcome spec 'unchanged nil))) ((funcall equal-fn remote baseline) (funcall push-then-commit @@ -3501,7 +3515,8 @@ baseline is `unchanged'; otherwise the remote is fetched (`:error' -> (plist-get spec :live-display) (funcall (plist-get spec :remote-display) remote) push-then-commit - (lambda () (funcall (plist-get spec :commit-remote) remote)) + (lambda () (when (pearl--marker-live-p marker) + (funcall (plist-get spec :commit-remote) remote))) (lambda (status reason) (funcall callback (pearl--save-outcome spec status reason)))))))))))) diff --git a/tests/test-pearl-save.el b/tests/test-pearl-save.el index 65f742a..8050e6d 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -375,6 +375,37 @@ the conflict choice (stubbed). Returns (:outcome :fetched :pushed :applied (should (eq 'failed (plist-get r :status))) (should (eq 'fetch-failed (plist-get r :reason))))) +(ert-deftest test-pearl-atomic-killed-buffer-no-signal () + "A push whose buffer is killed before the callback reports without touching it. +The commit advances the baseline via the marker; on a dead buffer it must be +skipped (the remote push already landed), not signal." + (let ((buf (generate-new-buffer "pearl-atomic-kill")) outcome committed) + (unwind-protect + (let (marker) + (with-current-buffer buf + (insert "* h\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n") + (org-mode) + (goto-char (point-min)) + (setq marker (point-marker))) + (pearl--run-atomic-field-save + (list :issue-id "u" :identifier "ENG-1" :field 'assignee :marker marker + :label "ENG-1 assignee" :live "b" :baseline "a" :equal #'string= + :live-display "b" :remote-display (lambda (_) "a") + ;; remote = baseline -> clean push; the fetch kills the buffer first + :fetch-remote (lambda (cb) (kill-buffer buf) (funcall cb "a")) + :push (lambda (cb) (funcall cb '(:success t))) + ;; touching the dead marker would signal without the guard + :commit-local (lambda () + (setq committed t) + (org-entry-put marker "X" "y")) + :commit-remote (lambda (_) nil)) + (lambda (o) (setq outcome o))) + (should-not (buffer-live-p buf)) + ;; remote success is still reported; the local commit is skipped + (should (eq 'pushed (plist-get outcome :status))) + (should-not committed)) + (when (buffer-live-p buf) (kill-buffer buf))))) + ;;; --save-assignee-field (the relation saver, end to end) (ert-deftest test-pearl-save-assignee-clean-push-advances-baseline () |