;;; test-pearl-assignee-labels.el --- Tests for set-assignee / set-labels -*- 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 two picker commands that resolve names to ids: ;; `pearl-edit-assignee' and `pearl-edit-labels'. As save-model-v2 ;; buffer-editors they write the LINEAR-ASSIGNEE / LABELS drawer (and the live ;; id sets) but do NOT push -- the change reconciles at the next save (the push ;; path is covered in test-pearl-save). The resolver is stubbed. ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) (require 'cl-lib) (defmacro test-pearl--in-org (content &rest body) "Run BODY in an org-mode temp buffer holding CONTENT at point-min." (declare (indent 1)) `(with-temp-buffer (insert ,content) (org-mode) (goto-char (point-min)) ,@body)) ;;; edit-assignee (buffer-editor: writes the drawer, no push) (ert-deftest test-pearl-edit-assignee-writes-drawer-no-push () "edit-assignee resolves the name, writes the drawer, and does not push." (let ((pushed nil)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-ASSIGNEE-ID: old\n:LINEAR-ASSIGNEE-NAME: Someone\n:END:\n" (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (_kind _name _team &optional _force) "u9")) ((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) (pearl-edit-assignee "Craig") (should-not pushed) (should (string= "Craig" (org-entry-get nil "LINEAR-ASSIGNEE-NAME"))) (should (string= "u9" (org-entry-get nil "LINEAR-ASSIGNEE-ID"))))))) (ert-deftest test-pearl-edit-assignee-unresolvable-errors () "An unresolvable assignee name signals a user error and writes nothing." (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (&rest _) nil))) (should-error (pearl-edit-assignee "Nobody") :type 'user-error)))) (ert-deftest test-pearl-edit-assignee-not-on-issue-errors () "edit-assignee outside a Linear issue heading signals a user error." (test-pearl--in-org "* Plain heading\nno id\n" (should-error (pearl-edit-assignee "Craig") :type 'user-error))) ;;; edit-labels (buffer-editor: writes the drawer + live ids, no push) (ert-deftest test-pearl-edit-labels-writes-names-and-ids-no-push () "edit-labels resolves each name, writes LINEAR-LABELS + LINEAR-LABEL-IDS, no push." (let ((pushed nil)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: []\n:END:\n" (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (_kind name _team &optional _force) (pcase name ("bug" "l1") ("p1" "l2") (_ nil)))) ((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) (pearl-edit-labels '("bug" "p1")) (should-not pushed) (should (string= "[bug, p1]" (org-entry-get nil "LINEAR-LABELS"))) (should (string= "l1 l2" (org-entry-get nil "LINEAR-LABEL-IDS"))))))) (ert-deftest test-pearl-edit-labels-clear-writes-empty () "Clearing labels writes an empty drawer and empty id set, no push." (let ((pushed nil)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:LINEAR-LABEL-IDS: l1\n:END:\n" (cl-letf (((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) (pearl-edit-labels '()) (should-not pushed) (should (string= "[]" (org-entry-get nil "LINEAR-LABELS"))) (should (string= "" (org-entry-get nil "LINEAR-LABEL-IDS"))))))) (ert-deftest test-pearl-edit-labels-unresolvable-errors () "An unresolvable label name signals a user error and writes nothing." (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (&rest _) nil))) (should-error (pearl-edit-labels '("ghost")) :type 'user-error)))) (provide 'test-pearl-assignee-labels) ;;; test-pearl-assignee-labels.el ends here