diff options
Diffstat (limited to 'tests/test-pearl-menu.el')
| -rw-r--r-- | tests/test-pearl-menu.el | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/tests/test-pearl-menu.el b/tests/test-pearl-menu.el new file mode 100644 index 0000000..1362b2e --- /dev/null +++ b/tests/test-pearl-menu.el @@ -0,0 +1,73 @@ +;;; test-pearl-menu.el --- Tests for the transient menu -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `pearl-menu', the transient dispatcher. The menu is +;; interactive UI, so these test the integration -- the prefix is a real +;; command, every suffix dispatches to a bound command, and the key bindings +;; don't collide -- rather than transient's own rendering behavior. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el" + (file-name-directory + (or load-file-name buffer-file-name)))) +(require 'transient) + +(defun test-pearl-menu--suffixes (node) + "Collect (KEY . COMMAND) pairs from a transient layout NODE. +Walks vectors and lists recursively; whenever it reaches a plist +\(a list whose car is a keyword) it reads :key and :command from it." + (cond + ((vectorp node) + (apply #'append (mapcar #'test-pearl-menu--suffixes + (append node nil)))) + ((and (consp node) (keywordp (car node))) + (let ((cmd (plist-get node :command)) + (key (plist-get node :key))) + (when cmd (list (cons key cmd))))) + ((consp node) + (apply #'append (mapcar #'test-pearl-menu--suffixes node))) + (t nil))) + +(defun test-pearl-menu--pairs () + "Return the (KEY . COMMAND) pairs declared in `pearl-menu'." + (test-pearl-menu--suffixes + (get 'pearl-menu 'transient--layout))) + +(ert-deftest test-pearl-menu-is-command () + "The dispatcher is defined and is an interactive command." + (should (fboundp 'pearl-menu)) + (should (commandp 'pearl-menu))) + +(ert-deftest test-pearl-menu-suffixes-dispatch-to-real-commands () + "Every suffix in the menu names a bound, interactive command. +This is the regression guard: rename or remove a command and the +menu entry that still points at it fails here." + (let ((pairs (test-pearl-menu--pairs))) + (should pairs) + (dolist (pair pairs) + (let ((cmd (cdr pair))) + (should (fboundp cmd)) + (should (commandp cmd)))))) + +(ert-deftest test-pearl-menu-keys-are-unique () + "No two suffixes share a key binding." + (let* ((pairs (test-pearl-menu--pairs)) + (keys (delq nil (mapcar #'car pairs)))) + (should (= (length keys) (length (delete-dups (copy-sequence keys))))))) + +(ert-deftest test-pearl-menu-covers-core-commands () + "A representative slice of the command surface is reachable from the menu." + (let ((cmds (mapcar #'cdr (test-pearl-menu--pairs)))) + (dolist (expected '(pearl-list-issues + pearl-run-view + pearl-run-saved-query + pearl-sync-current-issue + pearl-set-state + pearl-add-comment + pearl-new-issue + pearl-delete-current-issue)) + (should (memq expected cmds))))) + +(provide 'test-pearl-menu) +;;; test-pearl-menu.el ends here |