;;; test-pearl-bugfixes.el --- Tests for the 2026-05-25 quick bug batch -*- 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 a batch of small bugs found in a 2026-05-25 code review of ;; pearl.el (each was a :bug:quick:solo: todo): single-issue refresh ;; false-stash, comment outcome parent-issue-id, save-all viewer-unavailable ;; counting, request-counter leak on a missing key, issue commands climbing ;; out of comment subtrees, the project selector on no projects, and ;; command-path filter validation. ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) (require 'cl-lib) (defmacro test-pearl-bug--in-org (content &rest body) "Run BODY in an org-mode temp buffer holding CONTENT at point-min." (declare (indent 1)) `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE"))) (org-element-use-cache nil)) (with-temp-buffer (insert ,content) (org-mode) (goto-char (point-min)) ,@body))) ;;; Bug: single-issue refresh falsely stashes clean lossy descriptions (ert-deftest test-pearl-refresh-clean-lossy-description-not-stashed () "A freshly rendered issue whose markdown is lossy under org->md is not stashed." (test-pearl-bug--in-org (pearl--format-issue-as-org-entry '(:id "u" :identifier "ENG-1" :title "t" :priority 3 :state (:name "Todo") :description "# Heading\nbody text")) (re-search-forward "body text") (let ((stashed nil)) (cl-letf (((symbol-function 'pearl--stash-conflict-text) (lambda (&rest _) (setq stashed t))) ((symbol-function 'pearl--fetch-issue-async) (lambda (&rest _) nil))) (pearl-refresh-current-issue) (should-not stashed))))) ;;; Bug: comment save outcomes lose the parent issue id (ert-deftest test-pearl-issue-id-at-point-climbs-from-comment () "From inside a comment subtree, the enclosing issue's LINEAR-ID is found." (test-pearl-bug--in-org (concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" "**** Comments\n***** Me\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\nhi\n") (re-search-forward "^\\*\\*\\*\\*\\* Me") (should (string= "a" (pearl--issue-id-at-point))))) (ert-deftest test-pearl-save-comment-outcome-carries-issue-id () "A skipped comment outcome carries the enclosing issue id, not nil." (test-pearl-bug--in-org (concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" "**** Comments\n***** Other\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n" ":LINEAR-COMMENT-AUTHOR-ID: u-other\n:END:\nhi\n") (re-search-forward "^\\*\\*\\*\\*\\* Other") (let (outcome) ;; non-own comment -> skipped/read-only, no network; outcome should still ;; name the parent issue. (pearl--save-comment-field (point-marker) "u-me" (lambda (o) (setq outcome o))) (should (string= "a" (plist-get outcome :issue-id)))))) ;;; Bug: save-all prompt mislabels viewer-lookup failures as read-only (ert-deftest test-pearl-save-all-counts-viewer-failed-not-read-only () "With the viewer lookup failed, comment candidates count as viewer-unavailable." (let* ((scan (list (cons (make-marker) (list :title nil :description nil :comment-candidates '((:comment-id "c1" :author-id "u-me")))))) (counts (pearl--save-all-counts scan nil t))) (should (= 0 (plist-get counts :read-only-comments))) (should (= 0 (plist-get counts :own-comments))) (should (= 1 (plist-get counts :viewer-unavailable))) (should (string-match-p "viewer unavailable" (pearl--save-all-prompt counts))))) ;;; Bug: missing API key can leak the active request count (ert-deftest test-pearl-request-missing-key-does-not-leak-counter () "A missing key signals before dispatch and leaves the request counter intact." (let ((pearl-api-key nil) (pearl--active-requests 0)) (should-error (pearl--graphql-request-async "query { viewer { id } }")) (should (= 0 pearl--active-requests)))) ;;; Bug: issue-level commands do not climb out of comment subtrees (ert-deftest test-pearl-goto-issue-heading-climbs-from-comment () "The issue-heading guard climbs from a comment to the enclosing issue heading." (test-pearl-bug--in-org (concat "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" "**** Comments\n***** Me\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\nhi\n") (re-search-forward "^\\*\\*\\*\\*\\* Me") (pearl--goto-issue-heading-or-error) (should (string= "a" (org-entry-get nil "LINEAR-ID"))))) (ert-deftest test-pearl-goto-issue-heading-errors-off-an-issue () "With no enclosing issue heading, the guard signals a user-error." (test-pearl-bug--in-org "* Plain heading\nno linear id\n" (goto-char (point-max)) (should-error (pearl--goto-issue-heading-or-error) :type 'user-error))) ;;; Bug: project selector errors when a team has no projects (ert-deftest test-pearl-select-project-no-projects-returns-nil () "With no projects (or a failed fetch), the selector returns nil without erroring." (cl-letf (((symbol-function 'pearl-get-projects) (lambda (_team) nil))) (should (null (pearl-select-project "team-1"))))) ;;; Bug: saved/ad-hoc query filters bypass validation (ert-deftest test-pearl-run-saved-query-validates-before-fetch () "A local view with an unknown filter key errors before any fetch." (let ((pearl-local-views '(("bad" :filter (:bogus-key "x")))) (fetched nil)) (cl-letf (((symbol-function 'pearl--query-issues-async) (lambda (&rest _) (setq fetched t)))) (should-error (pearl-run-local-view "bad") :type 'user-error) (should-not fetched)))) (ert-deftest test-pearl-run-saved-query-validates-bad-priority () "A local view with an out-of-range priority errors before any fetch." (let ((pearl-local-views '(("bad" :filter (:priority 9)))) (fetched nil)) (cl-letf (((symbol-function 'pearl--query-issues-async) (lambda (&rest _) (setq fetched t)))) (should-error (pearl-run-local-view "bad") :type 'user-error) (should-not fetched)))) ;;; Bug: an out-of-range priority cookie ([#E]) silently downgraded to None (ert-deftest test-pearl-priority-number-in-range () "A/B/C/D cookies map to Linear 1-4; a heading with no cookie is 0 (None)." (test-pearl-bug--in-org "* TODO [#A] Urgent issue\n" (should (= 1 (pearl--priority-number-at-point)))) (test-pearl-bug--in-org "* TODO [#C] Medium issue\n" (should (= 3 (pearl--priority-number-at-point)))) (test-pearl-bug--in-org "* TODO [#D] Low issue\n" (should (= 4 (pearl--priority-number-at-point)))) (test-pearl-bug--in-org "* TODO No cookie issue\n" (should (= 0 (pearl--priority-number-at-point))))) (ert-deftest test-pearl-priority-number-out-of-range-errors () "An out-of-range cookie ([#E]) signals a user-error, not a silent None. The old reader matched only [#A-D], so [#E] fell through to 0 and a save silently pushed None, clearing the issue's Linear priority. Now it refuses at read time so the bad cookie surfaces before any push." (test-pearl-bug--in-org "* TODO [#E] Bogus priority\n" (should-error (pearl--priority-number-at-point) :type 'user-error)) (test-pearl-bug--in-org "* TODO [#Z] Also bogus\n" (should-error (pearl--priority-number-at-point) :type 'user-error))) (provide 'test-pearl-bugfixes) ;;; test-pearl-bugfixes.el ends here