;;; 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 drawer-field commands that resolve names to ids: ;; `pearl-set-assignee' and `pearl-set-labels'. They push via ;; the generic `--update-issue-async' and update the LINEAR-ASSIGNEE / LABELS ;; drawer. The resolver and the mutation are 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)) ;;; set-assignee (ert-deftest test-pearl-set-assignee-pushes-id-and-updates-drawer () "Setting an assignee resolves the name, pushes the id, and updates the drawer." (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 (_id input cb) (setq pushed input) (funcall cb '(:success t))))) (pearl-set-assignee "Craig") (should (string= "u9" (cdr (assoc "assigneeId" 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-set-assignee-unresolvable-errors () "An unresolvable assignee name signals a user error and pushes nothing." (let ((pushed nil)) (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)) ((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) (should-error (pearl-set-assignee "Nobody") :type 'user-error) (should-not pushed))))) (ert-deftest test-pearl-set-assignee-not-on-issue-errors () "Setting an assignee outside a Linear issue heading signals a user error." (test-pearl--in-org "* Plain heading\nno id\n" (should-error (pearl-set-assignee "Craig") :type 'user-error))) ;;; set-labels (ert-deftest test-pearl-set-labels-pushes-ids-and-updates-drawer () "Setting labels resolves each name, pushes the id list, and updates the drawer." (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 (_id input cb) (setq pushed input) (funcall cb '(:success t))))) (pearl-set-labels '("bug" "p1")) (should (equal '("l1" "l2") (cdr (assoc "labelIds" pushed)))) (should (string= "[bug, p1]" (org-entry-get nil "LINEAR-LABELS"))))))) (ert-deftest test-pearl-set-labels-clear-pushes-empty () "Clearing labels (empty list) pushes an empty id list and empties the drawer." (let ((pushed 'unset)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:END:\n" (cl-letf (((symbol-function 'pearl--update-issue-async) (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) (pearl-set-labels '()) (should (equal '() (cdr (assoc "labelIds" pushed)))) (should (string= "[]" (org-entry-get nil "LINEAR-LABELS"))))))) (ert-deftest test-pearl-set-labels-unresolvable-errors () "An unresolvable label name signals a user error and pushes nothing." (let ((pushed nil)) (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)) ((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) (should-error (pearl-set-labels '("ghost")) :type 'user-error) (should-not pushed))))) (provide 'test-pearl-assignee-labels) ;;; test-pearl-assignee-labels.el ends here