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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
;;; test-pearl-merge.el --- Tests for merge-by-LINEAR-ID 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 the same-source refresh merge: `pearl--merge-issues-into-buffer'
;; updates existing issue subtrees in place by LINEAR-ID, appends new matches,
;; drops issues gone from the result, and protects unpushed local edits (it
;; neither overwrites nor drops a subtree whose body diverges from its stored
;; provenance hash). Also covers the header refresh and the `--merge-query-result'
;; render boundary that drives `pearl-refresh-current-view'.
;;; 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-merge--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)))
(defun test-pearl-merge--issue (id title desc)
"A normalized issue plist with ID, TITLE, and DESC for merge input."
(list :id id :identifier (concat "ENG-" id) :title title :description desc
:priority 2 :url (concat "https://linear.app/x/" id)
:updated-at "2026-05-23T03:00:00.000Z"
:state (list :id "s1" :name "Todo" :type "unstarted")
:team (list :id "t1" :key "ENG" :name "Engineering")))
(defun test-pearl-merge--raw (id title desc)
"A raw issue node (json-read shape) with ID, TITLE, and DESC."
`((id . ,id) (identifier . ,(concat "ENG-" id)) (title . ,title)
(description . ,desc) (priority . 2) (url . ,(concat "https://linear.app/x/" id))
(updatedAt . "2026-05-23T03:00:00.000Z")
(state (id . "s1") (name . "Todo") (type . "unstarted"))
(team (id . "t1") (key . "ENG") (name . "Engineering"))
(labels (nodes . []))))
(defun test-pearl-merge--buffer (&rest issues)
"A header plus the formatted ISSUES, as the active file would hold them."
(concat "#+title: Linear — My open issues\n"
"#+LINEAR-SOURCE: (:type filter :name \"My open issues\" :filter (:assignee :me))\n"
"#+LINEAR-RUN-AT: 2026-05-01 09:00\n"
"#+LINEAR-COUNT: 9\n"
"#+LINEAR-TRUNCATED: no\n\n"
(mapconcat #'pearl--format-issue-as-org-entry issues "")))
;;; --merge-issues-into-buffer
(ert-deftest test-pearl-merge-updates-existing-in-place ()
"An existing issue still in the result is re-rendered from the fetch in place."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
(test-pearl-merge--issue "b" "Beta" "Desc Beta."))
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "a" "Alpha Renamed" "Desc Alpha.")
(test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
(should (= 2 (plist-get counts :updated)))
(should (= 0 (plist-get counts :added)))
(should (= 0 (plist-get counts :dropped)))
(should (= 0 (plist-get counts :skipped)))
(goto-char (point-min))
(should (re-search-forward "Alpha Renamed" nil t))
(should-not (save-excursion (re-search-forward "^\\*\\*\\* .*Alpha$" nil t)))
;; Alpha still precedes Beta — order is stable.
(goto-char (point-min))
(let ((a (progn (re-search-forward "Alpha Renamed") (point)))
(b (progn (re-search-forward "Beta") (point))))
(should (< a b))))))
(ert-deftest test-pearl-merge-appends-new-issue ()
"An issue new to the result is appended after the existing ones."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
(test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
(should (= 1 (plist-get counts :added)))
(goto-char (point-min))
(should (string= "a" (progn (re-search-forward "LINEAR-ID: *\\(.*\\)$") (match-string 1))))
(should (re-search-forward "LINEAR-ID: *b" nil t))
(goto-char (point-min))
(should (< (progn (re-search-forward "Alpha") (point))
(progn (re-search-forward "Beta") (point)))))))
(ert-deftest test-pearl-merge-drops-absent-issue ()
"A clean issue no longer in the result is dropped."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
(test-pearl-merge--issue "b" "Beta" "Desc Beta."))
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")))))
(should (= 1 (plist-get counts :dropped)))
(goto-char (point-min))
(should (re-search-forward "Alpha" nil t))
(goto-char (point-min))
(should-not (re-search-forward "Beta" nil t)))))
(ert-deftest test-pearl-merge-keeps-unpushed-edit-on-update ()
"An existing subtree with unpushed body edits is kept, not overwritten."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
;; Dirty the body so its hash no longer matches the stored provenance.
(goto-char (point-min))
(re-search-forward "Desc Alpha\\.")
(end-of-line)
(insert " UNPUSHED EDIT")
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "a" "Alpha Renamed" "Remote desc.")))))
(should (= 1 (plist-get counts :skipped)))
(should (= 0 (plist-get counts :updated)))
(goto-char (point-min))
;; Local edit and old heading survive; the remote rename did not land.
(should (re-search-forward "UNPUSHED EDIT" nil t))
(goto-char (point-min))
(should-not (re-search-forward "Alpha Renamed" nil t)))))
(ert-deftest test-pearl-merge-keeps-dirty-issue-absent-from-result ()
"A dirty issue gone from the result is kept rather than dropped (no data loss)."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
(test-pearl-merge--issue "b" "Beta" "Desc Beta."))
(goto-char (point-min))
(re-search-forward "Desc Alpha\\.")
(end-of-line)
(insert " UNPUSHED EDIT")
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
(should (= 1 (plist-get counts :skipped)))
(should (= 0 (plist-get counts :dropped)))
(goto-char (point-min))
(should (re-search-forward "UNPUSHED EDIT" nil t)))))
(ert-deftest test-pearl-merge-updates-rich-description-issue-in-place ()
"An unedited issue with lossy markdown (a heading) is updated, not skipped.
Regression: the dirty check round-tripped Org back to markdown and mistook a
lossy round-trip (# heading -> bold, *italic* -> **bold**) for a local edit, so
refresh silently skipped every rich-text issue."
(test-pearl-merge--in-org
(test-pearl-merge--buffer
(test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
(let ((counts (pearl--merge-issues-into-buffer
(list (test-pearl-merge--issue "a" "Alpha Renamed"
"# Heading\n\nSome body text.")))))
(should (= 1 (plist-get counts :updated)))
(should (= 0 (plist-get counts :skipped)))
(goto-char (point-min))
(should (re-search-forward "Alpha Renamed" nil t)))))
(ert-deftest test-pearl-subtree-dirty-p-rich-description-unedited-not-dirty ()
"A freshly rendered subtree with lossy-markdown description is not dirty unedited."
(test-pearl-merge--in-org
(test-pearl-merge--buffer
(test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(beginning-of-line)
(should-not (pearl--subtree-dirty-p))))
(ert-deftest test-pearl-subtree-dirty-p-empty-description-not-dirty ()
"An issue with an empty description is not dirty.
Regression: body extraction overshot an empty body into the next issue's
subtree, so every description-less issue read as a local edit."
(test-pearl-merge--in-org
(test-pearl-merge--buffer
(test-pearl-merge--issue "a" "Alpha" "")
(test-pearl-merge--issue "b" "Beta" "Desc Beta."))
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(beginning-of-line)
(should (string= "" (pearl--issue-body-at-point)))
(should-not (pearl--subtree-dirty-p))))
(ert-deftest test-pearl-subtree-dirty-p-edited-body-is-dirty ()
"Editing the rendered body still marks the subtree dirty (edit detection holds)."
(test-pearl-merge--in-org
(test-pearl-merge--buffer
(test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
(goto-char (point-min))
(re-search-forward "Some body text\\.")
(end-of-line)
(insert " LOCAL EDIT")
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(beginning-of-line)
(should (pearl--subtree-dirty-p))))
;;; --update-source-header
(ert-deftest test-pearl-merge-update-source-header-rewrites-count ()
"The header refresh updates the count and truncation lines in place."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
(pearl--update-source-header 5 t)
(goto-char (point-min))
(should (re-search-forward "^#\\+LINEAR-COUNT: 5$" nil t))
(goto-char (point-min))
(should (re-search-forward "^#\\+LINEAR-TRUNCATED: yes$" nil t))))
;;; --merge-query-result (render boundary)
(ert-deftest test-pearl-merge-query-result-merges-and-updates-header ()
"An ok result normalizes its raw nodes, merges them, and refreshes the count."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
(let ((source '(:type filter :name "My open issues" :filter (:assignee :me)))
(result (pearl--make-query-result
'ok :issues (list (test-pearl-merge--raw "a" "Alpha Renamed" "Desc Alpha.")
(test-pearl-merge--raw "c" "Gamma" "Desc Gamma.")))))
(pearl--merge-query-result result source)
(goto-char (point-min))
(should (re-search-forward "Alpha Renamed" nil t))
(should (re-search-forward "Gamma" nil t))
(goto-char (point-min))
(should (re-search-forward "^#\\+LINEAR-COUNT: 2$" nil t)))))
(ert-deftest test-pearl-merge-query-result-empty-leaves-buffer ()
"An empty result leaves the buffer unchanged rather than dropping everything."
(test-pearl-merge--in-org
(test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
(let ((source '(:type filter :name "My open issues" :filter (:assignee :me)))
(before (buffer-string)))
(pearl--merge-query-result (pearl--make-query-result 'empty) source)
(should (string= before (buffer-string))))))
(provide 'test-pearl-merge)
;;; test-pearl-merge.el ends here
|
