diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-pearl-conflict.el | 2 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 324 |
2 files changed, 324 insertions, 2 deletions
diff --git a/tests/test-pearl-conflict.el b/tests/test-pearl-conflict.el index 03d8f31..138e622 100644 --- a/tests/test-pearl-conflict.el +++ b/tests/test-pearl-conflict.el @@ -212,7 +212,7 @@ (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'rewrite)) ;; Emulate the user resolving the buffer and committing. ((symbol-function 'pearl--resolve-conflict-in-smerge) - (lambda (_label _local _remote on-finish) + (lambda (_label _local _remote on-finish &optional _on-abort) (funcall on-finish "merged text")))) (pearl--resolve-conflict "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" diff --git a/tests/test-pearl-save.el b/tests/test-pearl-save.el index 24db264..802535b 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -27,6 +27,7 @@ ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) (defun test-pearl-save--issue () "A normalized issue with a description and one own comment (author-id u-craig)." @@ -38,8 +39,13 @@ (defmacro test-pearl-save--in-rendered (issue &rest body) "Render ISSUE into an org buffer, then run BODY with point at the start." (declare (indent 1)) + ;; `org-element-use-cache' nil: these tests do raw `insert' surgery and then + ;; `org-entry-put', which in batch makes the cache reconcile pathologically + ;; (seconds per call). Disabling it keeps the suite fast and deterministic; + ;; production never touches this binding. `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO"))) - (pearl-comment-sort-order 'newest-first)) + (pearl-comment-sort-order 'newest-first) + (org-element-use-cache nil)) (with-temp-buffer (insert (pearl--format-issue-as-org-entry ,issue)) (org-mode) @@ -119,5 +125,321 @@ (should (equal '("c2" "c3") (mapcar (lambda (c) (plist-get c :comment-id)) (plist-get r :read-only)))))) +;;; --run-field-save (the per-field save engine) + +(cl-defun test-pearl-save--engine (&key local stored remote (push-success t) resolution) + "Run `pearl--run-field-save' over a synthetic spec; return a results plist. +LOCAL/STORED/REMOTE drive the gate; PUSH-SUCCESS the update result; RESOLUTION +the conflict choice (stubbed). Returns (:outcome :fetched :pushed :applied +:hash) where :pushed / :applied are the texts handed to the stub closures and +:hash is the provenance property after the run." + (with-temp-buffer + (org-mode) + (insert "* Issue\n:PROPERTIES:\n:LINEAR-TEST-SHA256: " (or stored "") "\n:END:\nbody\n") + (goto-char (point-min)) + (let* ((marker (point-marker)) + (fetched 0) (pushed nil) (applied nil) outcome + (spec (list :issue-id "u" :identifier "ENG-1" :field 'description + :comment-id nil :marker marker :prop "LINEAR-TEST-SHA256" + :local local :stored stored :label "ENG-1 description" + :fetch (lambda (cb) (cl-incf fetched) (funcall cb remote)) + :push (lambda (text cb) + (push text pushed) + (funcall cb (list :success push-success))) + :apply (lambda (text) (push text applied))))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) + (lambda (_l) resolution))) + (pearl--run-field-save spec (lambda (o) (setq outcome o)))) + (list :outcome outcome :fetched fetched + :pushed (nreverse pushed) :applied (nreverse applied) + :hash (org-entry-get marker "LINEAR-TEST-SHA256"))))) + +(ert-deftest test-pearl-engine-unchanged-skips-fetch () + "Local equals the stored hash: `unchanged', and no fetch fires." + (let* ((local "same text") + (r (test-pearl-save--engine :local local :stored (secure-hash 'sha256 local)))) + (should (eq 'unchanged (plist-get (plist-get r :outcome) :status))) + (should (= 0 (plist-get r :fetched))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-clean-push-advances-hash () + "Local edited, remote still at baseline: `pushed' and the hash advances." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") :remote "baseline"))) + (should (eq 'pushed (plist-get (plist-get r :outcome) :status))) + (should (= 1 (plist-get r :fetched))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= (secure-hash 'sha256 "edited") (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-converged-is-unchanged () + "Local moved off the baseline but remote already matches it: `unchanged', no push." + (let ((r (test-pearl-save--engine + :local "new text" :stored (secure-hash 'sha256 "baseline") :remote "new text"))) + (should (eq 'unchanged (plist-get (plist-get r :outcome) :status))) + (should (= 1 (plist-get r :fetched))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-fetch-failure () + "A nil remote (fetch failed) reports `failed'/`fetch-failed', no push." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") :remote nil))) + (should (eq 'failed (plist-get (plist-get r :outcome) :status))) + (should (eq 'fetch-failed (plist-get (plist-get r :outcome) :reason))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-push-failure-keeps-hash () + "A failed push reports `failed'/`push-failed' and leaves the hash untouched." + (let* ((stored (secure-hash 'sha256 "baseline")) + (r (test-pearl-save--engine + :local "edited" :stored stored :remote "baseline" :push-success nil))) + (should (eq 'failed (plist-get (plist-get r :outcome) :status))) + (should (eq 'push-failed (plist-get (plist-get r :outcome) :reason))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= stored (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-cancel () + "Cancelling a conflict reports `conflict'/`cancelled', no push, hash intact." + (let* ((stored (secure-hash 'sha256 "baseline")) + (r (test-pearl-save--engine + :local "edited" :stored stored :remote "remote changed" :resolution 'cancel))) + (should (eq 'conflict (plist-get (plist-get r :outcome) :status))) + (should (eq 'cancelled (plist-get (plist-get r :outcome) :reason))) + (should-not (plist-get r :pushed)) + (should (string= stored (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-use-local () + "Use-local pushes the local text and advances the hash to it." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") + :remote "remote changed" :resolution 'use-local))) + (should (eq 'pushed (plist-get (plist-get r :outcome) :status))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= (secure-hash 'sha256 "edited") (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-use-remote () + "Use-remote applies the remote, advances the hash, and does not push." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") + :remote "remote changed" :resolution 'use-remote))) + (should (eq 'resolved-remote (plist-get (plist-get r :outcome) :status))) + (should-not (plist-get r :pushed)) + (should (equal '("remote changed") (plist-get r :applied))) + (should (string= (secure-hash 'sha256 "remote changed") (plist-get r :hash))))) + +;;; --save-description-field (advances both provenance hashes) + +(ert-deftest test-pearl-save-description-advances-both-hashes () + "A description push advances both the markdown and the Org provenance hashes, +so the next local dirty scan (which uses the Org hash) sees the ticket as clean." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (org-back-to-heading t) + (let ((marker (point-marker)) outcome) + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) + (funcall cb (list :description "Original description." :updated-at "t0")))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (_id _md cb) (funcall cb '(:success t :updated-at "t1"))))) + (pearl--save-description-field marker (lambda (o) (setq outcome o)))) + (should (eq 'pushed (plist-get outcome :status))) + (org-with-point-at marker + (should (string= (secure-hash 'sha256 (pearl--issue-body-at-point)) + (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) + (should (string= (secure-hash 'sha256 (pearl--org-to-md (pearl--issue-body-at-point))) + (org-entry-get nil "LINEAR-DESC-SHA256"))) + ;; the push timestamp still lands via the after-push bookkeeping + (should (string= "t1" (org-entry-get nil "LINEAR-DESC-UPDATED-AT"))))))) + +;;; --run-save-queue (sequential runner) + +(ert-deftest test-pearl-save-queue-runs-in-order-collecting-outcomes () + "The queue runs thunks in order and hands the callback their outcomes in order." + (let ((order nil) (collected nil)) + (pearl--run-save-queue + (list (lambda (done) (push 'a order) (funcall done '(:status pushed :field a))) + (lambda (done) (push 'b order) (funcall done '(:status unchanged :field b))) + (lambda (done) (push 'c order) (funcall done '(:status skipped :field c)))) + (lambda (outcomes) (setq collected outcomes))) + (should (equal '(a b c) (nreverse order))) + (should (equal '(a b c) (mapcar (lambda (o) (plist-get o :field)) collected))))) + +(ert-deftest test-pearl-save-queue-waits-for-each-done () + "A thunk that defers its DONE blocks the next thunk until it fires." + (let ((started nil) (gate nil)) + (pearl--run-save-queue + (list (lambda (done) (push '1 started) (setq gate done)) ; defers + (lambda (done) (push '2 started) (funcall done '(:status pushed)))) + #'ignore) + ;; only the first thunk has started; the second waits on the deferred done + (should (equal '(1) started)) + (funcall gate '(:status pushed)) + (should (equal '(1 2) (nreverse started))))) + +(ert-deftest test-pearl-save-queue-empty-calls-back-empty () + "An empty queue calls back immediately with no outcomes." + (let ((called 'no)) + (pearl--run-save-queue nil (lambda (o) (setq called o))) + (should (null called)))) + +;;; pearl-save-issue (HTTP stubbed) + +(defmacro test-pearl-save--with-net (&rest body) + "Run BODY with the four issue network helpers stubbed to record calls. +Binds dynamic spies `title-pushes' / `desc-pushes' / `fetched' (lists/flags)." + (declare (indent 0)) + `(let ((title-pushes nil) (desc-pushes nil) (fetched nil)) + (cl-letf (((symbol-function 'pearl--update-issue-title-async) + (lambda (_id text cb) (push text title-pushes) + (funcall cb '(:success t :updated-at "t")))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (_id text cb) (push text desc-pushes) + (funcall cb '(:success t :updated-at "t"))))) + ,@body))) + +(ert-deftest test-pearl-save-issue-clean-makes-no-network-calls () + "A freshly rendered issue with no edits saves nothing and fetches nothing." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description") + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (&rest _) (setq fetched t))) + ((symbol-function 'pearl--fetch-issue-title-async) + (lambda (&rest _) (setq fetched t)))) + (pearl-save-issue) + (should-not fetched) + (should-not title-pushes) + (should-not desc-pushes))))) + +(ert-deftest test-pearl-save-issue-pushes-edited-description () + "An edited description is fetched, found clean-against-remote, and pushed." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Original description." :updated-at "t0"))))) + (pearl-save-issue) + (should (= 1 (length desc-pushes))) + (should-not title-pushes))))) + +(ert-deftest test-pearl-save-issue-conflict-on-one-field-still-saves-the-other () + "Title pushes cleanly while the description conflicts (cancelled); the +description hash is left untouched and the title still saved." + (test-pearl-save--in-rendered (test-pearl-save--issue) + ;; edit both the title and the description + (re-search-forward "Fix the Bug") + (org-back-to-heading t) + (org-edit-headline "ENG-1: Fix the Cache Bug") + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (let ((desc-hash-before + (save-excursion (org-back-to-heading t) + (org-entry-get nil "LINEAR-DESC-SHA256")))) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-title-async) + ;; remote title unchanged -> clean push + (lambda (_id cb) (funcall cb '(:title "Fix the Bug" :updated-at "t0")))) + ((symbol-function 'pearl--fetch-issue-description-async) + ;; remote description drifted -> conflict + (lambda (_id cb) (funcall cb '(:description "Remote moved on." :updated-at "t1")))) + ((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (pearl-save-issue) + (should (= 1 (length title-pushes))) + (should-not desc-pushes) + ;; the description hash is untouched by the cancelled conflict + (should (string= desc-hash-before + (save-excursion (org-back-to-heading t) + (org-entry-get nil "LINEAR-DESC-SHA256"))))))))) + +;;; pearl-save-all (file-wide scan + confirm + batch) + +(defmacro test-pearl-save--in-two-issues (&rest body) + "Render two issues (ENG-1, ENG-2; bodies \"Body.\") and run BODY at point-min." + (declare (indent 0)) + `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO"))) + (pearl-comment-sort-order 'newest-first) + (org-element-use-cache nil)) + (with-temp-buffer + (insert (pearl--format-issue-as-org-entry + '(:id "u1" :identifier "ENG-1" :title "one" :priority 2 + :state (:name "Todo") :description "Body."))) + (insert (pearl--format-issue-as-org-entry + '(:id "u2" :identifier "ENG-2" :title "two" :priority 2 + :state (:name "Todo") :description "Body."))) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(ert-deftest test-pearl-save-all-clean-file-no-network-no-prompt () + "A clean file saves nothing, prompts nothing, and makes no network calls." + (test-pearl-save--in-two-issues + (let ((prompted nil) (fetched nil)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) (setq prompted t) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (&rest _) (setq fetched t)))) + (pearl-save-all) + (should-not prompted) + (should-not fetched) + (should-not desc-pushes)))))) + +(ert-deftest test-pearl-save-all-confirm-saves-across-issues () + "With edits in both issues, confirming saves each description in one pass." + (test-pearl-save--in-two-issues + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + (should (= 2 (length desc-pushes))))))) + +(ert-deftest test-pearl-save-all-decline-makes-no-mutation () + "Declining the confirmation prompt pushes nothing." + (test-pearl-save--in-two-issues + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + (should-not desc-pushes))))) + +(ert-deftest test-pearl-save-all-malformed-issue-does-not-abort-batch () + "A heading without a LINEAR-ID is skipped by the scan; valid edits still save." + (test-pearl-save--in-two-issues + ;; clobber the first issue's LINEAR-ID so it drops out of the marker scan + (save-excursion + (goto-char (point-min)) + (re-search-forward ":LINEAR-ID:") + (beginning-of-line) (kill-line) (insert ":LINEAR-NOPE: x")) + ;; edit both descriptions + (goto-char (point-min)) + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + ;; only the still-valid second issue saved + (should (= 1 (length desc-pushes))))))) + (provide 'test-pearl-save) ;;; test-pearl-save.el ends here |