blob: 1362b2e7ee38dc91b2566eab63035c007878600c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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
|
