;;; test-pearl-labels.el --- Tests for label-to-tag slugify and tag set -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; 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 . ;;; 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