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
|
;;; test-pearl-bugfixes.el --- Tests for the 2026-05-25 quick bug batch -*- 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 a batch of small bugs found in a 2026-05-25 code review of
;; pearl.el (each was a :bug:quick:solo: todo): single-issue refresh
;; false-stash, comment outcome parent-issue-id, save-all viewer-unavailable
;; counting, request-counter leak on a missing key, issue commands climbing
;; out of comment subtrees, the project selector on no projects, and
;; command-path filter validation.
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'cl-lib)
(defmacro test-pearl-bug--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)))
;;; Bug: single-issue refresh falsely stashes clean lossy descriptions
(ert-deftest test-pearl-refresh-clean-lossy-description-not-stashed ()
"A freshly rendered issue whose markdown is lossy under org->md is not stashed."
(test-pearl-bug--in-org
(pearl--format-issue-as-org-entry
'(:id "u" :identifier "ENG-1" :title "t" :priority 3
:state (:name "Todo") :description "# Heading\nbody text"))
(re-search-forward "body text")
(let ((stashed nil))
(cl-letf (((symbol-function 'pearl--stash-conflict-text)
(lambda (&rest _) (setq stashed t)))
((symbol-function 'pearl--fetch-issue-async)
(lambda (&rest _) nil)))
(pearl-refresh-current-issue)
(should-not stashed)))))
;;; Bug: comment save outcomes lose the parent issue id
(ert-deftest test-pearl-issue-id-at-point-climbs-from-comment ()
"From inside a comment subtree, the enclosing issue's LINEAR-ID is found."
(test-pearl-bug--in-org
(concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"**** Comments\n***** Me\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\nhi\n")
(re-search-forward "^\\*\\*\\*\\*\\* Me")
(should (string= "a" (pearl--issue-id-at-point)))))
(ert-deftest test-pearl-save-comment-outcome-carries-issue-id ()
"A skipped comment outcome carries the enclosing issue id, not nil."
(test-pearl-bug--in-org
(concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"**** Comments\n***** Other\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n"
":LINEAR-COMMENT-AUTHOR-ID: u-other\n:END:\nhi\n")
(re-search-forward "^\\*\\*\\*\\*\\* Other")
(let (outcome)
;; non-own comment -> skipped/read-only, no network; outcome should still
;; name the parent issue.
(pearl--save-comment-field (point-marker) "u-me"
(lambda (o) (setq outcome o)))
(should (string= "a" (plist-get outcome :issue-id))))))
;;; Bug: save-all prompt mislabels viewer-lookup failures as read-only
(ert-deftest test-pearl-save-all-counts-viewer-failed-not-read-only ()
"With the viewer lookup failed, comment candidates count as viewer-unavailable."
(let* ((scan (list (cons (make-marker)
(list :title nil :description nil
:comment-candidates
'((:comment-id "c1" :author-id "u-me"))))))
(counts (pearl--save-all-counts scan nil t)))
(should (= 0 (plist-get counts :read-only-comments)))
(should (= 0 (plist-get counts :own-comments)))
(should (= 1 (plist-get counts :viewer-unavailable)))
(should (string-match-p "viewer unavailable" (pearl--save-all-prompt counts)))))
;;; Bug: missing API key can leak the active request count
(ert-deftest test-pearl-request-missing-key-does-not-leak-counter ()
"A missing key signals before dispatch and leaves the request counter intact."
(let ((pearl-api-key nil)
(pearl--active-requests 0))
(should-error (pearl--graphql-request-async "query { viewer { id } }"))
(should (= 0 pearl--active-requests))))
;;; Bug: issue-level commands do not climb out of comment subtrees
(ert-deftest test-pearl-goto-issue-heading-climbs-from-comment ()
"The issue-heading guard climbs from a comment to the enclosing issue heading."
(test-pearl-bug--in-org
(concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n"
"**** Comments\n***** Me\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\nhi\n")
(re-search-forward "^\\*\\*\\*\\*\\* Me")
(pearl--goto-issue-heading-or-error)
(should (string= "a" (org-entry-get nil "LINEAR-ID")))))
(ert-deftest test-pearl-goto-issue-heading-errors-off-an-issue ()
"With no enclosing issue heading, the guard signals a user-error."
(test-pearl-bug--in-org "* Plain heading\nno linear id\n"
(goto-char (point-max))
(should-error (pearl--goto-issue-heading-or-error) :type 'user-error)))
;;; Bug: project selector errors when a team has no projects
(ert-deftest test-pearl-select-project-no-projects-returns-nil ()
"With no projects (or a failed fetch), the selector returns nil without erroring."
(cl-letf (((symbol-function 'pearl-get-projects) (lambda (_team) nil)))
(should (null (pearl-select-project "team-1")))))
;;; Bug: saved/ad-hoc query filters bypass validation
(ert-deftest test-pearl-run-saved-query-validates-before-fetch ()
"A local view with an unknown filter key errors before any fetch."
(let ((pearl-local-views '(("bad" :filter (:bogus-key "x"))))
(fetched nil))
(cl-letf (((symbol-function 'pearl--query-issues-async)
(lambda (&rest _) (setq fetched t))))
(should-error (pearl-run-local-view "bad") :type 'user-error)
(should-not fetched))))
(ert-deftest test-pearl-run-saved-query-validates-bad-priority ()
"A local view with an out-of-range priority errors before any fetch."
(let ((pearl-local-views '(("bad" :filter (:priority 9))))
(fetched nil))
(cl-letf (((symbol-function 'pearl--query-issues-async)
(lambda (&rest _) (setq fetched t))))
(should-error (pearl-run-local-view "bad") :type 'user-error)
(should-not fetched))))
(provide 'test-pearl-bugfixes)
;;; test-pearl-bugfixes.el ends here
|
