;;; test-pearl-refresh.el --- Tests for single-issue refresh -*- 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 `pearl-refresh-current-issue' and its helpers: the single ;; issue fetch (stubbed at the HTTP boundary), the in-place subtree replace, ;; and the per-subtree conflict guard that refuses to clobber unpushed local ;; description edits. ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) (require 'testutil-request (expand-file-name "testutil-request.el")) (require 'cl-lib) (defmacro test-pearl--in-org (content &rest body) "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." (declare (indent 1)) `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) (with-temp-buffer (insert ,content) (org-mode) (goto-char (point-min)) ,@body))) (defconst test-pearl--refresh-raw '((id . "a") (identifier . "ENG-1") (title . "Refreshed Title") (description . "New remote desc.") (priority . 2) (url . "https://linear.app/x/ENG-1") (updatedAt . "2026-05-23T03:00:00.000Z") (state (id . "s1") (name . "In Progress") (type . "started")) (assignee (id . "u1") (name . "Craig") (displayName . "craig") (email . "c@x")) (team (id . "t1") (key . "ENG") (name . "Engineering")) (project (id . "p1") (name . "Proj")) (labels (nodes . [((id . "l1") (name . "bug"))])) (cycle (id . "c1") (number . 3) (name . "Cycle 3"))) "A raw issue node as Linear would return it for a single-issue fetch.") (defun test-pearl--clean-entry () "An issue entry whose empty body matches its stored hash (no local edit)." (format "*** TODO [#B] Stale Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-IDENTIFIER: ENG-1\n:LINEAR-DESC-SHA256: %s\n:END:\n" (secure-hash 'sha256 ""))) ;;; --fetch-issue-async (ert-deftest test-pearl-fetch-issue-returns-raw-node () "The single-issue fetch hands its callback the raw issue node." (testutil-linear-with-response `((data (issue . ,test-pearl--refresh-raw))) (let (result) (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) (should (string= "Refreshed Title" (cdr (assoc 'title result))))))) (ert-deftest test-pearl-fetch-issue-missing-yields-missing () "A successful response with a null issue node yields `:missing'." (testutil-linear-with-response '((data (issue . nil))) (let ((result 'untouched)) (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) (should (eq :missing result))))) (ert-deftest test-pearl-fetch-issue-graphql-error-yields-error () "A GraphQL error response yields `:error', distinct from a missing issue." (testutil-linear-with-response '((errors . [((message . "boom"))]) (data . nil)) (let ((result 'untouched)) (pearl--fetch-issue-async "a" (lambda (r) (setq result r))) (should (eq :error result))))) ;;; refresh-current-issue (ert-deftest test-pearl-refresh-replaces-subtree-from-remote () "A clean refresh rewrites the subtree from the fetched issue." (test-pearl--in-org (test-pearl--clean-entry) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb test-pearl--refresh-raw)))) (re-search-forward "Stale Title") (pearl-refresh-current-issue) (goto-char (point-min)) (re-search-forward "^\\*\\* ") ;; heading + drawer reflect the remote (should (string-match-p "Refreshed Title" (thing-at-point 'line t))) (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))) ;; body is the remote description, and provenance matches it (should (string= "New remote desc." (pearl--issue-body-at-point))) (should (string= (secure-hash 'sha256 "New remote desc.") (org-entry-get nil "LINEAR-DESC-SHA256")))))) (ert-deftest test-pearl-refresh-stashes-then-replaces-when-body-edited () "An unpushed local edit is stashed before the refresh overwrites it (decision 4)." (let ((kill-ring nil)) (test-pearl--in-org (format "*** TODO [#B] Stale Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: %s\n:END:\nLocal edit not yet pushed.\n" (secure-hash 'sha256 "")) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb test-pearl--refresh-raw)))) (pearl-refresh-current-issue) ;; the unpushed edit was stashed before the overwrite, not lost (should (string-match-p "Local edit not yet pushed\\." (current-kill 0))) ;; and the refresh proceeded, replacing the subtree with the remote (goto-char (point-min)) (should (re-search-forward "Refreshed Title" nil t)) (goto-char (point-min)) (should-not (re-search-forward "Local edit not yet pushed\\." nil t)))))) (ert-deftest test-pearl-refresh-handles-fetch-error () "A fetch error leaves the subtree untouched." (test-pearl--in-org (test-pearl--clean-entry) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb :error)))) (pearl-refresh-current-issue) (goto-char (point-min)) (should (re-search-forward "Stale Title" nil t))))) (ert-deftest test-pearl-refresh-handles-missing-issue () "A missing issue leaves the subtree untouched." (test-pearl--in-org (test-pearl--clean-entry) (cl-letf (((symbol-function 'pearl--fetch-issue-async) (lambda (_id cb) (funcall cb :missing)))) (pearl-refresh-current-issue) (goto-char (point-min)) (should (re-search-forward "Stale Title" nil t))))) (ert-deftest test-pearl-refresh-not-on-issue-errors () "Refreshing outside a Linear issue heading signals a user error." (test-pearl--in-org "* Plain heading\nno id\n" (should-error (pearl-refresh-current-issue) :type 'user-error))) (provide 'test-pearl-refresh) ;;; test-pearl-refresh.el ends here