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
289
|
;;; test-pearl-labels.el --- Tests for label-to-tag slugify and tag set -*- 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 pure helpers behind "Linear labels as Org tags"
;; (docs/labels-as-org-tags-spec.org): `pearl--label-name-to-tag' slugifies one
;; label name to an Org tag, and `pearl--label-tags' turns a list of label
;; plists into the ordered, de-duplicated tag set for a heading.
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'cl-lib)
;;; pearl--label-name-to-tag
(ert-deftest test-pearl-label-name-to-tag-downcases-and-slugs ()
"A label name downcases; spaces and other non-tag chars become single underscores."
(should (string= "bug" (pearl--label-name-to-tag "Bug")))
(should (string= "needs_review" (pearl--label-name-to-tag "Needs Review")))
(should (string= "ui_ux" (pearl--label-name-to-tag "UI/UX")))
(should (string= "backend_api" (pearl--label-name-to-tag "backend/api")))
(should (string= "p1" (pearl--label-name-to-tag "P1"))))
(ert-deftest test-pearl-label-name-to-tag-preserves-unicode-alnum ()
"Unicode letters survive (alnum is Unicode-aware), downcased."
(should (string= "naïve_café" (pearl--label-name-to-tag "naïve café"))))
(ert-deftest test-pearl-label-name-to-tag-collapses-runs-and-trims ()
"Runs of non-tag characters collapse to one underscore; leading/trailing are trimmed."
(should (string= "a_b" (pearl--label-name-to-tag " a // b ")))
(should (string= "x" (pearl--label-name-to-tag "_x_"))))
(ert-deftest test-pearl-label-name-to-tag-punctuation-only-is-empty ()
"A name with no tag-legal characters slugifies to the empty string."
(should (string= "" (pearl--label-name-to-tag "///")))
(should (string= "" (pearl--label-name-to-tag "")))
(should (string= "" (pearl--label-name-to-tag nil))))
;;; pearl--label-tags
(ert-deftest test-pearl-label-tags-maps-in-order ()
"Each label's :name slugifies; order is preserved."
(should (equal '("bug" "backend")
(pearl--label-tags '((:id "1" :name "Bug") (:id "2" :name "Backend"))))))
(ert-deftest test-pearl-label-tags-dedupes-collisions-first-wins ()
"Two names that slugify the same render one tag, at the first's position."
(should (equal '("a_b")
(pearl--label-tags '((:name "A/B") (:name "A B"))))))
(ert-deftest test-pearl-label-tags-drops-empty-slugs ()
"A punctuation-only label contributes no tag."
(should (equal '("bug")
(pearl--label-tags '((:name "Bug") (:name "///"))))))
(ert-deftest test-pearl-label-tags-empty-input ()
"No labels yields no tags."
(should (null (pearl--label-tags nil))))
;;; pearl--assignee-tag
(ert-deftest test-pearl-assignee-tag-prefixes-and-slugs ()
"An assignee renders as an @-prefixed, slugified Org tag."
(should (string= "@eric" (pearl--assignee-tag '(:name "Eric"))))
(should (string= "@eric_smith" (pearl--assignee-tag '(:name "Eric Smith")))))
(ert-deftest test-pearl-assignee-tag-prefers-display-name ()
"The tag uses Linear's short displayName (its @-mention handle), not the name
field -- which is the full email for teammates who never set a display name."
(should (string= "@nerses"
(pearl--assignee-tag '(:name "Nerses Ohanyan" :display-name "nerses"))))
(should (string= "@vrezh_mikayelyan"
(pearl--assignee-tag '(:name "vrezh.mikayelyan@deepsat.com"
:display-name "vrezh.mikayelyan")))))
(ert-deftest test-pearl-assignee-tag-falls-back-to-name ()
"With no displayName, the tag slugs the name."
(should (string= "@eric_bell" (pearl--assignee-tag '(:name "Eric Bell")))))
(ert-deftest test-pearl-assignee-tag-short-keeps-first-segment ()
"With `pearl-assignee-tag-short' on, only the first name (before the first dot
or space) is kept, so a firstname.lastname handle shortens to just the first."
(let ((pearl-assignee-tag-short t))
(should (string= "@vrezh" (pearl--assignee-tag '(:display-name "vrezh.mikayelyan"))))
(should (string= "@eric" (pearl--assignee-tag '(:name "Eric Bell"))))
;; A single-token handle is unchanged.
(should (string= "@nerses" (pearl--assignee-tag '(:display-name "nerses"))))))
(ert-deftest test-pearl-assignee-tag-short-off-keeps-full-handle ()
"Off by default: the full slugified handle is kept."
(should (string= "@vrezh_mikayelyan"
(pearl--assignee-tag '(:display-name "vrezh.mikayelyan")))))
(ert-deftest test-pearl-normalize-user-captures-display-name ()
"The normalized user carries Linear's displayName so the @-tag can use the
short handle while the drawer keeps the fuller name."
(let ((u (pearl--normalize-user '((id . "u1") (name . "Nerses Ohanyan")
(displayName . "nerses") (email . "n@x")))))
(should (string= "nerses" (plist-get u :display-name)))
(should (string= "Nerses Ohanyan" (plist-get u :name)))))
(ert-deftest test-pearl-assignee-tag-nil-when-unassigned ()
"No assignee yields no tag."
(should-not (pearl--assignee-tag nil)))
(ert-deftest test-pearl-assignee-tag-nil-when-disabled ()
"With `pearl-show-assignee' off, no tag is produced even for a real assignee."
(let ((pearl-show-assignee nil))
(should-not (pearl--assignee-tag '(:name "Eric")))))
(ert-deftest test-pearl-assignee-tag-empty-slug-is-nil ()
"A name that slugifies to empty (all punctuation) yields no tag."
(should-not (pearl--assignee-tag '(:name "///"))))
;;; rendering on the issue heading
(defun test-pearl-labels--entry (labels &optional assignee)
"Render a minimal issue with LABELS (and optional ASSIGNEE) via
`pearl--format-issue-as-org-entry'."
(pearl--format-issue-as-org-entry
(list :id "u" :identifier "ENG-1" :title "Fix the thing"
:priority 2 :state '(:name "Todo") :labels labels :assignee assignee)))
(ert-deftest test-pearl-format-issue-renders-label-tags ()
"Labels render as Org tags on the issue heading; the drawer keeps the names."
(let ((out (test-pearl-labels--entry '((:id "1" :name "Bug") (:id "2" :name "Backend")))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:backend:$" out))
(should (string-match-p "^:LINEAR-LABELS: +\\[Bug, Backend\\]$" out))))
(ert-deftest test-pearl-format-issue-no-labels-no-tags ()
"An issue with no labels gets no tag string on the heading."
(let ((out (test-pearl-labels--entry nil)))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing$" out))))
(ert-deftest test-pearl-format-issue-label-tag-collision-renders-once ()
"Two labels that slugify the same render one tag; the drawer keeps both names."
(let ((out (test-pearl-labels--entry '((:name "A/B") (:name "A B")))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :a_b:$" out))
(should (string-match-p "^:LINEAR-LABELS: +\\[A/B, A B\\]$" out))))
(ert-deftest test-pearl-format-issue-empty-slug-label-not-on-heading ()
"A punctuation-only label is absent from the heading but present in the drawer."
(let ((out (test-pearl-labels--entry '((:name "Bug") (:name "///")))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:$" out))
(should (string-match-p "^:LINEAR-LABELS: +\\[Bug, ///\\]$" out))))
(ert-deftest test-pearl-format-issue-tags-do-not-corrupt-title-sync ()
"With tags present, the title at point is still the bare title (no tags/keyword/prefix)."
(with-temp-buffer
(insert (test-pearl-labels--entry '((:name "Bug") (:name "Backend"))))
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(should (string= "Fix the thing" (pearl--issue-title-at-point)))))
(ert-deftest test-pearl-format-issue-renders-assignee-tag-before-labels ()
"The assignee renders as the leading @-tag, ahead of the label tags."
(let ((out (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric"))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :@eric:bug:$" out))))
(ert-deftest test-pearl-format-issue-assignee-tag-only ()
"An assigned issue with no labels gets just the @-tag."
(let ((out (test-pearl-labels--entry nil '(:name "Eric"))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :@eric:$" out))))
(ert-deftest test-pearl-format-issue-assignee-tag-disabled ()
"With `pearl-show-assignee' off, the heading carries no @-tag."
(let* ((pearl-show-assignee nil)
(out (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric"))))
(should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:$" out))
(should-not (string-match-p "@eric" out))))
(ert-deftest test-pearl-format-issue-assignee-tag-does-not-corrupt-title-sync ()
"The assignee tag stays outside the hashed title span, like label tags."
(with-temp-buffer
(insert (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric")))
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(should (string= "Fix the thing" (pearl--issue-title-at-point)))))
;;; pearl--set-heading-label-tags
(ert-deftest test-pearl-set-heading-label-tags-replaces-preserving-the-rest ()
"Replacing the tag set leaves the keyword, cookie, title, and identifier intact."
(with-temp-buffer
(insert "** TODO [#B] ENG-1: Fix the thing :old:\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n")
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(pearl--set-heading-label-tags '("bug" "backend"))
(goto-char (point-min))
(should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing[ \t]+:bug:backend:$" nil t))
;; drawer and body untouched
(should (string= "a" (org-entry-get nil "LINEAR-ID")))))
(ert-deftest test-pearl-set-heading-label-tags-preserves-assignee-tag ()
"Rewriting the label tags keeps the @-assignee tag (pearl owns label tags, but
the assignee tag is a separate namespace) and drops other stale tags."
(with-temp-buffer
(insert "** TODO [#B] ENG-1: Fix the thing :@eric:old:\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n")
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(pearl--set-heading-label-tags '("bug" "backend"))
(goto-char (point-min))
(should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing[ \t]+:@eric:bug:backend:$" nil t))
(should-not (save-excursion (goto-char (point-min)) (re-search-forward ":old:" nil t)))))
(ert-deftest test-pearl-set-heading-label-tags-empty-clears ()
"An empty tag set clears the heading's label tags (the @-assignee tag, if any,
is kept -- it isn't a label)."
(with-temp-buffer
(insert "** TODO [#B] ENG-1: Fix :bug:\n")
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(pearl--set-heading-label-tags nil)
(goto-char (point-min))
(should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix[ \t]*$" nil t))
(should-not (save-excursion (goto-char (point-min)) (re-search-forward ":bug:" nil t)))))
;;; pearl-edit-labels rewrites both the drawer and the heading tags
(ert-deftest test-pearl-edit-labels-rewrites-heading-tags-and-drawer ()
"Picking labels updates the drawer and rewrites the heading tags, dropping stale ones."
(cl-letf (((symbol-function 'pearl--resolve-team-id)
(lambda (_type name _team) (concat "id-" name))))
(with-temp-buffer
(insert "** TODO ENG-1: Fix :stale:\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: t1\n:LINEAR-LABELS: [old]\n:LINEAR-LABEL-IDS: x\n:END:\n")
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(pearl-edit-labels '("Bug" "Backend"))
(should (string= "[Bug, Backend]" (org-entry-get nil "LINEAR-LABELS")))
(should (string= "id-Bug id-Backend" (org-entry-get nil "LINEAR-LABEL-IDS")))
(goto-char (point-min))
(should (re-search-forward "^\\*\\* TODO ENG-1: Fix[ \t]+:bug:backend:$" nil t))
(should-not (save-excursion (goto-char (point-min)) (re-search-forward ":stale:" nil t))))))
(ert-deftest test-pearl-edit-labels-clear-removes-tags-and-empties-drawer ()
"Clearing the selection removes heading tags and sets the drawer to []."
(with-temp-buffer
(insert "** TODO ENG-1: Fix :bug:\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: t1\n:LINEAR-LABELS: [Bug]\n:LINEAR-LABEL-IDS: id-Bug\n:END:\n")
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
(pearl-edit-labels nil)
(should (string= "[]" (org-entry-get nil "LINEAR-LABELS")))
(should (string= "" (org-entry-get nil "LINEAR-LABEL-IDS")))
(should-not (save-excursion (goto-char (point-min)) (re-search-forward ":bug:" nil t)))))
;;; save isolation -- a tag edit is never a dirty field
(ert-deftest test-pearl-label-tags-edit-is-not-a-dirty-field ()
"Hand-editing the heading tags does not mark the issue's labels dirty.
The dirty scan reads the LABEL-IDS drawer, not the heading tags, so a tag-only
change is never treated as a pushable edit."
(with-temp-buffer
(insert (test-pearl-labels--entry '((:id "lbl-1" :name "Bug"))))
(org-mode)
(goto-char (point-min))
(re-search-forward "^\\*\\* ")
;; freshly rendered: LABEL-IDS == LABEL-IDS-SYNCED, so not dirty
(should-not (pearl--label-ids-dirty-p))
;; hand-add a stray heading tag; the drawer is untouched
(org-set-tags '("bug" "manual"))
(should-not (pearl--label-ids-dirty-p))))
(provide 'test-pearl-labels)
;;; test-pearl-labels.el ends here
|
