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
|
;;; test-pearl-comment-deletion.el --- Tests for deleting a comment -*- 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-delete-current-comment' and `pearl--delete-comment-async'
;; (see docs/comment-deletion-spec.org). The command is own-only (reusing the
;; viewer / `pearl--comment-editable-p' gate), confirms before the destructive
;; `commentDelete' mutation, removes only the comment's subtree on success, and
;; ignores tag/save concerns. HTTP is stubbed at the request boundary.
;;; 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-del--in-org (content &rest body)
"Run BODY in an org-mode temp buffer holding CONTENT at point-min."
(declare (indent 1))
`(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))
(org-element-use-cache nil))
(with-temp-buffer
(insert ,content)
(org-mode)
(goto-char (point-min))
,@body)))
(defun test-pearl-del--doc (&optional c1-stored-body)
"An issue with a body and two comments: own c1 (author u-me) + other c2.
C1's =LINEAR-COMMENT-SHA256= is the hash of C1-STORED-BODY's markdown, defaulting
to its visible body \"my comment\" (so the comment reads clean). Pass a
different string to make C1 read dirty, or the symbol `none' to omit the hash."
(let* ((shown "my comment")
(sha (cond ((eq c1-stored-body 'none) nil)
(t (secure-hash 'sha256
(pearl--org-to-md (or c1-stored-body shown)))))))
(concat
"*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nIssue body.\n"
"**** Comments\n"
"***** Craig --- 2026-05-24T09:00:00.000Z\n"
":PROPERTIES:\n"
":LINEAR-COMMENT-ID: c1\n"
":LINEAR-COMMENT-AUTHOR-ID: u-me\n"
(if sha (format ":LINEAR-COMMENT-SHA256: %s\n" sha) "")
":END:\n" shown "\n"
"***** Someone --- 2026-05-24T10:00:00.000Z\n"
":PROPERTIES:\n"
":LINEAR-COMMENT-ID: c2\n"
":LINEAR-COMMENT-AUTHOR-ID: u-other\n"
":LINEAR-COMMENT-SHA256: " (secure-hash 'sha256 "their comment") "\n"
":END:\ntheir comment\n")))
(defun test-pearl-del--goto (needle)
"Move point onto the line matching NEEDLE."
(goto-char (point-min))
(re-search-forward needle)
(beginning-of-line))
;;; --delete-comment-async (HTTP stubbed)
(ert-deftest test-pearl-delete-comment-async-success ()
"A successful commentDelete reports success."
(testutil-linear-with-response '((data (commentDelete (success . t))))
(let (result)
(pearl--delete-comment-async "c1" (lambda (r) (setq result r)))
(should (eq t (plist-get result :success))))))
(ert-deftest test-pearl-delete-comment-async-soft-fail ()
"A non-success / error commentDelete reports failure rather than erroring."
(testutil-linear-with-response '((data (commentDelete (success . :json-false))))
(let (result)
(pearl--delete-comment-async "c1" (lambda (r) (setq result r)))
(should-not (plist-get result :success)))))
;;; pearl-delete-current-comment
(defmacro test-pearl-del--with-stubs (deleted confirm &rest body)
"Run BODY with delete/viewer/confirm stubbed.
DELETED is a symbol bound to a list collecting comment-ids passed to the delete
mutation (which reports success). CONFIRM is the `yes-or-no-p' return value.
Binds `prompt' to the last confirmation prompt string. Viewer is warm as u-me."
(declare (indent 2))
`(let ((pearl--cache-viewer '(:id "u-me" :name "Me"))
(prompt nil))
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (id cb) (push id ,deleted) (funcall cb '(:success t))))
((symbol-function 'yes-or-no-p)
(lambda (p) (setq prompt p) ,confirm)))
(ignore prompt)
,@body)))
(ert-deftest test-pearl-delete-comment-not-on-comment-errors ()
"Run on a non-comment heading: user-error, no delete mutation."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil))
(test-pearl-del--with-stubs deleted t
(test-pearl-del--goto "^\\*\\*\\* TODO")
(should-error (pearl-delete-current-comment) :type 'user-error)
(should-not deleted)))))
(ert-deftest test-pearl-delete-comment-own-confirmed-removes-only-that-subtree ()
"Own comment + confirm + success removes c1 only; c2 and the issue body stay."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil))
(test-pearl-del--with-stubs deleted t
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should (equal '("c1") deleted))
(let ((s (buffer-string)))
(should-not (string-match-p "LINEAR-COMMENT-ID: c1" s))
(should (string-match-p "LINEAR-COMMENT-ID: c2" s))
(should (string-match-p "their comment" s))
(should (string-match-p "Issue body\\." s)))))))
(ert-deftest test-pearl-delete-comment-declined-no-mutation ()
"Declining the confirmation deletes nothing and leaves the subtree intact."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil))
(test-pearl-del--with-stubs deleted nil
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should-not deleted)
(should (string-match-p "LINEAR-COMMENT-ID: c1" (buffer-string)))))))
(ert-deftest test-pearl-delete-comment-non-own-refused ()
"Another user's comment is refused with no delete mutation."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil))
(test-pearl-del--with-stubs deleted t
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Someone")
(pearl-delete-current-comment)
(should-not deleted)
(should (string-match-p "LINEAR-COMMENT-ID: c2" (buffer-string)))))))
(ert-deftest test-pearl-delete-comment-viewer-failure-refused ()
"A failed viewer lookup refuses with the identity message and no mutation."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil) (msg nil) (pearl--cache-viewer nil))
(cl-letf (((symbol-function 'pearl--viewer-async)
(lambda (cb) (funcall cb nil)))
((symbol-function 'pearl--delete-comment-async)
(lambda (id cb) (push id deleted) (funcall cb '(:success t))))
((symbol-function 'message)
(lambda (fmt &rest args) (setq msg (apply #'format fmt args)))))
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should-not deleted)
(should (string-match-p "Linear identity" msg))))))
(ert-deftest test-pearl-delete-comment-failure-keeps-subtree ()
"A failed commentDelete leaves the comment subtree in place."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((pearl--cache-viewer '(:id "u-me" :name "Me")))
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (_id cb) (funcall cb '(:success nil))))
((symbol-function 'yes-or-no-p) (lambda (_p) t)))
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should (string-match-p "LINEAR-COMMENT-ID: c1" (buffer-string)))))))
(ert-deftest test-pearl-delete-comment-clean-prompt-wording ()
"A clean own comment uses the plain remove-it-here prompt."
(test-pearl-del--in-org (test-pearl-del--doc)
(let ((deleted nil) (captured nil))
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (id cb) (push id deleted) (funcall cb '(:success t))))
((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t)))
(let ((pearl--cache-viewer '(:id "u-me" :name "Me")))
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should (string-match-p "from Linear and remove it here" captured)))))))
(ert-deftest test-pearl-delete-comment-dirty-prompt-names-both ()
"A locally edited own comment uses the discard-local-edits prompt naming both."
(test-pearl-del--in-org (test-pearl-del--doc "a different stored body")
(let ((captured nil))
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (_id cb) (funcall cb '(:success t))))
((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t)))
(let ((pearl--cache-viewer '(:id "u-me" :name "Me")))
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should (string-match-p "Linear" captured))
(should (string-match-p "discard" captured)))))))
(ert-deftest test-pearl-delete-comment-missing-sha-takes-stronger-prompt ()
"A comment with no stored hash (unknown provenance) takes the discard prompt."
(test-pearl-del--in-org (test-pearl-del--doc 'none)
(let ((captured nil))
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (_id cb) (funcall cb '(:success t))))
((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t)))
(let ((pearl--cache-viewer '(:id "u-me" :name "Me")))
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")
(pearl-delete-current-comment)
(should (string-match-p "discard" captured)))))))
(ert-deftest test-pearl-delete-comment-killed-buffer-no-signal ()
"If the buffer is killed before the delete callback fires, nothing signals."
(let ((buf (generate-new-buffer "pearl-del-killtest"))
(pearl--cache-viewer '(:id "u-me" :name "Me")))
(unwind-protect
(progn
(with-current-buffer buf
(let ((org-element-use-cache nil))
(insert (test-pearl-del--doc))
(org-mode)
(test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig")))
;; The delete stub kills the buffer, then reports success -- the
;; success callback must not signal against the dead buffer.
(cl-letf (((symbol-function 'pearl--delete-comment-async)
(lambda (_id cb) (kill-buffer buf) (funcall cb '(:success t))))
((symbol-function 'yes-or-no-p) (lambda (_p) t)))
(with-current-buffer buf
;; should complete without error
(should-not (pearl-delete-current-comment)))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(provide 'test-pearl-comment-deletion)
;;; test-pearl-comment-deletion.el ends here
|
