diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-pearl-adhoc.el | 6 | ||||
| -rw-r--r-- | tests/test-pearl-commands.el | 36 | ||||
| -rw-r--r-- | tests/test-pearl-favorites.el | 237 | ||||
| -rw-r--r-- | tests/test-pearl-filter.el | 24 | ||||
| -rw-r--r-- | tests/test-pearl-keymap.el | 3 |
5 files changed, 301 insertions, 5 deletions
diff --git a/tests/test-pearl-adhoc.el b/tests/test-pearl-adhoc.el index 97ac22e..23aad79 100644 --- a/tests/test-pearl-adhoc.el +++ b/tests/test-pearl-adhoc.el @@ -52,6 +52,12 @@ (let ((f (pearl--assemble-filter nil nil nil nil '() nil))) (should-not (plist-member f :labels)))) +(ert-deftest test-pearl-assemble-filter-string-assignee-is-assignee-id () + "A string assignee (resolved member id) lands as :assignee-id, not :assignee." + (let ((f (pearl--assemble-filter nil t nil nil nil "user-1"))) + (should (string= "user-1" (plist-get f :assignee-id))) + (should-not (plist-member f :assignee)))) + ;;; --save-query (ert-deftest test-pearl-save-query-adds-entry () diff --git a/tests/test-pearl-commands.el b/tests/test-pearl-commands.el index ccd39c8..64e38b4 100644 --- a/tests/test-pearl-commands.el +++ b/tests/test-pearl-commands.el @@ -78,16 +78,21 @@ ;;; pearl-list-issues-by-project -(ert-deftest test-pearl-list-issues-by-project-dispatches-with-project-id () - "Selecting a team and project forwards the project id to list-issues." +(ert-deftest test-pearl-list-issues-by-project-dispatches-with-project-id-and-name () + "Selecting a team and project forwards both id and name to list-issues, so +the source can render 'Project issues: <name>'." (let ((pid 'unset) + (pname 'unset) (pearl-default-team-id nil)) (cl-letf (((symbol-function 'pearl-select-team) (lambda () '((id . "t1")))) ((symbol-function 'pearl-select-project) (lambda (_t) '((id . "p1") (name . "Platform")))) - ((symbol-function 'pearl-list-issues) (lambda (project-id) (setq pid project-id)))) + ((symbol-function 'pearl-list-issues) + (lambda (project-id &optional project-name) + (setq pid project-id pname project-name)))) (pearl-list-issues-by-project) - (should (string-equal "p1" pid))))) + (should (string-equal "p1" pid)) + (should (string-equal "Platform" pname))))) (ert-deftest test-pearl-list-issues-by-project-no-team-stops () "With no team selected, list-issues is not called." @@ -149,5 +154,28 @@ (pearl-check-setup) (should-not called)))) +;;; pearl-list-issues source construction (by-project me-lock fix) + +(ert-deftest test-pearl-list-issues-source-default-is-my-open-issues () + "Without a project, pearl-list-issues is me-scoped and named 'My open issues'." + (let ((s (pearl--list-issues-source nil nil))) + (should (equal '(:assignee :me :open t) (car s))) + (should (string= "My open issues" (plist-get (cdr s) :name))))) + +(ert-deftest test-pearl-list-issues-source-project-drops-the-me-lock () + "With a project id (and no name), the filter pins the project only -- no +:assignee key -- and the source name is 'Project issues' (regression against +the old me-locked by-project behavior)." + (let ((s (pearl--list-issues-source "proj-1" nil))) + (should (equal '(:project "proj-1" :open t) (car s))) + (should-not (plist-member (car s) :assignee)) + (should (string= "Project issues" (plist-get (cdr s) :name))))) + +(ert-deftest test-pearl-list-issues-source-project-name-in-display () + "With a project id and name, the source name reads 'Project issues: NAME'." + (let ((s (pearl--list-issues-source "proj-1" "Platform"))) + (should (equal '(:project "proj-1" :open t) (car s))) + (should (string= "Project issues: Platform" (plist-get (cdr s) :name))))) + (provide 'test-pearl-commands) ;;; test-pearl-commands.el ends here diff --git a/tests/test-pearl-favorites.el b/tests/test-pearl-favorites.el new file mode 100644 index 0000000..b47cde6 --- /dev/null +++ b/tests/test-pearl-favorites.el @@ -0,0 +1,237 @@ +;;; test-pearl-favorites.el --- Tests for favorites layer -*- 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 favorites layer (spec: docs/issue-sources-spec.org). Covers +;; `pearl--normalize-favorite' (node -> typed plist), `pearl--favorite->source' +;; (typed plist -> runnable source or browser action), and +;; `pearl--favorites-async' (paged fetch with the request boundary stubbed). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defun test-pearl-fav--node (type title url sort-order entity-key entity-id &optional identifier) + "Build a favorite NODE alist for TYPE, optionally with an ENTITY-KEY/ID ref. +For an issue node, IDENTIFIER fills the issue's user-facing key." + (let ((node (list (cons 'id (format "fav-%s" type)) + (cons 'type type) + (cons 'title title) + (cons 'url url) + (cons 'sortOrder sort-order)))) + (when entity-key + (push (cons entity-key + (append (list (cons 'id entity-id)) + (when identifier (list (cons 'identifier identifier))))) + node)) + node)) + +;;; normalize per type + +(ert-deftest test-pearl-normalize-favorite-custom-view () + "A customView favorite normalizes to :kind view with the view's id." + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "customView" "Active bugs" "https://linear.app/x/view/v1" 0.1 + 'customView "view-1")))) + (should (eq 'view (plist-get p :kind))) + (should (string= "Active bugs" (plist-get p :title))) + (should (string= "view-1" (plist-get p :id))))) + +(ert-deftest test-pearl-normalize-favorite-project () + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "project" "Platform" "https://linear.app/x/project/p1" 0.2 + 'project "proj-1")))) + (should (eq 'project (plist-get p :kind))) + (should (string= "proj-1" (plist-get p :id))))) + +(ert-deftest test-pearl-normalize-favorite-cycle () + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "cycle" "Sprint 12" "https://linear.app/x/cycle/c1" 0.3 + 'cycle "cyc-1")))) + (should (eq 'cycle (plist-get p :kind))) + (should (string= "cyc-1" (plist-get p :id))))) + +(ert-deftest test-pearl-normalize-favorite-label-and-project-label () + "Both label and projectLabel normalize to :kind label (collapsed for dispatch)." + (let ((a (pearl--normalize-favorite + (test-pearl-fav--node "label" "security" "https://linear.app/x/label/l1" 0.4 + 'label "lbl-1"))) + (b (pearl--normalize-favorite + (test-pearl-fav--node "projectLabel" "milestone" "https://linear.app/x/pl/pl1" 0.5 + 'projectLabel "plbl-1")))) + (should (eq 'label (plist-get a :kind))) + (should (string= "lbl-1" (plist-get a :id))) + (should (eq 'label (plist-get b :kind))) + (should (string= "plbl-1" (plist-get b :id))))) + +(ert-deftest test-pearl-normalize-favorite-user () + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "user" "Vrezh" "https://linear.app/x/user/u1" 0.6 + 'user "user-1")))) + (should (eq 'user (plist-get p :kind))) + (should (string= "user-1" (plist-get p :id))))) + +(ert-deftest test-pearl-normalize-favorite-issue-carries-identifier () + "An issue favorite carries the user-facing identifier alongside the id." + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "issue" "Some bug" "https://linear.app/x/issue/ENG-1" 0.7 + 'issue "iss-1" "ENG-1")))) + (should (eq 'issue (plist-get p :kind))) + (should (string= "iss-1" (plist-get p :id))) + (should (string= "ENG-1" (plist-get p :identifier))))) + +(ert-deftest test-pearl-normalize-favorite-unknown-type-is-other () + "An unrecognized favorite type normalizes to :kind other (browser-only)." + (let ((p (pearl--normalize-favorite + (test-pearl-fav--node "release" "v1.2" "https://linear.app/x/release/r1" 0.8 + nil nil)))) + (should (eq 'other (plist-get p :kind))) + (should (null (plist-get p :id))) + (should (string= "https://linear.app/x/release/r1" (plist-get p :url))))) + +;;; favorite->source dispatch + +(defun test-pearl-fav--norm (kind id &optional title url) + "Hand-build a normalized favorite for dispatch tests." + (list :kind kind :title (or title "T") :url (or url "https://x") + :sort-order 0.0 :id id)) + +(ert-deftest test-pearl-favorite->source-view () + "A view favorite dispatches to a (:type view ...) source." + (let ((s (pearl--favorite->source + (test-pearl-fav--norm 'view "view-1" "Active bugs" "https://linear.app/x/v")))) + (should (eq 'view (plist-get s :type))) + (should (string= "Active bugs" (plist-get s :name))) + (should (string= "view-1" (plist-get s :id))))) + +(ert-deftest test-pearl-favorite->source-project () + (let ((s (pearl--favorite->source (test-pearl-fav--norm 'project "proj-1" "Platform")))) + (should (eq 'filter (plist-get s :type))) + (should (string= "Platform" (plist-get s :name))) + (should (equal '(:project "proj-1" :open t) (plist-get s :filter))))) + +(ert-deftest test-pearl-favorite->source-cycle () + (let ((s (pearl--favorite->source (test-pearl-fav--norm 'cycle "cyc-1" "Sprint 12")))) + (should (equal '(:cycle "cyc-1" :open t) (plist-get s :filter))))) + +(ert-deftest test-pearl-favorite->source-label-uses-id () + "Label favorites dispatch to (:label-id ID) -- rename-proof." + (let ((s (pearl--favorite->source (test-pearl-fav--norm 'label "lbl-1" "security")))) + (should (equal '(:label-id "lbl-1" :open t) (plist-get s :filter))))) + +(ert-deftest test-pearl-favorite->source-user-uses-id () + "User favorites dispatch to (:assignee-id ID) -- sidesteps email availability." + (let ((s (pearl--favorite->source (test-pearl-fav--norm 'user "user-1" "Vrezh")))) + (should (equal '(:assignee-id "user-1" :open t) (plist-get s :filter))))) + +(ert-deftest test-pearl-favorite->source-issue-is-browser () + "Issue favorites are browser-only in v1 (no source)." + (let ((s (pearl--favorite->source + (append (test-pearl-fav--norm 'issue "iss-1" "Some bug" "https://linear.app/x/issue/ENG-1") + (list :identifier "ENG-1"))))) + (should (plist-get s :browser)) + (should (string= "https://linear.app/x/issue/ENG-1" (plist-get s :url))))) + +(ert-deftest test-pearl-favorite->source-other-is-browser () + "An unknown-kind favorite is browser-only." + (let ((s (pearl--favorite->source (test-pearl-fav--norm 'other nil "Release v1" "https://linear.app/x/r")))) + (should (plist-get s :browser)) + (should (string= "https://linear.app/x/r" (plist-get s :url))))) + +;;; favorites-async (request boundary stubbed) + +(ert-deftest test-pearl-favorites-async-single-page () + "A single-page favorites response is collected into a list of normalized plists." + (testutil-linear-with-response + `((data (favorites + (nodes . ,(vector (test-pearl-fav--node "customView" "V" "https://x/v" 0.1 + 'customView "view-1") + (test-pearl-fav--node "project" "P" "https://x/p" 0.2 + 'project "proj-1"))) + (pageInfo (hasNextPage . :json-false) (endCursor . nil))))) + (let (result) + (pearl--favorites-async (lambda (r) (setq result r))) + (should (= 2 (length result))) + (should (eq 'view (plist-get (nth 0 result) :kind))) + (should (eq 'project (plist-get (nth 1 result) :kind)))))) + +;;; pick-source candidate builder + +(ert-deftest test-pearl-pick-source-candidates-orders-favorites-by-sort-order () + "Favorites are listed first in ascending :sort-order, then saved queries alphabetically." + (let* ((favs (list (test-pearl-fav--norm 'project "p1" "Bravo") ; sort-order 0.0 + (let ((f (test-pearl-fav--norm 'view "v1" "Alpha"))) + (plist-put f :sort-order -1.0)))) ; lower, comes first + (saved '(("My open" :filter (:assignee :me :open t)) + ("All bugs" :filter (:labels ("bug") :open t)))) + (cands (pearl--pick-source-candidates favs saved)) + (labels (mapcar #'car cands))) + (should (equal labels + '("[view] Alpha" + "[project] Bravo" + "[saved] All bugs" + "[saved] My open"))))) + +(ert-deftest test-pearl-pick-source-candidates-dispatch-from-attached-plist () + "Dispatch reads the attached source plist, not the display string." + (let* ((favs (list (test-pearl-fav--norm 'project "proj-1" "Platform"))) + (cands (pearl--pick-source-candidates favs nil)) + (source (cdr (assoc "[project] Platform" cands)))) + (should (eq 'filter (plist-get source :type))) + (should (equal '(:project "proj-1" :open t) (plist-get source :filter))))) + +(ert-deftest test-pearl-pick-source-candidates-disambiguates-duplicates () + "Two candidates that would share a display string are made unique with a suffix." + (let* ((favs (list (test-pearl-fav--norm 'project "p1" "Same") + (test-pearl-fav--norm 'project "p2" "Same"))) + (cands (pearl--pick-source-candidates favs nil)) + (labels (mapcar #'car cands))) + (should (= 2 (length cands))) + ;; both unique + (should (= 2 (length (delete-dups (copy-sequence labels))))))) + +(ert-deftest test-pearl-pick-source-candidates-empty () + "No favorites and no saved queries yields no candidates." + (should (null (pearl--pick-source-candidates nil nil)))) + +;;; open-favorite-url + +(ert-deftest test-pearl-open-favorite-url-with-url-browses () + "A valid URL is handed to browse-url and a message names what opened." + (let (visited) + (cl-letf (((symbol-function 'browse-url) (lambda (u &rest _) (setq visited u)))) + (pearl--open-favorite-url + (list :browser t :url "https://linear.app/x/issue/ENG-1" + :title "Some bug" :kind 'issue)) + (should (string= "https://linear.app/x/issue/ENG-1" visited))))) + +(ert-deftest test-pearl-open-favorite-url-nil-refuses () + "A nil/empty URL refuses cleanly and never calls browse-url." + (let (visited) + (cl-letf (((symbol-function 'browse-url) (lambda (u &rest _) (setq visited u)))) + (should-error (pearl--open-favorite-url + (list :browser t :url nil :title "X" :kind 'other)) + :type 'user-error) + (should-not visited)))) + +(provide 'test-pearl-favorites) +;;; test-pearl-favorites.el ends here diff --git a/tests/test-pearl-filter.el b/tests/test-pearl-filter.el index 6143311..38d254e 100644 --- a/tests/test-pearl-filter.el +++ b/tests/test-pearl-filter.el @@ -189,5 +189,29 @@ "A non-string entry in :labels is a user-error." (should-error (pearl--validate-issue-filter '(:labels ("bug" 7))) :type 'user-error)) +;;; id-based forms (rename-proof; used by favorite-derived filter sources) + +(ert-deftest test-pearl-filter-assignee-id () + ":assignee-id compiles to assignee.id.eq -- rename-proof, used by user favorites." + (should (equal (pearl--build-issue-filter '(:assignee-id "u-1")) + '(("assignee" ("id" ("eq" . "u-1"))))))) + +(ert-deftest test-pearl-filter-label-id () + ":label-id compiles to labels.some.id.in [id] -- rename-proof, used by label favorites." + (should (equal (pearl--build-issue-filter '(:label-id "lbl-1")) + '(("labels" ("some" ("id" ("in" . ["lbl-1"])))))))) + +(ert-deftest test-pearl-filter-validate-rejects-empty-assignee-id () + "An empty :assignee-id is a user-error." + (should-error (pearl--validate-issue-filter '(:assignee-id "")) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-empty-label-id () + "An empty :label-id is a user-error." + (should-error (pearl--validate-issue-filter '(:label-id "")) :type 'user-error)) + +(ert-deftest test-pearl-filter-validate-rejects-unknown-id-key () + "An unknown key is still rejected (sanity that :label-id/:assignee-id were registered)." + (should-error (pearl--validate-issue-filter '(:not-a-key "x")) :type 'user-error)) + (provide 'test-pearl-filter) ;;; test-pearl-filter.el ends here diff --git a/tests/test-pearl-keymap.el b/tests/test-pearl-keymap.el index b465395..5cc658d 100644 --- a/tests/test-pearl-keymap.el +++ b/tests/test-pearl-keymap.el @@ -66,7 +66,8 @@ The lowercase `c' is no longer a direct command -- it is the create prefix." (should (keymapp (lookup-key pearl-prefix-map (kbd "y"))))) ; copy (ert-deftest test-pearl-prefix-map-fetch-group () - "The fetch group resolves each source command." + "The fetch group resolves each source command, including the unified pick-source." + (should (eq 'pearl-pick-source (lookup-key pearl-prefix-map (kbd "f s")))) (should (eq 'pearl-list-issues (lookup-key pearl-prefix-map (kbd "f o")))) (should (eq 'pearl-list-issues-by-project (lookup-key pearl-prefix-map (kbd "f p")))) (should (eq 'pearl-list-issues-filtered (lookup-key pearl-prefix-map (kbd "f f")))) |