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
|
;;; 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))))
;;; rendering on the issue heading
(defun test-pearl-labels--entry (labels)
"Render a minimal issue with LABELS 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)))
(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)))))
;;; 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-empty-clears ()
"An empty tag set clears the heading's tags."
(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
|
