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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
;;; test-pearl-comment-editing.el --- Tests for editing comments -*- 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 editing an existing comment (spec: docs/issue-comment-editing-spec.org).
;; Covers: the author-id retained at normalize time, the per-comment provenance
;; drawer, the editability predicate and highlight pass, the viewer/commentUpdate
;; network helpers (stubbed at the HTTP boundary), and the permission + conflict
;; gates of `pearl-edit-current-comment'.
;;; 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."
(declare (indent 1))
`(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE"))))
(with-temp-buffer
(insert ,content)
(org-mode)
(goto-char (point-min))
,@body)))
;;; normalize-comment keeps the author id
(ert-deftest test-pearl-normalize-comment-keeps-author-id ()
"A user-authored comment retains the user id for the permission check."
(let ((c (pearl--normalize-comment
'((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z")
(user (id . "u-123") (name . "Craig"))))))
(should (string= "u-123" (plist-get c :author-id)))
(should (string= "Craig" (plist-get c :author)))))
(ert-deftest test-pearl-normalize-comment-bot-has-no-author-id ()
"A bot comment has no user, so author-id is nil (not editable)."
(let ((c (pearl--normalize-comment
'((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z")
(botActor (name . "Linear"))))))
(should (null (plist-get c :author-id)))))
;;; format-comment writes the provenance drawer
(ert-deftest test-pearl-format-comment-writes-drawer ()
"A rendered comment carries id, author-id, and a body hash in a drawer."
(let ((out (pearl--format-comment
'(:id "c9" :author-id "u-123" :author "Craig"
:created-at "2026-05-24T10:00:00.000Z" :body "Looks good"))))
(should (string-match-p ":LINEAR-COMMENT-ID:[ \t]+c9" out))
(should (string-match-p ":LINEAR-COMMENT-AUTHOR-ID:[ \t]+u-123" out))
(should (string-match-p (format ":LINEAR-COMMENT-SHA256:[ \t]+%s"
(secure-hash 'sha256 "Looks good"))
out))))
(ert-deftest test-pearl-format-comment-bot-empty-author-id ()
"A comment with no author id renders an empty author-id, not an error."
(let ((out (pearl--format-comment
'(:id "c1" :author "Linear" :created-at "2026-05-24T10:00:00.000Z"
:body "auto"))))
(should (string-match-p "^:LINEAR-COMMENT-AUTHOR-ID:[ \t]*$" out))))
;;; editability predicate
(ert-deftest test-pearl-comment-editable-own ()
"A comment whose author is the viewer is editable."
(should (pearl--comment-editable-p "u-1" "u-1")))
(ert-deftest test-pearl-comment-editable-other ()
"A comment by another user is not editable."
(should-not (pearl--comment-editable-p "u-2" "u-1")))
(ert-deftest test-pearl-comment-editable-nil-author ()
"A comment with no author id (bot/external) is not editable."
(should-not (pearl--comment-editable-p nil "u-1"))
(should-not (pearl--comment-editable-p "" "u-1")))
;;; viewer identity (cached)
(ert-deftest test-pearl-viewer-async-parses-and-caches ()
"The viewer query returns the id/name and caches it for the next call."
(let ((pearl--cache-viewer nil))
(testutil-linear-with-response
'((data (viewer (id . "u-me") (name . "Craig"))))
(let (v)
(pearl--viewer-async (lambda (r) (setq v r)))
(should (string= "u-me" (plist-get v :id)))
(should (string= "u-me" (plist-get pearl--cache-viewer :id)))))
;; second call uses the cache, no HTTP needed
(let ((v2 'untouched))
(pearl--viewer-async (lambda (r) (setq v2 r)))
(should (string= "u-me" (plist-get v2 :id))))))
;;; commentUpdate write path
(ert-deftest test-pearl-update-comment-success ()
"A successful commentUpdate reports success."
(testutil-linear-with-response
'((data (commentUpdate (success . t) (comment (id . "c1") (body . "edited")))))
(let (result)
(pearl--update-comment-async "c1" "edited" (lambda (r) (setq result r)))
(should (eq t (plist-get result :success))))))
(ert-deftest test-pearl-update-comment-soft-fail ()
"A non-success commentUpdate reports failure rather than erroring."
(testutil-linear-with-response
'((data (commentUpdate (success . :json-false) (comment . nil))))
(let (result)
(pearl--update-comment-async "c1" "x" (lambda (r) (setq result r)))
(should-not (plist-get result :success)))))
;;; edit command — permission + conflict gates
(defconst test-pearl--comment-buffer
(concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"**** Comments\n"
"***** Craig — 2026-05-24T09:00:00.000Z\n"
":PROPERTIES:\n"
":LINEAR-COMMENT-ID: c1\n"
":LINEAR-COMMENT-AUTHOR-ID: %s\n"
":LINEAR-COMMENT-SHA256: %s\n"
":END:\n"
"%s\n")
"Template: author-id, stored-sha, body.")
(defun test-pearl--comment-doc (author-id stored-body current-body)
"Build a comment buffer: AUTHOR-ID, drawer hash of STORED-BODY, CURRENT-BODY shown."
(format test-pearl--comment-buffer
author-id (secure-hash 'sha256 stored-body) current-body))
(ert-deftest test-pearl-edit-comment-not-on-comment-errors ()
"Running the edit command outside a comment subtree signals a user error."
(test-pearl--in-org "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
(should-error (pearl-edit-current-comment) :type 'user-error)))
(ert-deftest test-pearl-edit-comment-refuses-others ()
"Editing another user's comment refuses and never calls commentUpdate."
(test-pearl--in-org (test-pearl--comment-doc "u-other" "old" "new text")
(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(updated nil) (fetched nil))
(cl-letf (((symbol-function 'pearl--update-comment-async)
(lambda (&rest _) (setq updated t)))
((symbol-function 'pearl--fetch-comment-body-async)
(lambda (&rest _) (setq fetched t))))
(re-search-forward "new text")
(pearl-edit-current-comment)
(should-not updated)
(should-not fetched)))))
(ert-deftest test-pearl-edit-comment-noop-when-unchanged ()
"An unedited comment pushes nothing."
(test-pearl--in-org (test-pearl--comment-doc "u-me" "same" "same")
(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(updated nil))
(cl-letf (((symbol-function 'pearl--update-comment-async)
(lambda (&rest _) (setq updated t))))
(re-search-forward "same")
(pearl-edit-current-comment)
(should-not updated)))))
(ert-deftest test-pearl-edit-comment-pushes-own-edit ()
"Editing your own comment against an unchanged remote pushes and advances the hash."
(test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body")
(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(pushed-body nil))
(cl-letf (((symbol-function 'pearl--fetch-comment-body-async)
;; remote is unchanged since fetch (matches the stored hash)
(lambda (_id cb) (funcall cb "old body")))
((symbol-function 'pearl--update-comment-async)
(lambda (_id body cb) (setq pushed-body body)
(funcall cb '(:success t)))))
(re-search-forward "new body")
(pearl-edit-current-comment)
(should (string= "new body" pushed-body))
;; the stored hash advanced to the pushed body
(goto-char (point-min))
(re-search-forward "^\\*\\*\\*\\*\\* Craig")
(should (string= (secure-hash 'sha256 "new body")
(org-entry-get nil "LINEAR-COMMENT-SHA256")))))))
(ert-deftest test-pearl-edit-comment-refuses-conflict ()
"When the remote changed since the fetch, the edit is refused."
(test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body")
(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(updated nil))
(cl-letf (((symbol-function 'pearl--fetch-comment-body-async)
;; remote drifted from the stored hash -> conflict
(lambda (_id cb) (funcall cb "remote changed body")))
((symbol-function 'pearl--update-comment-async)
(lambda (&rest _) (setq updated t)))
;; On conflict the command now prompts; cancel keeps the old
;; refuse behavior (no commentUpdate call).
((symbol-function 'pearl--read-conflict-resolution)
(lambda (_label) 'cancel)))
(re-search-forward "new body")
(pearl-edit-current-comment)
(should-not updated)))))
(ert-deftest test-pearl-edit-comment-push-failure-keeps-hash ()
"A failed comment push keeps the stored hash and the edited body for retry."
(test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body")
(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(pushed-body nil)
(stored (secure-hash 'sha256 "old body")))
(cl-letf (((symbol-function 'pearl--fetch-comment-body-async)
(lambda (_id cb) (funcall cb "old body")))
((symbol-function 'pearl--update-comment-async)
(lambda (_id body cb) (setq pushed-body body) (funcall cb '(:success nil)))))
(re-search-forward "new body")
(pearl-edit-current-comment)
;; push attempted with the edited body ...
(should (string= "new body" pushed-body))
;; ... but the stored hash is not advanced and the edit stays.
(goto-char (point-min))
(re-search-forward "^\\*\\*\\*\\*\\* Craig")
(should (string= stored (org-entry-get nil "LINEAR-COMMENT-SHA256")))
(should (string= "new body" (pearl--issue-body-at-point)))))))
;;; editability highlighting
(ert-deftest test-pearl-highlight-comments-colors-by-editability ()
"Own comments get the editable face; others get the read-only face."
(test-pearl--in-org
(concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"**** Comments\n"
"***** Me — 2026-05-24T09:00:00.000Z\n"
":PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:LINEAR-COMMENT-AUTHOR-ID: u-me\n:END:\nmine\n"
"***** Them — 2026-05-24T10:00:00.000Z\n"
":PROPERTIES:\n:LINEAR-COMMENT-ID: c2\n:LINEAR-COMMENT-AUTHOR-ID: u-other\n:END:\ntheirs\n")
(pearl--apply-comment-highlights "u-me")
(cl-flet ((face-on (pat)
(goto-char (point-min))
(re-search-forward pat)
(goto-char (line-beginning-position))
(let ((ov (cl-find-if (lambda (o) (overlay-get o 'pearl-comment))
(overlays-at (point)))))
(and ov (overlay-get ov 'face)))))
(should (eq 'pearl-editable-comment (face-on "^\\*\\*\\*\\*\\* Me")))
(should (eq 'pearl-readonly-comment (face-on "^\\*\\*\\*\\*\\* Them"))))))
(ert-deftest test-pearl-add-comment-from-inside-comment-refuses ()
"Running add-comment from inside a comment subtree refuses — no issue id there."
(test-pearl--in-org (test-pearl--comment-doc "u-me" "stored" "uniquecommentline")
(goto-char (point-min))
(re-search-forward "uniquecommentline") ; point inside the comment subtree
(should-error (pearl-add-comment "hi") :type 'user-error)))
(ert-deftest test-pearl-edit-comment-missing-id-refuses-no-network ()
"A comment subtree without LINEAR-COMMENT-ID is refused with no network call."
(test-pearl--in-org
(concat "** TODO Issue\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"*** Comments\n**** Me — ts\n:PROPERTIES:\n:LINEAR-COMMENT-AUTHOR-ID: u-me\n:END:\nedited\n")
(let ((net nil))
(cl-letf (((symbol-function 'pearl--fetch-comment-body-async) (lambda (&rest _) (setq net t)))
((symbol-function 'pearl--update-comment-async) (lambda (&rest _) (setq net t))))
(re-search-forward "edited")
(should-error (pearl-edit-current-comment) :type 'user-error)
(should-not net)))))
(ert-deftest test-pearl-comment-body-reads-drawer-looking-text ()
"A comment body containing a colon-wrapped, drawer-looking line reads back intact."
(test-pearl--in-org
(concat "** TODO Issue\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"*** Comments\n**** Me — ts\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\n"
"see :note: below\nand more text\n")
(re-search-forward "see :note:")
(should (string= "see :note: below\nand more text" (pearl--issue-body-at-point)))))
(provide 'test-pearl-comment-editing)
;;; test-pearl-comment-editing.el ends here
|
