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
|
;;; 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)))))
;;; 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"))))))
(provide 'test-pearl-comment-editing)
;;; test-pearl-comment-editing.el ends here
|
