diff options
Diffstat (limited to 'tests/test-pearl-commands.el')
| -rw-r--r-- | tests/test-pearl-commands.el | 153 |
1 files changed, 153 insertions, 0 deletions
diff --git a/tests/test-pearl-commands.el b/tests/test-pearl-commands.el new file mode 100644 index 0000000..77f2d46 --- /dev/null +++ b/tests/test-pearl-commands.el @@ -0,0 +1,153 @@ +;;; test-pearl-commands.el --- Tests for pearl user commands -*- 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 interactive commands. Their input sources (completing-read, +;; read-string) and the network/file boundaries are stubbed so the dispatch +;; and orchestration logic runs: the list-issues result handling, project +;; dispatch, the new-issue input-building, and the connection/setup checks. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +;;; pearl-list-issues + +(ert-deftest test-pearl-list-issues-ok-writes-all-issues () + "On an ok result, every server-returned issue is written (no client filter)." + (let ((written nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result + 'ok :issues '(((identifier . "A")) ((identifier . "B"))))))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (issues &optional _source _truncated) (setq written issues)))) + (pearl-list-issues) + (should (= 2 (length written)))))) + +(ert-deftest test-pearl-list-issues-empty-skips-write () + "An empty result messages the user and does not overwrite the file." + (let ((wrote nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result 'empty :issues nil)))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (&rest _) (setq wrote t)))) + (pearl-list-issues) + (should-not wrote)))) + +(ert-deftest test-pearl-list-issues-error-skips-write () + "A failed query messages and does not write." + (let ((wrote nil)) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter cb &optional _order) + (funcall cb (pearl--make-query-result + 'request-failed :message "boom")))) + ((symbol-function 'pearl--update-org-from-issues) + (lambda (&rest _) (setq wrote t)))) + (pearl-list-issues) + (should-not wrote)))) + +(ert-deftest test-pearl-list-issues-project-id-adds-project-filter () + "A project id is compiled into the issue filter passed to the fetch." + (let (captured-filter) + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (filter _cb &optional _order) (setq captured-filter filter))) + ((symbol-function 'pearl--update-org-from-issues) #'ignore)) + (pearl-list-issues "proj-1") + (should (equal '(("id" ("eq" . "proj-1"))) (cdr (assoc "project" captured-filter))))))) + +;;; 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." + (let ((pid '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)))) + (pearl-list-issues-by-project) + (should (string-equal "p1" pid))))) + +(ert-deftest test-pearl-list-issues-by-project-no-team-stops () + "With no team selected, list-issues is not called." + (let ((called nil) + (pearl-default-team-id nil)) + (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil)) + ((symbol-function 'pearl-list-issues) (lambda (&rest _) (setq called t)))) + (pearl-list-issues-by-project) + (should-not called)))) + +;;; pearl-new-issue + +(ert-deftest test-pearl-new-issue-success-returns-issue () + "new-issue builds the input, sends it, and returns the created issue." + (let ((pearl-default-team-id "team-1")) + (cl-letf (((symbol-function 'read-string) + (lambda (prompt &rest _) (if (string-prefix-p "Issue title" prompt) "My Issue" ""))) + ((symbol-function 'completing-read) + (lambda (prompt &rest _) + (cond ((string-prefix-p "State" prompt) "Todo") + ((string-prefix-p "Priority" prompt) "Medium") + ((string-prefix-p "Label category" prompt) "All") + (t "")))) + ((symbol-function 'pearl-get-states) + (lambda (_t) '(((id . "s1") (name . "Todo"))))) + ((symbol-function 'pearl-get-team-members) (lambda (_t) '())) + ((symbol-function 'pearl-get-issue-types) (lambda (_t) '())) + ((symbol-function 'pearl-select-project) (lambda (_t) nil)) + ((symbol-function 'pearl--graphql-request) + (lambda (_q &optional _v) + '((data (issueCreate (success . t) + (issue (id . "i1") (identifier . "ENG-1") (title . "My Issue")))))))) + (should (string-equal "ENG-1" (cdr (assoc 'identifier (pearl-new-issue)))))))) + +(ert-deftest test-pearl-new-issue-no-team-stops () + "new-issue stops cleanly when no team is selected." + (let ((pearl-default-team-id nil)) + (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil))) + (should (progn (pearl-new-issue) t))))) + +;;; pearl-test-connection / check-setup + +(ert-deftest test-pearl-test-connection-success-runs () + "test-connection completes on a successful viewer response." + (testutil-linear-with-response '((data (viewer (id . "u") (name . "Me")))) + (should (progn (pearl-test-connection) t)))) + +(ert-deftest test-pearl-check-setup-with-key-tests-connection () + "check-setup runs the connection test when an API key is set." + (let ((pearl-api-key "k") (called nil)) + (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t)))) + (pearl-check-setup) + (should called)))) + +(ert-deftest test-pearl-check-setup-without-key-skips-test () + "check-setup does not run the connection test without an API key." + (let ((pearl-api-key nil) (called nil)) + (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t)))) + (pearl-check-setup) + (should-not called)))) + +(provide 'test-pearl-commands) +;;; test-pearl-commands.el ends here |