;;; test-pearl-save.el --- Tests for the unified ticket save model -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Tests for the unified ticket save model (see ;; docs/ticket-save-model-spec.org). Phase 1: the local dirty scanners ;; (`pearl--issue-dirty-fields', `pearl--changed-comment-candidates') and the ;; viewer-based ownership classifier (`pearl--classify-comment-candidates'). ;;; 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)." '(:id "u" :identifier "ENG-1" :title "fix the bug" :priority 2 :state (:name "Todo") :description "Original description." :comments ((:id "c1" :author "Craig" :author-id "u-craig" :created-at "2026-05-24T00:00:00.000Z" :body "my comment")))) (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. ;; Title-case the rendered heading so these save-path tests can search for the ;; cased title; the save logic hashes the rendered form regardless of casing, ;; so the opt-in binding doesn't change what's under test. `(let ((pearl-comment-sort-order 'newest-first) (pearl-title-case-headings t) (org-element-use-cache nil)) (with-temp-buffer (insert (pearl--format-issue-as-org-entry ,issue)) (org-mode) (goto-char (point-min)) ,@body))) ;;; --issue-dirty-fields (Phase A, local) (ert-deftest test-pearl-dirty-fields-clean-issue () "A freshly rendered issue has no dirty fields and no comment candidates." (test-pearl-save--in-rendered (test-pearl-save--issue) (re-search-forward "Original description") (let ((d (pearl--issue-dirty-fields))) (should-not (plist-get d :title)) (should-not (plist-get d :description)) (should-not (plist-get d :comment-candidates))))) (ert-deftest test-pearl-dirty-fields-title-edit () "Editing the heading title (past the identifier prefix) marks the title dirty." (test-pearl-save--in-rendered (test-pearl-save--issue) (re-search-forward "Fix the Bug") (org-back-to-heading t) (org-edit-headline "ENG-1: Fix the Cache Bug") (let ((d (pearl--issue-dirty-fields))) (should (plist-get d :title)) (should-not (plist-get d :description))))) (ert-deftest test-pearl-dirty-fields-description-edit () "Editing the body marks the description dirty, not the title." (test-pearl-save--in-rendered (test-pearl-save--issue) (re-search-forward "Original description\\.") (end-of-line) (insert " EDITED") (let ((d (pearl--issue-dirty-fields))) (should (plist-get d :description)) (should-not (plist-get d :title))))) (ert-deftest test-pearl-dirty-fields-lossy-description-stays-clean () "A description whose markdown is lossy under org->md is not falsely dirty (HP1)." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-2" :title "t" :priority 3 :state (:name "Todo") :description "# Heading\nbody text") (re-search-forward "body text") (should-not (plist-get (pearl--issue-dirty-fields) :description)))) (ert-deftest test-pearl-dirty-fields-comment-candidate () "An edited comment surfaces as a candidate carrying its id and author-id." (test-pearl-save--in-rendered (test-pearl-save--issue) ;; edit the comment body (re-search-forward "my comment") (end-of-line) (insert " edited") ;; scan from inside the issue body (not the comment) (goto-char (point-min)) (re-search-forward "Original description") (let ((cands (plist-get (pearl--issue-dirty-fields) :comment-candidates))) (should (= 1 (length cands))) (should (string= "c1" (plist-get (car cands) :comment-id))) (should (string= "u-craig" (plist-get (car cands) :author-id)))))) (ert-deftest test-pearl-dirty-fields-unedited-comment-no-candidate () "An unedited comment is not a candidate." (test-pearl-save--in-rendered (test-pearl-save--issue) (re-search-forward "Original description") (should-not (plist-get (pearl--issue-dirty-fields) :comment-candidates)))) ;;; --issue-dirty-fields: structured fields (save-model v2) (defun test-pearl-save--structured-issue () "A normalized issue with state id, assignee, and labels (for structured dirty)." '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :assignee (:id "a1" :name "Craig") :labels ((:id "l1" :name "bug") (:id "l2" :name "backend")) :description "body")) (ert-deftest test-pearl-dirty-fields-structured-clean () "A freshly rendered issue has no dirty structured fields." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (let ((d (pearl--issue-dirty-fields))) (should-not (plist-get d :priority)) (should-not (plist-get d :state)) (should-not (plist-get d :assignee)) (should-not (plist-get d :labels))))) (ert-deftest test-pearl-dirty-fields-priority-cookie-change () "Changing the priority cookie marks priority dirty vs LINEAR-PRIORITY." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (let ((org-priority-highest ?A) (org-priority-lowest ?D)) (org-priority ?C)) ; was [#B] (2); now [#C] (3) (should (plist-get (pearl--issue-dirty-fields) :priority)))) (ert-deftest test-pearl-dirty-fields-priority-none-not-dirty () "A None-priority issue renders no cookie and is not falsely dirty." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-2" :title "t" :priority 0 :state (:id "s1" :name "Todo") :description "body") (should-not (plist-get (pearl--issue-dirty-fields) :priority)))) (ert-deftest test-pearl-dirty-fields-state-picker-change () "An explicit state id different from the synced baseline marks state dirty." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (org-entry-put nil "LINEAR-STATE-ID" "s2") (should (plist-get (pearl--issue-dirty-fields) :state)))) (ert-deftest test-pearl-dirty-fields-state-keyword-cycle () "Cycling the TODO keyword away from the synced state-name slug marks state dirty, even when the explicit state id still matches its baseline." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (let ((org-after-todo-state-change-hook nil)) (org-todo "DONE")) ; TODO -> DONE, id untouched (should (plist-get (pearl--issue-dirty-fields) :state)))) (ert-deftest test-pearl-dirty-fields-state-fresh-keyword-not-dirty () "A freshly rendered state (keyword equals the state-name slug) is not state dirty." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (should-not (plist-get (pearl--issue-dirty-fields) :state)))) (ert-deftest test-pearl-dirty-fields-assignee-change () "An assignee id different from the synced baseline marks assignee dirty." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (org-entry-put nil "LINEAR-ASSIGNEE-ID" "a2") (should (plist-get (pearl--issue-dirty-fields) :assignee)))) (ert-deftest test-pearl-dirty-fields-labels-change () "A label id set different from the synced baseline marks labels dirty." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (org-entry-put nil "LINEAR-LABEL-IDS" "l2 l3") (should (plist-get (pearl--issue-dirty-fields) :labels)))) (ert-deftest test-pearl-dirty-fields-labels-reorder-not-dirty () "Reordering the same label ids is not dirty (order-insensitive set compare)." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) (org-back-to-heading t) (org-entry-put nil "LINEAR-LABEL-IDS" "l2 l1") (should-not (plist-get (pearl--issue-dirty-fields) :labels)))) ;;; --classify-comment-candidates (Phase B, by viewer id) (ert-deftest test-pearl-classify-comment-candidates () "Candidates split into own (author = viewer) and read-only (everyone else)." (let* ((cands '((:comment-id "c1" :author-id "u-craig") (:comment-id "c2" :author-id "u-other") (:comment-id "c3" :author-id ""))) ; bot/external: not own (r (pearl--classify-comment-candidates cands "u-craig"))) (should (equal '("c1") (mapcar (lambda (c) (plist-get c :comment-id)) (plist-get r :own)))) (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))))) (ert-deftest test-pearl-save-field-push-killed-buffer-no-signal () "A text-field push whose buffer is killed before the success callback does not signal. The hash-advance and :after-push touch the marker; on a dead buffer they must be skipped, with the remote push still reported as pushed." (let ((buf (generate-new-buffer "pearl-field-push-kill")) outcome after-ran) (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--save-field-push (list :issue-id "u" :identifier "ENG-1" :field 'title :marker marker :prop "LINEAR-TITLE-SHA256" :label "ENG-1 title" ;; the push kills the buffer, then reports success :push (lambda (_text cb) (kill-buffer buf) (funcall cb '(:success t))) ;; touching the dead marker would signal without the guard :after-push (lambda (_r m) (setq after-ran t) (org-entry-put m "X" "y"))) "new text" (lambda (o) (setq outcome o))) (should-not (buffer-live-p buf)) (should (eq 'pushed (plist-get outcome :status))) (should-not after-ran)) (when (buffer-live-p buf) (kill-buffer buf))))) ;;; --run-atomic-field-save (the per-field engine for enum/relation fields) (cl-defun test-pearl-save--atomic (&key live baseline remote (push-success t) resolution) "Drive `pearl--run-atomic-field-save' over a synthetic spec; return a results plist." (let (outcome pushed committed-local committed-remote) (cl-letf (((symbol-function 'pearl--read-atomic-conflict-resolution) (lambda (_) resolution))) (pearl--run-atomic-field-save (list :issue-id "u" :identifier "ENG-1" :field 'assignee :marker nil :label "ENG-1 assignee" :live live :baseline baseline :equal #'string= :live-display (format "L:%s" live) :remote-display (lambda (r) (format "R:%s" r)) :fetch-remote (lambda (cb) (funcall cb remote)) :push (lambda (cb) (setq pushed t) (funcall cb (list :success push-success))) :commit-local (lambda () (setq committed-local t)) :commit-remote (lambda (r) (setq committed-remote r))) (lambda (o) (setq outcome o)))) (list :status (plist-get outcome :status) :reason (plist-get outcome :reason) :pushed pushed :local committed-local :remote committed-remote))) (ert-deftest test-pearl-atomic-missing-baseline-skips () "A nil baseline (legacy file) is skipped with missing-property, no fetch." (let ((r (test-pearl-save--atomic :live "b" :baseline nil :remote "x"))) (should (eq 'skipped (plist-get r :status))) (should (eq 'missing-property (plist-get r :reason))) (should-not (plist-get r :pushed)))) (ert-deftest test-pearl-atomic-live-equals-baseline-unchanged () "Live equal to baseline is unchanged (defensive; the scan shouldn't queue it)." (let ((r (test-pearl-save--atomic :live "a" :baseline "a" :remote "x"))) (should (eq 'unchanged (plist-get r :status))) (should-not (plist-get r :pushed)))) (ert-deftest test-pearl-atomic-remote-converged-advances-no-push () "Remote already equal to live converges: advance baseline, unchanged, no push." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "b"))) (should (eq 'unchanged (plist-get r :status))) (should (plist-get r :local)) (should-not (plist-get r :pushed)))) (ert-deftest test-pearl-atomic-clean-push () "Remote unmoved from baseline: clean push, baseline advances to live." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "a"))) (should (eq 'pushed (plist-get r :status))) (should (plist-get r :pushed)) (should (plist-get r :local)))) (ert-deftest test-pearl-atomic-clean-push-failure () "A failed clean push reports failed/push-failed and does not advance baseline." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "a" :push-success nil))) (should (eq 'failed (plist-get r :status))) (should (eq 'push-failed (plist-get r :reason))) (should-not (plist-get r :local)))) (ert-deftest test-pearl-atomic-conflict-use-local () "Remote moved differently: use-local pushes and advances." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" :resolution 'use-local))) (should (eq 'pushed (plist-get r :status))) (should (plist-get r :pushed)) (should (plist-get r :local)))) (ert-deftest test-pearl-atomic-conflict-use-remote () "Use-remote adopts the remote value, never pushes, reports resolved-remote." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" :resolution 'use-remote))) (should (eq 'resolved-remote (plist-get r :status))) (should-not (plist-get r :pushed)) (should (string= "c" (plist-get r :remote))))) (ert-deftest test-pearl-atomic-conflict-cancel () "Cancel leaves the field in conflict, pushes and commits nothing." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" :resolution 'cancel))) (should (eq 'conflict (plist-get r :status))) (should (eq 'cancelled (plist-get r :reason))) (should-not (plist-get r :pushed)) (should-not (plist-get r :local)) (should-not (plist-get r :remote)))) (ert-deftest test-pearl-atomic-fetch-failure () "A remote fetch error reports failed/fetch-failed." (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote :error))) (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 () "A picker-changed assignee with an unmoved remote pushes and advances the baseline." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :assignee (:id "a1" :name "Craig") :description "body") (org-back-to-heading t) (org-entry-put nil "LINEAR-ASSIGNEE-ID" "a2") ; the picker chose a new assignee (let ((marker (point-marker)) outcome (pushed nil)) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((assignee (id . "a1") (name . "Craig")))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed (cdr (assoc "assigneeId" input))) (funcall cb '(:success t))))) (pearl--save-assignee-field marker (lambda (o) (setq outcome o))) (should (eq 'pushed (plist-get outcome :status))) (should (string= "a2" pushed)) (should (string= "a2" (org-entry-get marker "LINEAR-ASSIGNEE-ID-SYNCED"))))))) ;;; --save-priority-field / --save-state-field / --save-labels-field (ert-deftest test-pearl-save-priority-clean-push-advances-baseline () "A cookie-changed priority with an unmoved remote pushes and advances LINEAR-PRIORITY." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :description "body") (org-back-to-heading t) (let ((org-priority-highest ?A) (org-priority-lowest ?D)) (org-priority ?C)) ; [#B] (2) -> [#C] (3) (let ((marker (point-marker)) outcome pushed) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((priority . 2))))) ; remote unmoved ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed (cdr (assoc "priority" input))) (funcall cb '(:success t))))) (pearl--save-priority-field marker (lambda (o) (setq outcome o))) (should (eq 'pushed (plist-get outcome :status))) (should (eql 3 pushed)) (should (string= "3" (org-entry-get marker "LINEAR-PRIORITY"))))))) (ert-deftest test-pearl-save-state-picker-clean-push-advances-baseline () "A picker-changed state with an unmoved remote pushes stateId and advances the baseline." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :description "body") (org-back-to-heading t) (org-entry-put nil "LINEAR-STATE-ID" "s2") ; the picker chose another state (let ((marker (point-marker)) outcome pushed) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((state (id . "s1") (name . "Todo")))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed (cdr (assoc "stateId" input))) (funcall cb '(:success t))))) (pearl--save-state-field marker (lambda (o) (setq outcome o))) (should (eq 'pushed (plist-get outcome :status))) (should (string= "s2" pushed)) (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID-SYNCED"))))))) (ert-deftest test-pearl-save-state-keyword-cycle-resolves-and-pushes () "A keyword-cycled state (id unmoved) resolves the keyword to its team state id by slug match, pushes that id, and writes the resolved name/id/baseline." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :description "body") (goto-char (point-min)) (insert "#+TODO: TODO IN-PROGRESS | DONE\n") (org-mode) ; re-init so the keywords take (goto-char (point-min)) (re-search-forward "ENG-1") (org-back-to-heading t) (org-entry-put nil "LINEAR-TEAM-ID" "team-1") (progn (let ((org-after-todo-state-change-hook nil)) (org-todo "IN-PROGRESS")) ; cycle keyword, leave id = s1 (let ((marker (point-marker)) outcome pushed) (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0)) ((id . "s2") (name . "In Progress") (type . "started") (position . 2.0))))) ((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((state (id . "s1") (name . "Todo")))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed (cdr (assoc "stateId" input))) (funcall cb '(:success t))))) (pearl--save-state-field marker (lambda (o) (setq outcome o))) (should (eq 'pushed (plist-get outcome :status))) (should (string= "s2" pushed)) (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID"))) (should (string= "In Progress" (org-entry-get marker "LINEAR-STATE-NAME"))) (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID-SYNCED")))))))) (ert-deftest test-pearl-save-state-keyword-cycle-unknown-keyword-skips () "A keyword no team state slugifies to cannot be resolved, so the save is skipped with no push." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :description "body") (goto-char (point-min)) (insert "#+TODO: TODO BLOCKED | DONE\n") (org-mode) (goto-char (point-min)) (re-search-forward "ENG-1") (org-back-to-heading t) (org-entry-put nil "LINEAR-TEAM-ID" "team-1") (progn (let ((org-after-todo-state-change-hook nil)) (org-todo "BLOCKED")) ; no team state slugifies to BLOCKED (let ((marker (point-marker)) outcome (pushed :none)) (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id _input cb) (setq pushed :called) (funcall cb '(:success t))))) (pearl--save-state-field marker (lambda (o) (setq outcome o))) (should (eq 'skipped (plist-get outcome :status))) (should (eq :none pushed))))))) (ert-deftest test-pearl-save-labels-clean-push-advances-baseline () "A changed label set with an unmoved remote pushes labelIds and advances the baseline." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :labels ((:id "l1" :name "bug") (:id "l2" :name "backend")) :description "body") (org-back-to-heading t) (org-entry-put nil "LINEAR-LABEL-IDS" "l1 l3") ; dropped l2, added l3 (let ((marker (point-marker)) outcome pushed) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((labels (nodes ((id . "l1") (name . "bug")) ((id . "l2") (name . "backend")))))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed (cdr (assoc "labelIds" input))) (funcall cb '(:success t))))) (pearl--save-labels-field marker (lambda (o) (setq outcome o))) (should (eq 'pushed (plist-get outcome :status))) (should (equal ["l1" "l3"] pushed)) (should (string= "l1 l3" (org-entry-get marker "LINEAR-LABEL-IDS-SYNCED"))))))) ;;; --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 issue 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--entry-body-at-point)) (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) (should (string= (secure-hash 'sha256 (pearl--org-to-md (pearl--entry-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-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 'pearl--read-yes-no) (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 'pearl--read-yes-no) (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 'pearl--read-yes-no) (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 'pearl--read-yes-no) (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))))))) ;;; structured fields wired into save-issue / save-all (save-model v2) (ert-deftest test-pearl-save-issue-routes-dirty-structured-field () "save-issue picks up a dirty structured field (assignee) and pushes it." (test-pearl-save--in-rendered '(:id "u" :identifier "ENG-1" :title "t" :priority 2 :state (:id "s1" :name "Todo") :assignee (:id "a1" :name "Craig") :description "body") (org-back-to-heading t) (org-entry-put nil "LINEAR-ASSIGNEE-ID" "a2") ; the picker chose a new assignee (let (pushed-input) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb '((assignee (id . "a1") (name . "Craig")))))) ((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed-input input) (funcall cb '(:success t))))) (pearl-save-issue) (should (string= "a2" (cdr (assoc "assigneeId" pushed-input)))) (should (string= "a2" (org-entry-get nil "LINEAR-ASSIGNEE-ID-SYNCED"))))))) (ert-deftest test-pearl-save-all-counts-and-prompt-structured-fields () "save-all tallies and names priority / state / assignee / labels in the prompt." (let* ((scan (list (cons (make-marker) '(:priority t)) (cons (make-marker) '(:state t :labels t :assignee t)))) (counts (pearl--save-all-counts scan nil))) (should (= 2 (plist-get counts :issues))) (should (= 1 (plist-get counts :priorities))) (should (= 1 (plist-get counts :states))) (should (= 1 (plist-get counts :assignees))) (should (= 1 (plist-get counts :labels))) (let ((prompt (pearl--save-all-prompt counts))) (should (string-match-p "1 priority" prompt)) (should (string-match-p "1 state" prompt)) (should (string-match-p "1 assignee" prompt)) (should (string-match-p "1 label" prompt)) (should (string-match-p "Save 4 fields across 2 issues" prompt))))) (provide 'test-pearl-save) ;;; test-pearl-save.el ends here