1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
;;; test-pearl-refresh.el --- Tests for single-issue refresh -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Craig Jennings
;; Author: Craig Jennings <c@cjennings.net>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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
|
