diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-pearl-format.el | 4 | ||||
| -rw-r--r-- | tests/test-pearl-labels.el | 193 |
2 files changed, 195 insertions, 2 deletions
diff --git a/tests/test-pearl-format.el b/tests/test-pearl-format.el index 53af2e7..491348a 100644 --- a/tests/test-pearl-format.el +++ b/tests/test-pearl-format.el @@ -51,7 +51,7 @@ so these tests no longer need a state mapping bound." "A full issue renders the heading and the namespaced LINEAR-* drawer." (test-pearl--with-default-mapping (let ((out (pearl--format-issue-as-org-entry (test-pearl--norm-full)))) - (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing$" out)) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing :bug:backend:$" out)) (should (string-match-p "^:LINEAR-ID: +uuid-1$" out)) (should (string-match-p "^:LINEAR-IDENTIFIER: +ENG-42$" out)) (should (string-match-p "^:LINEAR-STATE-NAME: +In Progress$" out)) @@ -168,7 +168,7 @@ sort together (org-sort on the parent) instead of being orphan headings." (test-pearl--with-default-mapping (let ((out (pearl--build-org-content (list (test-pearl--norm-full) (test-pearl--norm-bare))))) - (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing$" out)) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing :bug:backend:$" out)) (should (string-match-p "^\\*\\* TODO ENG-7: Bare Issue$" out))))) ;;; --restore-page-visibility diff --git a/tests/test-pearl-labels.el b/tests/test-pearl-labels.el new file mode 100644 index 0000000..0195b27 --- /dev/null +++ b/tests/test-pearl-labels.el @@ -0,0 +1,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 |