diff options
Diffstat (limited to 'tests')
29 files changed, 1112 insertions, 65 deletions
diff --git a/tests/test-ai-config--apply-model-selection.el b/tests/test-ai-config--apply-model-selection.el new file mode 100644 index 000000000..4ccd6d7a0 --- /dev/null +++ b/tests/test-ai-config--apply-model-selection.el @@ -0,0 +1,45 @@ +;;; test-ai-config--apply-model-selection.el --- Tests for cj/--gptel-apply-model-selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--gptel-apply-model-selection is the apply step extracted from the +;; interactive cj/gptel-change-model: it sets gptel-backend/gptel-model globally +;; or buffer-locally and returns the confirmation message. The extraction also +;; dropped a dead `(if (stringp model) ...)' branch (model is always a symbol by +;; that point). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +(defvar gptel-backend) +(defvar gptel-model) + +(ert-deftest test-ai-config-apply-model-global-sets-globals () + "Normal: global scope assigns the global vars and reports (global)." + (let ((gptel-backend nil) (gptel-model nil)) + (let ((msg (cj/--gptel-apply-model-selection "global" 'mybackend 'mymodel "MyAI"))) + (should (eq gptel-backend 'mybackend)) + (should (eq gptel-model 'mymodel)) + (should (string-match-p "MyAI" msg)) + (should (string-match-p "mymodel" msg)) + (should (string-match-p "global" msg))))) + +(ert-deftest test-ai-config-apply-model-buffer-sets-buffer-locals () + "Normal: buffer scope makes the vars buffer-local and reports (buffer-local)." + (let ((gptel-backend 'orig) (gptel-model 'origm)) + (with-temp-buffer + (let ((msg (cj/--gptel-apply-model-selection "buffer" 'be 'mo "Name"))) + (should (local-variable-p 'gptel-backend)) + (should (local-variable-p 'gptel-model)) + (should (eq gptel-backend 'be)) + (should (eq gptel-model 'mo)) + (should (string-match-p "buffer-local" msg)))) + ;; outside the temp buffer the globals are untouched + (should (eq gptel-backend 'orig)) + (should (eq gptel-model 'origm)))) + +(provide 'test-ai-config--apply-model-selection) +;;; test-ai-config--apply-model-selection.el ends here diff --git a/tests/test-ai-term--capture-state.el b/tests/test-ai-term--capture-state.el index 543f83ad7..aa7421350 100644 --- a/tests/test-ai-term--capture-state.el +++ b/tests/test-ai-term--capture-state.el @@ -27,7 +27,9 @@ (should (= cj/--ai-term-last-size (window-body-width right)))))) (ert-deftest test-ai-term--capture-state-below-split-sets-direction () - "Normal: below-split window -> direction=below, integer body-lines matching window." + "Normal: below-split window -> direction=below, integer total-lines matching window. +The vertical axis captures total-height (not body-height) so the toggle +round-trip is immune to the mode line's pixel height." (save-window-excursion (delete-other-windows) (let ((below (split-window (selected-window) nil 'below)) @@ -36,7 +38,7 @@ (cj/--ai-term-capture-state below) (should (eq cj/--ai-term-last-direction 'below)) (should (integerp cj/--ai-term-last-size)) - (should (= cj/--ai-term-last-size (window-body-height below)))))) + (should (= cj/--ai-term-last-size (window-total-height below)))))) (ert-deftest test-ai-term--capture-state-noop-on-dead-window () "Boundary: nil window -> state remains unchanged." diff --git a/tests/test-ai-term--reuse-edge-window.el b/tests/test-ai-term--reuse-edge-window.el index f6259ae50..a9a0529e8 100644 --- a/tests/test-ai-term--reuse-edge-window.el +++ b/tests/test-ai-term--reuse-edge-window.el @@ -269,5 +269,46 @@ most-recent agent, which would now be the other one." (when (get-buffer right-name) (kill-buffer right-name)) (cj/test--kill-agent-buffers)))) +(ert-deftest test-ai-term--reuse-edge-window-3win-toggle-restores-own-window () + "Regression: in a 3-window layout the agent has its own split, so toggling it +off then on restores it as its own window without displacing a working window. +Before the fix, toggle-on reused the bottom edge (the user's main window), +collapsing three windows to two and hiding the main buffer. A toggle must be +reversible: off then on returns to the same layout." + (cj/test--kill-agent-buffers) + (let ((agent-name "agent [3win-toggle]") + (code-name "*test-3win-code*") + (main-name "*test-3win-main*") + (cj/--ai-term-last-direction nil) + (cj/--ai-term-last-size nil) + (cj/--ai-term-last-was-bury nil)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (cl-letf (((symbol-function 'cj/--ai-term-default-direction) (lambda (&rest _) 'below))) + (let ((code-buf (get-buffer-create code-name)) + (main-buf (get-buffer-create main-name)) + (agent-buf (get-buffer-create agent-name))) + (set-window-buffer (selected-window) code-buf) + (let* ((main-win (split-window (selected-window) nil 'below)) + (agent-win (split-window main-win nil 'below))) + (set-window-buffer main-win main-buf) + (set-window-buffer agent-win agent-buf) + (should (= (count-windows) 3)) + (let ((display-buffer-alist (cj/--ai-term-display-rule-list))) + (select-window agent-win) + (cj/test--call-as-gui #'cj/ai-term) ; off -> code | main + (should (= (count-windows) 2)) + (should-not (member agent-name (cj/test--displayed-buffer-names))) + (cj/test--call-as-gui #'cj/ai-term) ; on -> back to 3 windows + (should (= (count-windows) 3)) + (let ((bufs (cj/test--displayed-buffer-names))) + (should (member agent-name bufs)) + (should (member code-name bufs)) + (should (member main-name bufs)))))))) + (when (get-buffer code-name) (kill-buffer code-name)) + (when (get-buffer main-name) (kill-buffer main-name)) + (cj/test--kill-agent-buffers)))) + (provide 'test-ai-term--reuse-edge-window) ;;; test-ai-term--reuse-edge-window.el ends here diff --git a/tests/test-browser-config.el b/tests/test-browser-config.el index 7faecbfc8..9fe5b02e4 100644 --- a/tests/test-browser-config.el +++ b/tests/test-browser-config.el @@ -273,29 +273,6 @@ (should (string= (plist-get loaded :name) "Second")))) (test-browser-teardown)) -;;; Public wrappers (message side-effects mocked) - -(ert-deftest test-browser-apply-wrapper-success-messages-name () - "Normal: =cj/apply-browser-choice= reports the chosen name on success." - (test-browser-setup) - (let ((browser (test-browser-make-plist "Wrapper Test")) - (received nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq received (apply #'format fmt args))))) - (cj/apply-browser-choice browser)) - (should (string-match-p "Wrapper Test" received)) - (should (string-match-p "Default browser set" received))) - (test-browser-teardown)) - -(ert-deftest test-browser-apply-wrapper-invalid-plist-messages-error () - "Error: =cj/apply-browser-choice= surfaces an error message for a bad plist." - (test-browser-setup) - (let ((received nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq received (apply #'format fmt args))))) - (cj/apply-browser-choice nil)) - (should (string-match-p "Invalid" received))) - (test-browser-teardown)) (ert-deftest test-browser-initialize-wrapper-loaded-branch-applies () "Normal: =cj/initialize-browser= applies the saved browser when one is loaded." diff --git a/tests/test-calendar-sync--parse-exception-event.el b/tests/test-calendar-sync--parse-exception-event.el new file mode 100644 index 000000000..1935d3ebb --- /dev/null +++ b/tests/test-calendar-sync--parse-exception-event.el @@ -0,0 +1,64 @@ +;;; test-calendar-sync--parse-exception-event.el --- Tests for one-event exception parsing -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for calendar-sync--parse-exception-event, the per-VEVENT half of +;; calendar-sync--collect-recurrence-exceptions: it turns a single RECURRENCE-ID +;; override VEVENT into an exception plist (or nil). One function per file. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "." (file-name-directory load-file-name))) +(add-to-list 'load-path (expand-file-name "../modules" (file-name-directory load-file-name))) +(require 'testutil-calendar-sync) +(require 'calendar-sync) + +(defun test-cs-parse-exc--override-event (start end) + "Return a RECURRENCE-ID override VEVENT string for START..END." + (concat "BEGIN:VEVENT\n" + "UID:override@google.com\n" + "RECURRENCE-ID:20260203T090000Z\n" + "SUMMARY:Rescheduled Meeting\n" + "DTSTART:" (test-calendar-sync-ics-datetime start) "\n" + "DTEND:" (test-calendar-sync-ics-datetime end) "\n" + "END:VEVENT")) + +;;; Normal Cases + +(ert-deftest test-calendar-sync--parse-exception-event-normal-returns-plist () + "Normal: a RECURRENCE-ID override parses into a plist with its overridden times." + (let* ((start (test-calendar-sync-time-days-from-now 7 10 0)) + (end (test-calendar-sync-time-days-from-now 7 11 0)) + (plist (calendar-sync--parse-exception-event + (test-cs-parse-exc--override-event start end)))) + (should plist) + (should (plist-get plist :recurrence-id)) + (should (equal "20260203T090000Z" (plist-get plist :recurrence-id-raw))) + (should (plist-get plist :start)) + (should (plist-get plist :end)) + (should (equal "Rescheduled Meeting" (plist-get plist :summary))))) + +;;; Boundary Cases + +(ert-deftest test-calendar-sync--parse-exception-event-boundary-no-recurrence-id () + "Boundary: a VEVENT with no RECURRENCE-ID is not an override and returns nil." + (let* ((start (test-calendar-sync-time-days-from-now 7 10 0)) + (end (test-calendar-sync-time-days-from-now 7 11 0)) + (event (test-calendar-sync-make-vevent "Regular Event" start end))) + (should-not (calendar-sync--parse-exception-event event)))) + +;;; Error Cases + +(ert-deftest test-calendar-sync--parse-exception-event-error-unparseable-times () + "Error: a RECURRENCE-ID override whose times do not parse returns nil rather +than a half-built plist." + (let ((event (concat "BEGIN:VEVENT\n" + "UID:broken@google.com\n" + "RECURRENCE-ID:not-a-timestamp\n" + "SUMMARY:Broken Override\n" + "DTSTART:also-garbage\n" + "END:VEVENT"))) + (should-not (calendar-sync--parse-exception-event event)))) + +(provide 'test-calendar-sync--parse-exception-event) +;;; test-calendar-sync--parse-exception-event.el ends here diff --git a/tests/test-chrono-tools--sound-helpers.el b/tests/test-chrono-tools--sound-helpers.el new file mode 100644 index 000000000..08f71f9bb --- /dev/null +++ b/tests/test-chrono-tools--sound-helpers.el @@ -0,0 +1,54 @@ +;;; test-chrono-tools--sound-helpers.el --- Tests for the tmr sound-file helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/tmr--current-sound-name and cj/tmr--apply-sound-file were extracted from +;; the deeply-nested cj/tmr-select-sound-file so the "what's the current sound" +;; and "set the chosen sound" steps are unit-testable apart from the +;; completing-read UI. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'chrono-tools) + +(defvar tmr-sound-file) +(defvar sounds-dir) +(defvar notification-sound) + +(ert-deftest test-chrono-current-sound-name-existing () + "Normal: returns the basename when the current sound file exists." + (let* ((f (make-temp-file "tmr-sound" nil ".wav")) + (tmr-sound-file f)) + (unwind-protect + (should (equal (cj/tmr--current-sound-name) (file-name-nondirectory f))) + (delete-file f)))) + +(ert-deftest test-chrono-current-sound-name-missing-or-nil () + "Boundary: a missing file or nil yields nil." + (let ((tmr-sound-file "/no/such/file.wav")) + (should (null (cj/tmr--current-sound-name)))) + (let ((tmr-sound-file nil)) + (should (null (cj/tmr--current-sound-name))))) + +(ert-deftest test-chrono-apply-sound-file-sets-and-messages () + "Normal: sets tmr-sound-file under sounds-dir and reports the choice." + (let ((sounds-dir "/snd") + (notification-sound "/snd/default.wav") + (tmr-sound-file nil)) + (let ((msg (cj/tmr--apply-sound-file "chime.wav"))) + (should (equal tmr-sound-file "/snd/chime.wav")) + (should (string-match-p "Timer sound set to: chime.wav" msg))))) + +(ert-deftest test-chrono-apply-sound-file-default-branch () + "Boundary: choosing the notification sound reports it as the default." + (let ((sounds-dir "/snd") + (notification-sound "/snd/default.wav") + (tmr-sound-file nil)) + (let ((msg (cj/tmr--apply-sound-file "default.wav"))) + (should (equal tmr-sound-file "/snd/default.wav")) + (should (string-match-p "default: default.wav" msg))))) + +(provide 'test-chrono-tools--sound-helpers) +;;; test-chrono-tools--sound-helpers.el ends here diff --git a/tests/test-cj-window-geometry-lib.el b/tests/test-cj-window-geometry-lib.el index 938749f21..d32a48a92 100644 --- a/tests/test-cj-window-geometry-lib.el +++ b/tests/test-cj-window-geometry-lib.el @@ -2,7 +2,7 @@ ;;; Commentary: ;; Tests the pure helpers in `cj-window-geometry-lib.el': -;; `cj/window-direction', `cj/window-body-size', +;; `cj/window-direction', `cj/window-replay-size', ;; `cj/cardinal-to-edge-direction', and `cj/window-at-edge'. ;;; Code: @@ -52,30 +52,32 @@ (delete-other-windows) (should (eq (cj/window-direction (selected-window) 'below) 'below)))) -(ert-deftest test-cj-window-geometry--body-size-right-returns-body-cols () +(ert-deftest test-cj-window-geometry--replay-size-right-returns-body-cols () "Normal: right window with direction='right -> body-width in cols." (save-window-excursion (delete-other-windows) (let ((right (split-window (selected-window) nil 'right))) - (should (= (cj/window-body-size right 'right) + (should (= (cj/window-replay-size right 'right) (window-body-width right)))))) -(ert-deftest test-cj-window-geometry--body-size-below-returns-body-lines () - "Normal: below window with direction='below -> body-height in lines." +(ert-deftest test-cj-window-geometry--replay-size-below-returns-total-lines () + "Normal: below window with direction='below -> total-height in lines. +The vertical axis captures total-height (not body-height) so the capture/ +replay round-trip is immune to the mode line's pixel height." (save-window-excursion (delete-other-windows) (let ((below (split-window (selected-window) nil 'below))) - (should (= (cj/window-body-size below 'below) - (window-body-height below)))))) + (should (= (cj/window-replay-size below 'below) + (window-total-height below)))))) -(ert-deftest test-cj-window-geometry--body-size-narrow-window () +(ert-deftest test-cj-window-geometry--replay-size-narrow-window () "Normal: deliberately narrow right window -> matching body cols." (save-window-excursion (delete-other-windows) (let* ((frame-w (frame-width)) (target-cols (/ frame-w 4)) (right (split-window (selected-window) (- target-cols) 'right))) - (should (= (cj/window-body-size right 'right) + (should (= (cj/window-replay-size right 'right) (window-body-width right)))))) (ert-deftest test-cj-window-geometry--cardinal-to-edge-right () diff --git a/tests/test-cj-window-toggle-lib.el b/tests/test-cj-window-toggle-lib.el index 0762e255c..5edd06e96 100644 --- a/tests/test-cj-window-toggle-lib.el +++ b/tests/test-cj-window-toggle-lib.el @@ -36,7 +36,9 @@ (window-body-width right)))))) (ert-deftest test-cj-window-toggle-capture-records-below-split () - "Normal: below-split window writes direction=below and integer body-lines." + "Normal: below-split window writes direction=below and integer total-lines. +The vertical axis captures total-height, not body-height, so the round-trip +is immune to the mode line's pixel height (see `cj/window-replay-size')." (save-window-excursion (delete-other-windows) (let ((below (split-window (selected-window) nil 'below)) @@ -49,7 +51,7 @@ (should (eq test-cj-window-toggle--last-direction 'below)) (should (integerp test-cj-window-toggle--last-size)) (should (= test-cj-window-toggle--last-size - (window-body-height below)))))) + (window-total-height below)))))) (ert-deftest test-cj-window-toggle-capture-falls-back-to-default-direction () "Boundary: window filling the frame uses the supplied default direction." @@ -156,7 +158,9 @@ transfer; clearing it lets the consumer's default size apply." (should (eq (cdr (assq 'inhibit-same-window received-alist)) t)))) (ert-deftest test-cj-window-toggle-display-saved-maps-below-to-bottom () - "Normal: saved below + integer size -> bottom edge, body-lines cons." + "Normal: saved below + integer size -> bottom edge, plain total-line count. +The height axis replays a total-line integer (not a body-lines cons) so the +round-trip is immune to the mode line's pixel height." (let (received-alist (test-cj-window-toggle--last-direction 'below) (test-cj-window-toggle--last-size 12)) @@ -169,8 +173,7 @@ transfer; clearing it lets the consumer's default size apply." 'test-cj-window-toggle--last-size 0.7)) (should (eq (cdr (assq 'direction received-alist)) 'bottom)) - (should (equal (cdr (assq 'window-height received-alist)) - '(body-lines . 12))) + (should (equal (cdr (assq 'window-height received-alist)) 12)) (should-not (assq 'window-width received-alist)))) (ert-deftest test-cj-window-toggle-display-saved-maps-right-to-rightmost () diff --git a/tests/test-custom-datetime-all-methods.el b/tests/test-custom-datetime-all-methods.el index c9cfa41e2..62b421bdc 100644 --- a/tests/test-custom-datetime-all-methods.el +++ b/tests/test-custom-datetime-all-methods.el @@ -108,5 +108,19 @@ (cj/insert-sortable-date)) (should (string-prefix-p "before 2026-02-15" (buffer-string))))) +;;; Macro-generated commands stay interactive + +(ert-deftest test-custom-datetime-all-methods-are-interactive-commands () + "All six inserters generated by `cj/--define-datetime-inserter' are +interactive commands (so they keep working via M-x and the C-; d keymap)." + (dolist (cmd '(cj/insert-readable-date-time + cj/insert-sortable-date-time + cj/insert-sortable-time + cj/insert-readable-time + cj/insert-sortable-date + cj/insert-readable-date)) + (should (fboundp cmd)) + (should (commandp cmd)))) + (provide 'test-custom-datetime-all-methods) ;;; test-custom-datetime-all-methods.el ends here diff --git a/tests/test-custom-ordering--region-helpers.el b/tests/test-custom-ordering--region-helpers.el new file mode 100644 index 000000000..2ec747966 --- /dev/null +++ b/tests/test-custom-ordering--region-helpers.el @@ -0,0 +1,52 @@ +;;; test-custom-ordering--region-helpers.el --- Tests for the shared ordering region helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--ordering-validate-region and cj/--ordering-replace-region were extracted +;; from the seven pure ordering helpers (the copy-pasted start>end guard) and the +;; interactive ordering commands (the copy-pasted delete-region + insert tail). +;; The per-command behavior stays covered by the existing wrapper/transform +;; tests; these cover the extracted helpers directly. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-ordering) + +;;; cj/--ordering-validate-region + +(ert-deftest test-custom-ordering-validate-region-accepts-ordered () + "Normal: start < end returns nil without signalling." + (should (null (cj/--ordering-validate-region 1 10)))) + +(ert-deftest test-custom-ordering-validate-region-accepts-equal () + "Boundary: start = end (empty region) is allowed." + (should (null (cj/--ordering-validate-region 5 5)))) + +(ert-deftest test-custom-ordering-validate-region-rejects-inverted () + "Error: start > end signals with both positions in the message." + (let ((err (should-error (cj/--ordering-validate-region 10 3) :type 'error))) + (should (string-match-p "10" (error-message-string err))) + (should (string-match-p "3" (error-message-string err))))) + +;;; cj/--ordering-replace-region + +(ert-deftest test-custom-ordering-replace-region-swaps-text () + "Normal: the region between START and END is replaced with INSERTION and +point is left at START." + (with-temp-buffer + (insert "AAAABBBB") + (cj/--ordering-replace-region 1 5 "xx") ; replace the first AAAA + (should (equal "xxBBBB" (buffer-string))) + (should (= (point) 3)))) ; START (1) + len("xx") + +(ert-deftest test-custom-ordering-replace-region-empty-insertion () + "Boundary: an empty INSERTION just deletes the region." + (with-temp-buffer + (insert "keepDROP") + (cj/--ordering-replace-region 5 9 "") ; drop "DROP" (positions 5-8) + (should (equal "keep" (buffer-string))))) + +(provide 'test-custom-ordering--region-helpers) +;;; test-custom-ordering--region-helpers.el ends here diff --git a/tests/test-custom-text-enclose--enclose-region-or-word.el b/tests/test-custom-text-enclose--enclose-region-or-word.el new file mode 100644 index 000000000..4075fb050 --- /dev/null +++ b/tests/test-custom-text-enclose--enclose-region-or-word.el @@ -0,0 +1,62 @@ +;;; test-custom-text-enclose--enclose-region-or-word.el --- Tests for the shared enclose dispatch -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--enclose-region-or-word is the dispatch+edit skeleton extracted from +;; cj/surround/wrap/unwrap-word-or-region (region target, else word at point, +;; else a no-target message). The three commands stay covered by +;; test-custom-text-enclose-public-wrappers.el; these cover the helper directly, +;; including the custom and default no-target messages. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-text-enclose) + +(ert-deftest test-cte-enclose-region-target () + "Normal: an active region is the target; TRANSFORM is applied to it." + (with-temp-buffer + (let ((transient-mark-mode t)) + (insert "abc") + (goto-char (point-min)) + (push-mark (point) t t) + (goto-char (point-max)) + (cj/--enclose-region-or-word #'upcase)) + (should (equal (buffer-string) "ABC")) + (should (= (point) 4)))) ; after the inserted "ABC" (start 1 + 3) + +(ert-deftest test-cte-enclose-word-at-point-target () + "Normal: with no region, the word at point is the target." + (with-temp-buffer + (insert "foo bar") + (goto-char (point-min)) ; point on "foo" + (cj/--enclose-region-or-word (lambda (s) (concat "<" s ">"))) + (should (equal (buffer-string) "<foo> bar")))) + +(ert-deftest test-cte-enclose-no-target-default-message () + "Boundary: no region and no word => default message, buffer untouched." + (with-temp-buffer + (insert " ") ; whitespace, no word + (goto-char (point-min)) + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/--enclose-region-or-word #'upcase)) + (should (string-match-p "No word at point" msg)) + (should (equal (buffer-string) " "))))) + +(ert-deftest test-cte-enclose-no-target-custom-message () + "Boundary: a supplied NO-TARGET-MESSAGE overrides the default." + (with-temp-buffer + (insert " ") + (goto-char (point-min)) + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/--enclose-region-or-word #'upcase "custom no-target text")) + (should (equal msg "custom no-target text"))))) + +(provide 'test-custom-text-enclose--enclose-region-or-word) +;;; test-custom-text-enclose--enclose-region-or-word.el ends here diff --git a/tests/test-dirvish-config-hard-delete-command.el b/tests/test-dirvish-config-hard-delete-command.el new file mode 100644 index 000000000..eb12d2830 --- /dev/null +++ b/tests/test-dirvish-config-hard-delete-command.el @@ -0,0 +1,47 @@ +;;; test-dirvish-config-hard-delete-command.el --- Tests for cj/--dirvish-hard-delete-command -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--dirvish-hard-delete-command' is the pure string builder behind the +;; forced `sudo rm -rf' hard-delete bound to D in dirvish. It shell-quotes +;; every path and guards the list with `--' so a leading-dash or space-bearing +;; filename can't be misread. The interactive command (prompt + shell-command) +;; is verified live, not here. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'dirvish-config) + +(ert-deftest test-dirvish-config-hard-delete-command-multiple () + "Normal: two paths are quoted and joined behind `sudo rm -rf -- '." + (should (equal (cj/--dirvish-hard-delete-command '("/tmp/a.txt" "/tmp/b.txt")) + "sudo rm -rf -- /tmp/a.txt /tmp/b.txt"))) + +(ert-deftest test-dirvish-config-hard-delete-command-single () + "Boundary: a single path still carries the `--' option terminator." + (should (equal (cj/--dirvish-hard-delete-command '("/tmp/report.pdf")) + "sudo rm -rf -- /tmp/report.pdf"))) + +(ert-deftest test-dirvish-config-hard-delete-command-spaces-and-dash () + "Boundary: a path with spaces is shell-quoted, and `--' protects a +leading-dash filename from being read as an option." + (let ((cmd (cj/--dirvish-hard-delete-command + '("/tmp/my file.txt" "/tmp/-rf")))) + ;; `--' precedes the paths so `-rf' is a target, not an option. + (should (string-prefix-p "sudo rm -rf -- " cmd)) + ;; the space-bearing path is quoted (not a bare " " splitting the args). + (should (string-match-p (regexp-quote (shell-quote-argument "/tmp/my file.txt")) + cmd)) + (should (string-match-p (regexp-quote (shell-quote-argument "/tmp/-rf")) + cmd)))) + +(ert-deftest test-dirvish-config-hard-delete-command-empty () + "Error: an empty list yields just the prefix (no targets) -- the +interactive command never reaches here, guarding `No file at point' first." + (should (equal (cj/--dirvish-hard-delete-command '()) + "sudo rm -rf -- "))) + +(provide 'test-dirvish-config-hard-delete-command) +;;; test-dirvish-config-hard-delete-command.el ends here diff --git a/tests/test-dirvish-config-playlist.el b/tests/test-dirvish-config-playlist.el index d059a899a..14bb94ac7 100644 --- a/tests/test-dirvish-config-playlist.el +++ b/tests/test-dirvish-config-playlist.el @@ -10,6 +10,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (require 'package) (setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) @@ -93,5 +94,59 @@ lowercase extension list." (dolist (bad '("../evil" "../../etc/cron" "/etc/passwd" "sub/dir/name")) (should-not (cj/--playlist-name-safe-p bad)))) +;;; cj/--playlist-resolve-target +;; +;; Drives the real `file-exists-p' against a temp `music-dir' (mocking a C +;; primitive triggers a native-comp trampoline rebuild that fails under +;; --batch); only the ordinary `read-string' / `read-char-choice' prompts are +;; stubbed. + +(ert-deftest test-cj--playlist-resolve-target-returns-path-for-new-name () + "Normal: a safe name with no existing file returns its .m3u path under music-dir." + (let* ((music-dir (make-temp-file "cj-playlist-" t))) + (unwind-protect + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "roadtrip"))) + (should (equal (expand-file-name "roadtrip.m3u" music-dir) + (cj/--playlist-resolve-target)))) + (delete-directory music-dir t)))) + +(ert-deftest test-cj--playlist-resolve-target-reprompts-on-unsafe-name () + "Boundary: an unsafe name (with `/') re-prompts until a safe name is given." + (let* ((music-dir (make-temp-file "cj-playlist-" t)) + (answers '("../escape" "safe")) + (asked 0)) + (unwind-protect + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) (prog1 (nth asked answers) (cl-incf asked)))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (should (equal (expand-file-name "safe.m3u" music-dir) + (cj/--playlist-resolve-target))) + (should (= 2 asked))) + (delete-directory music-dir t)))) + +(ert-deftest test-cj--playlist-resolve-target-overwrite-returns-existing-path () + "Normal: when the target exists, choosing overwrite returns the same path." + (let* ((music-dir (make-temp-file "cj-playlist-" t)) + (existing (expand-file-name "mix.m3u" music-dir))) + (unwind-protect + (progn + (with-temp-file existing (insert "old\n")) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "mix")) + ((symbol-function 'read-char-choice) (lambda (&rest _) ?o))) + (should (equal existing (cj/--playlist-resolve-target))))) + (delete-directory music-dir t)))) + +(ert-deftest test-cj--playlist-resolve-target-cancel-signals-user-error () + "Error: when the target exists, choosing cancel aborts with a `user-error'." + (let* ((music-dir (make-temp-file "cj-playlist-" t)) + (existing (expand-file-name "mix.m3u" music-dir))) + (unwind-protect + (progn + (with-temp-file existing (insert "old\n")) + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "mix")) + ((symbol-function 'read-char-choice) (lambda (&rest _) ?c))) + (should-error (cj/--playlist-resolve-target) :type 'user-error))) + (delete-directory music-dir t)))) + (provide 'test-dirvish-config-playlist) ;;; test-dirvish-config-playlist.el ends here diff --git a/tests/test-dwim-shell-config-command-fixes.el b/tests/test-dwim-shell-config-command-fixes.el index 2f49a868f..2cc3ae72b 100644 --- a/tests/test-dwim-shell-config-command-fixes.el +++ b/tests/test-dwim-shell-config-command-fixes.el @@ -29,5 +29,60 @@ so the substitution can't sit dead inside single quotes." (should (string-match-p "\\.[0-9]\\{8\\}_[0-9]\\{6\\}\\.bak'" cmd)) (should-not (string-match-p "\\$(date" cmd)))) +;;; ----------------------- tar-gzip command builder -------------------------- + +(ert-deftest test-dwim-tar-gzip-command-single-names-after-file () + "Normal: a single marked file names the archive <fne>.tar.gz over <<f>>." + (let ((cmd (cj/dwim-shell--tar-gzip-command t))) + (should (string-match-p "'<<fne>>\\.tar\\.gz'" cmd)) + (should (string-match-p "'<<f>>'" cmd)))) + +(ert-deftest test-dwim-tar-gzip-command-multi-uses-shared-archive () + "Boundary: multiple files tar into a shared archive.tar.gz over <<*>>." + (let ((cmd (cj/dwim-shell--tar-gzip-command nil))) + (should (string-match-p "archive\\.tar\\.gz" cmd)) + (should (string-match-p "'<<\\*>>'" cmd)))) + +;;; --------------------- text-to-speech command builder ---------------------- + +(ert-deftest test-dwim-text-to-speech-command-darwin-uses-say-voice () + "Normal: on darwin the command uses `say' with the chosen voice." + (let ((cmd (cj/dwim-shell--text-to-speech-command 'darwin "Samantha"))) + (should (string-match-p "\\`say -v Samantha " cmd)) + (should (string-match-p "'<<fne>>\\.aiff'" cmd)))) + +(ert-deftest test-dwim-text-to-speech-command-linux-uses-espeak () + "Boundary: a non-darwin system uses `espeak' and ignores the voice." + (let ((cmd (cj/dwim-shell--text-to-speech-command 'gnu/linux "ignored"))) + (should (string-match-p "\\`espeak " cmd)) + (should (string-match-p "'<<fne>>\\.wav'" cmd)) + (should-not (string-match-p "ignored" cmd)))) + +;;; ----------------------- video-trim command builder ------------------------ + +(ert-deftest test-dwim-video-trim-command-beginning-uses-ss () + "Normal: trimming the beginning emits a leading -ss with the start seconds." + (let ((cmd (cj/dwim-shell--video-trim-command "Beginning" 7 0))) + (should (string-match-p "-ss 7 " cmd)) + (should-not (string-match-p "-sseof" cmd)))) + +(ert-deftest test-dwim-video-trim-command-end-uses-sseof () + "Normal: trimming the end emits -sseof with the end seconds, no -ss." + (let ((cmd (cj/dwim-shell--video-trim-command "End" 0 9))) + (should (string-match-p "-sseof -9 " cmd)) + (should-not (string-match-p "-ss [0-9]" cmd)))) + +(ert-deftest test-dwim-video-trim-command-both-uses-ss-and-sseof () + "Normal: trimming both ends emits both -ss start and -sseof end." + (let ((cmd (cj/dwim-shell--video-trim-command "Both" 3 4))) + (should (string-match-p "-ss 3 " cmd)) + (should (string-match-p "-sseof -4 " cmd)))) + +(ert-deftest test-dwim-video-trim-command-negative-seconds-errors () + "Error: a negative second count for the used side signals a user-error." + (should-error (cj/dwim-shell--video-trim-command "Beginning" -1 0) :type 'user-error) + (should-error (cj/dwim-shell--video-trim-command "End" 0 -1) :type 'user-error) + (should-error (cj/dwim-shell--video-trim-command "Both" 0 -2) :type 'user-error)) + (provide 'test-dwim-shell-config-command-fixes) ;;; test-dwim-shell-config-command-fixes.el ends here diff --git a/tests/test-elfeed-config--decode-html-entities.el b/tests/test-elfeed-config--decode-html-entities.el new file mode 100644 index 000000000..a3fba3c49 --- /dev/null +++ b/tests/test-elfeed-config--decode-html-entities.el @@ -0,0 +1,31 @@ +;;; test-elfeed-config--decode-html-entities.el --- Tests for cj/--decode-html-entities -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--decode-html-entities replaces the six inline replace-regexp-in-string +;; calls that cj/youtube-to-elfeed-feed-format used to hand-decode an og:title. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'elfeed-config) + +(ert-deftest test-elfeed-decode-html-entities-all () + "Normal: every supported entity is decoded." + (should (equal (cj/--decode-html-entities + "a & b <c> "d" 'e'") + "a & b <c> \"d\" 'e'"))) + +(ert-deftest test-elfeed-decode-html-entities-no-entities () + "Boundary: text without entities is unchanged." + (should (equal (cj/--decode-html-entities "plain title") "plain title")) + (should (equal (cj/--decode-html-entities "") ""))) + +(ert-deftest test-elfeed-decode-html-entities-amp-first () + "Boundary: & is decoded before the others (no double-decoding chains)." + (should (equal (cj/--decode-html-entities "Tom & Jerry <3") + "Tom & Jerry <3"))) + +(provide 'test-elfeed-config--decode-html-entities) +;;; test-elfeed-config--decode-html-entities.el ends here diff --git a/tests/test-erc-config--generate-buffer-name.el b/tests/test-erc-config--generate-buffer-name.el new file mode 100644 index 000000000..cbc716c82 --- /dev/null +++ b/tests/test-erc-config--generate-buffer-name.el @@ -0,0 +1,31 @@ +;;; test-erc-config--generate-buffer-name.el --- Tests for cj/erc-generate-buffer-name -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/erc-generate-buffer-name formats an ERC buffer name as SERVER-CHANNEL. +;; It was defined inside the erc use-package :config (so unreachable under +;; `make test'); lifting it to top level makes it unit-testable. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'erc-config) + +(ert-deftest test-erc-generate-buffer-name-server-and-channel () + "Normal: a target yields SERVER-CHANNEL." + (should (equal (cj/erc-generate-buffer-name '(:server "libera" :target "#emacs")) + "libera-#emacs"))) + +(ert-deftest test-erc-generate-buffer-name-server-only () + "Boundary: no target yields just the server name." + (should (equal (cj/erc-generate-buffer-name '(:server "libera")) + "libera"))) + +(ert-deftest test-erc-generate-buffer-name-missing-pieces () + "Boundary: missing server/target degrade to empty strings, not nil." + (should (equal (cj/erc-generate-buffer-name '(:target "#emacs")) "-#emacs")) + (should (equal (cj/erc-generate-buffer-name '()) ""))) + +(provide 'test-erc-config--generate-buffer-name) +;;; test-erc-config--generate-buffer-name.el ends here diff --git a/tests/test-font-config--frame-lifecycle.el b/tests/test-font-config--frame-lifecycle.el new file mode 100644 index 000000000..826edbd69 --- /dev/null +++ b/tests/test-font-config--frame-lifecycle.el @@ -0,0 +1,75 @@ +;;; test-font-config--frame-lifecycle.el --- Tests for the lifted font frame helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/apply-font-settings-to-frame, cj/cleanup-frame-list, and +;; cj/maybe-install-all-the-icons-fonts were defined inside use-package +;; :config / with-eval-after-load (unreachable under `make test'). Lifting +;; them to top level makes their branching unit-testable; env-gui-p and the +;; package side-effect calls are mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'font-config) + +(defvar cj/fontaine-configured-frames) + +(ert-deftest test-font-cleanup-frame-list-removes-frame () + "Normal: cleanup drops the given frame from the configured list." + (let ((cj/fontaine-configured-frames '(fr1 fr2 fr3))) + (cj/cleanup-frame-list 'fr2) + (should (equal cj/fontaine-configured-frames '(fr1 fr3))))) + +(ert-deftest test-font-apply-gui-unconfigured-sets-preset () + "Normal: a GUI frame not yet configured gets the preset and is tracked." + (let ((cj/fontaine-configured-frames nil) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should called) + (should (member (selected-frame) cj/fontaine-configured-frames)))) + +(ert-deftest test-font-apply-already-configured-is-noop () + "Boundary: an already-configured frame is not re-preset." + (let ((cj/fontaine-configured-frames (list (selected-frame))) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should-not called))) + +(ert-deftest test-font-apply-non-gui-is-noop () + "Boundary: without a GUI nothing is applied or tracked." + (let ((cj/fontaine-configured-frames nil) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () nil)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should-not called) + (should-not (member (selected-frame) cj/fontaine-configured-frames)))) + +(ert-deftest test-font-maybe-install-icons-gui-missing-installs () + "Normal: GUI present and font missing triggers the install." + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_n) nil)) + ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t))) + ((symbol-function 'remove-hook) #'ignore)) + (cj/maybe-install-all-the-icons-fonts)) + (should installed))) + +(ert-deftest test-font-maybe-install-icons-already-present-skips () + "Boundary: an installed font means no install attempt." + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_n) t)) + ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t)))) + (cj/maybe-install-all-the-icons-fonts)) + (should-not installed))) + +(provide 'test-font-config--frame-lifecycle) +;;; test-font-config--frame-lifecycle.el ends here diff --git a/tests/test-jumper--location-candidates.el b/tests/test-jumper--location-candidates.el new file mode 100644 index 000000000..df095830a --- /dev/null +++ b/tests/test-jumper--location-candidates.el @@ -0,0 +1,52 @@ +;;; test-jumper--location-candidates.el --- Tests for jumper--location-candidates -*- lexical-binding: t; -*- + +;;; Commentary: +;; jumper--location-candidates is the (display . index) builder extracted from +;; the verbatim cl-loop in jumper-jump-to-location and jumper-remove-location. +;; It composes jumper--format-location (which now goes through the extracted +;; jumper--with-marker-at). The wrappers cover it transitively; this exercises +;; it directly against stored locations. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'jumper) + +(ert-deftest test-jumper-location-candidates-one-pair-per-stored-location () + "Normal: one (display . index) pair per stored location, indices in order." + (let ((saved-regs jumper--registers) + (saved-idx jumper--next-index)) + (unwind-protect + (progn + (setq jumper--registers (make-vector jumper-max-locations nil) + jumper--next-index 0) + (with-temp-buffer + (insert "line one\nline two\nline three\n") + (goto-char (point-min)) + (should (integerp (jumper--do-store-location))) ; index 0 + (forward-line 2) + (should (integerp (jumper--do-store-location))) ; index 1 + (let ((cands (jumper--location-candidates))) + (should (= (length cands) 2)) + (should (equal (mapcar #'cdr cands) '(0 1))) + (should (stringp (car (nth 0 cands)))) + (should (stringp (car (nth 1 cands))))))) + (setq jumper--registers saved-regs + jumper--next-index saved-idx)))) + +(ert-deftest test-jumper-location-candidates-empty-when-none-stored () + "Boundary: no stored locations yields an empty candidate list." + (let ((saved-regs jumper--registers) + (saved-idx jumper--next-index)) + (unwind-protect + (progn + (setq jumper--registers (make-vector jumper-max-locations nil) + jumper--next-index 0) + (should (null (jumper--location-candidates)))) + (setq jumper--registers saved-regs + jumper--next-index saved-idx)))) + +(provide 'test-jumper--location-candidates) +;;; test-jumper--location-candidates.el ends here diff --git a/tests/test-mail-config--account-search-queries.el b/tests/test-mail-config--account-search-queries.el new file mode 100644 index 000000000..9f1b6b3e6 --- /dev/null +++ b/tests/test-mail-config--account-search-queries.el @@ -0,0 +1,53 @@ +;;; test-mail-config--account-search-queries.el --- Tests for the mail account-nav helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--mail-account-search-queries (pure: account name -> the four mu4e search +;; strings) and cj/--mail-make-account-map (builds the per-account nav keymap) +;; replace three near-identical defvar-keymap blocks that differed only by +;; maildir prefix. The map test invokes each binding with mu4e-search mocked, +;; which also verifies each loop-built closure captured its own query. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'mail-config) + +(ert-deftest test-mail-account-search-queries-cmail () + "Normal: the four searches are scoped to the account's INBOX maildir." + (should (equal (cj/--mail-account-search-queries "cmail") + '(("i" . "maildir:/cmail/INBOX") + ("u" . "maildir:/cmail/INBOX AND flag:unread AND NOT flag:trashed") + ("s" . "maildir:/cmail/INBOX AND flag:flagged") + ("l" . "maildir:/cmail/INBOX AND size:5M..999M"))))) + +(ert-deftest test-mail-account-search-queries-prefix-varies () + "Boundary: only the maildir prefix changes between accounts." + (should (equal (cdr (assoc "i" (cj/--mail-account-search-queries "dmail"))) + "maildir:/dmail/INBOX")) + (should (equal (cdr (assoc "i" (cj/--mail-account-search-queries "gmail"))) + "maildir:/gmail/INBOX"))) + +(ert-deftest test-mail-make-account-map-binds-four-keys () + "Normal: the built keymap binds i/u/s/l to commands." + (let ((map (cj/--mail-make-account-map "cmail"))) + (dolist (key '("i" "u" "s" "l")) + (should (commandp (keymap-lookup map key)))))) + +(ert-deftest test-mail-make-account-map-closures-capture-distinct-queries () + "Normal: each binding runs its own account-scoped search (no closure leak). +mu4e-search is mocked to capture the query each command passes." + (let ((searched '())) + (cl-letf (((symbol-function 'mu4e-search) + (lambda (q) (push q searched)))) + (let ((map (cj/--mail-make-account-map "dmail"))) + (funcall (keymap-lookup map "i")) + (funcall (keymap-lookup map "u")))) + (should (member "maildir:/dmail/INBOX" searched)) + (should (member "maildir:/dmail/INBOX AND flag:unread AND NOT flag:trashed" + searched)))) + +(provide 'test-mail-config--account-search-queries) +;;; test-mail-config--account-search-queries.el ends here diff --git a/tests/test-modeline-config--click-map.el b/tests/test-modeline-config--click-map.el new file mode 100644 index 000000000..6c5ba4c7e --- /dev/null +++ b/tests/test-modeline-config--click-map.el @@ -0,0 +1,29 @@ +;;; test-modeline-config--click-map.el --- Tests for cj/--modeline-click-map -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--modeline-click-map is the shared mode-line `local-map' builder extracted +;; from three clickable segments (buffer-name, vc, major-mode) that each spelled +;; out the same make-sparse-keymap + define-key dance. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'modeline-config) + +(ert-deftest test-modeline-click-map-binds-mouse-1-and-3 () + "Normal: with both commands, mouse-1 and mouse-3 are bound." + (let ((map (cj/--modeline-click-map 'vc-diff 'vc-root-diff))) + (should (keymapp map)) + (should (eq (lookup-key map [mode-line mouse-1]) 'vc-diff)) + (should (eq (lookup-key map [mode-line mouse-3]) 'vc-root-diff)))) + +(ert-deftest test-modeline-click-map-mouse-1-only () + "Boundary: with no MOUSE-3, only mouse-1 is bound." + (let ((map (cj/--modeline-click-map 'describe-mode))) + (should (eq (lookup-key map [mode-line mouse-1]) 'describe-mode)) + (should (null (lookup-key map [mode-line mouse-3]))))) + +(provide 'test-modeline-config--click-map) +;;; test-modeline-config--click-map.el ends here diff --git a/tests/test-mousetrap-mode--bind-events.el b/tests/test-mousetrap-mode--bind-events.el new file mode 100644 index 000000000..6772d6fa3 --- /dev/null +++ b/tests/test-mousetrap-mode--bind-events.el @@ -0,0 +1,41 @@ +;;; test-mousetrap-mode--bind-events.el --- Tests for mouse-trap--bind-events-to-ignore -*- lexical-binding: t; -*- + +;;; Commentary: +;; mouse-trap--bind-events-to-ignore is the per-category binding loop extracted +;; from mouse-trap--build-keymap-1 (which previously nested it five deep). It +;; binds a category's events, across modifier prefixes, to `ignore'. The full +;; keymap build stays covered by test-mousetrap-mode--build-keymap.el. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'mousetrap-mode) + +(ert-deftest test-mousetrap-bind-events-wheel () + "Normal: wheel events are bound to ignore across every prefix variant." + (let ((map (make-sparse-keymap)) + (spec '((wheel . ("wheel-up" "wheel-down"))))) + (mouse-trap--bind-events-to-ignore spec '("" "C-") map) + (should (eq (lookup-key map (kbd "<wheel-up>")) #'ignore)) + (should (eq (lookup-key map (kbd "<C-wheel-up>")) #'ignore)) + (should (eq (lookup-key map (kbd "<wheel-down>")) #'ignore)))) + +(ert-deftest test-mousetrap-bind-events-click () + "Normal: type x button click events are bound to ignore." + (let ((map (make-sparse-keymap)) + (spec '((types . ("mouse" "down-mouse")) (buttons . (1 3))))) + (mouse-trap--bind-events-to-ignore spec '("") map) + (should (eq (lookup-key map (kbd "<mouse-1>")) #'ignore)) + (should (eq (lookup-key map (kbd "<mouse-3>")) #'ignore)) + (should (eq (lookup-key map (kbd "<down-mouse-1>")) #'ignore)))) + +(ert-deftest test-mousetrap-bind-events-empty-spec-no-op () + "Boundary: a spec with neither wheel nor types/buttons binds nothing." + (let ((map (make-sparse-keymap))) + (mouse-trap--bind-events-to-ignore '((other . t)) '("") map) + (should (null (lookup-key map (kbd "<mouse-1>")))))) + +(provide 'test-mousetrap-mode--bind-events) +;;; test-mousetrap-mode--bind-events.el ends here diff --git a/tests/test-org-agenda-config--base-files.el b/tests/test-org-agenda-config--base-files.el new file mode 100644 index 000000000..c6939b4d7 --- /dev/null +++ b/tests/test-org-agenda-config--base-files.el @@ -0,0 +1,36 @@ +;;; test-org-agenda-config--base-files.el --- Tests for the agenda base-file helper -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-agenda-base-files is the single source of the fixed agenda base list +;; (inbox, schedule, and the three calendars) that was previously spelled out as +;; a literal in three places. The path vars are special (defvar'd in +;; user-constants), so they can be dynamically bound here. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-agenda-config) + +(ert-deftest test-org-agenda-base-files-returns-fixed-list-in-order () + "Normal: returns inbox, schedule, gcal, pcal, dcal in that order." + (let ((inbox-file "/i") + (schedule-file "/s") + (gcal-file "/g") + (pcal-file "/p") + (dcal-file "/d")) + (should (equal (cj/--org-agenda-base-files) + '("/i" "/s" "/g" "/p" "/d"))))) + +(ert-deftest test-org-agenda-base-files-reflects-current-values () + "Boundary: the helper reads the vars at call time (not a captured snapshot)." + (let ((inbox-file "first") + (schedule-file "x") (gcal-file "x") (pcal-file "x") (dcal-file "x")) + (should (equal (car (cj/--org-agenda-base-files)) "first")) + (setq inbox-file "second") + (should (equal (car (cj/--org-agenda-base-files)) "second")) + (should (= (length (cj/--org-agenda-base-files)) 5)))) + +(provide 'test-org-agenda-config--base-files) +;;; test-org-agenda-config--base-files.el ends here diff --git a/tests/test-org-capture-config--find-or-create-top-heading.el b/tests/test-org-capture-config--find-or-create-top-heading.el new file mode 100644 index 000000000..236c87c87 --- /dev/null +++ b/tests/test-org-capture-config--find-or-create-top-heading.el @@ -0,0 +1,45 @@ +;;; test-org-capture-config--find-or-create-top-heading.el --- Tests for the shared find-or-create helper -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-find-or-create-top-heading is the search-or-append positioning block +;; extracted from cj/org-capture--goto-file-headline, cj/--org-capture-goto-open-work, +;; and cj/--org-capture-goto-exact-headline. The three call sites stay covered by +;; test-org-capture-config-project-target.el (open-work, exact-headline) and the +;; target-cache test; these cover the generic helper directly with a plain regexp +;; (so the test doesn't depend on org's complex-heading format). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +(ert-deftest test-org-find-or-create-top-heading-finds-existing () + "Normal: an existing heading is found; point lands at its line start and the +buffer is unchanged." + (with-temp-buffer + (insert "* Alpha\nbody\n* Target\nmore\n") + (cj/--org-find-or-create-top-heading "^\\* Target$" "* Target") + (should (looking-at-p "\\* Target$")) + (should (equal (buffer-string) "* Alpha\nbody\n* Target\nmore\n")))) + +(ert-deftest test-org-find-or-create-top-heading-creates-when-absent () + "Boundary: with no match, the heading line is appended (a separating newline +added because the buffer doesn't end in one) and point lands on it." + (with-temp-buffer + (insert "some text") ; no trailing newline + (cj/--org-find-or-create-top-heading "^\\* Missing$" "* Missing") + (should (equal (buffer-string) "some text\n* Missing\n")) + (should (looking-at-p "\\* Missing$")))) + +(ert-deftest test-org-find-or-create-top-heading-empty-buffer () + "Boundary: in an empty buffer the heading is inserted at the top, no extra +leading newline." + (with-temp-buffer + (cj/--org-find-or-create-top-heading "^\\* X$" "* X") + (should (equal (buffer-string) "* X\n")) + (should (looking-at-p "\\* X$")))) + +(provide 'test-org-capture-config--find-or-create-top-heading) +;;; test-org-capture-config--find-or-create-top-heading.el ends here diff --git a/tests/test-prog-general--deadgrep.el b/tests/test-prog-general--deadgrep.el new file mode 100644 index 000000000..21223105d --- /dev/null +++ b/tests/test-prog-general--deadgrep.el @@ -0,0 +1,44 @@ +;;; test-prog-general--deadgrep.el --- Tests for the deadgrep helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/deadgrep--initial-term (region text or symbol at point) and cj/--deadgrep-run +;; (the normalize-root + read-term + invoke tail shared by cj/deadgrep-here and +;; cj/deadgrep-in-dir) were lifted out of the deadgrep use-package :config. +;; deadgrep is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(ert-deftest test-prg-deadgrep-initial-term-symbol-at-point () + "Normal: with no region, the symbol at point seeds the search." + (with-temp-buffer + (insert "hello world") + (goto-char (point-min)) + (should (equal (cj/deadgrep--initial-term) "hello")))) + +(ert-deftest test-prg-deadgrep-initial-term-region () + "Normal: an active region's text seeds the search." + (with-temp-buffer + (insert "needle") + (transient-mark-mode 1) + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (should (equal (cj/deadgrep--initial-term) "needle")))) + +(ert-deftest test-prg-deadgrep-run-normalizes-root-and-passes-term () + "Normal: ROOT is normalized to a directory and TERM is passed through." + (let (got-term got-root) + (cl-letf (((symbol-function 'deadgrep) + (lambda (term root) (setq got-term term got-root root)))) + (cj/--deadgrep-run "/tmp/foo" "needle")) + (should (equal got-term "needle")) + (should (equal got-root "/tmp/foo/")))) + +(provide 'test-prog-general--deadgrep) +;;; test-prog-general--deadgrep.el ends here diff --git a/tests/test-prog-general--find-project-root-file.el b/tests/test-prog-general--find-project-root-file.el new file mode 100644 index 000000000..97db0b979 --- /dev/null +++ b/tests/test-prog-general--find-project-root-file.el @@ -0,0 +1,49 @@ +;;; test-prog-general--find-project-root-file.el --- Tests for cj/find-project-root-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/find-project-root-file returns the first file in the current Projectile +;; project root matching a regexp (string or rx form), case-insensitively. It +;; was defined inside the projectile use-package :config (unreachable under +;; `make test'); lifting it to top level makes it unit-testable. projectile's +;; root and directory-files are mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'seq) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(defmacro test-prg--with-root (files &rest body) + "Run BODY with projectile-project-root \"/proj/\" and directory-files = FILES." + (declare (indent 1)) + `(cl-letf (((symbol-function 'projectile-project-root) (lambda (&rest _) "/proj/")) + ((symbol-function 'directory-files) (lambda (&rest _) ,files))) + ,@body)) + +(ert-deftest test-prg-find-root-file-string-regexp () + "Normal: a string regexp matches case-insensitively." + (test-prg--with-root '("README.md" "TODO.org" "src") + (should (equal (cj/find-project-root-file "^todo\\.org$") "TODO.org")))) + +(ert-deftest test-prg-find-root-file-rx-form () + "Normal: an rx form is converted and matched." + (test-prg--with-root '("notes.txt" "todo.md" "x") + (should (equal (cj/find-project-root-file + '(seq bos "todo." (or "org" "md" "txt") eos)) + "todo.md")))) + +(ert-deftest test-prg-find-root-file-no-match () + "Boundary: no matching file yields nil." + (test-prg--with-root '("a.el" "b.el") + (should (null (cj/find-project-root-file "^todo\\.org$"))))) + +(ert-deftest test-prg-find-root-file-no-project () + "Boundary: outside a project (nil root) yields nil." + (cl-letf (((symbol-function 'projectile-project-root) (lambda (&rest _) nil))) + (should (null (cj/find-project-root-file "^todo\\.org$"))))) + +(provide 'test-prog-general--find-project-root-file) +;;; test-prog-general--find-project-root-file.el ends here diff --git a/tests/test-system-lib--format-region-with-program.el b/tests/test-system-lib--format-region-with-program.el new file mode 100644 index 000000000..29b392b84 --- /dev/null +++ b/tests/test-system-lib--format-region-with-program.el @@ -0,0 +1,68 @@ +;;; test-system-lib--format-region-with-program.el --- Tests for cj/format-region-with-program -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/format-region-with-program' runs an external formatter over the whole +;; buffer via `call-process-region' (argv, no shell) and replaces the buffer +;; only when the program exits zero. Extracted from the byte-identical +;; per-language helpers in prog-json.el / prog-yaml.el, so this is the first +;; direct unit coverage of the logic. call-process-region is mocked at the +;; boundary (the established pattern in test-prog-json--json-format-buffer.el). + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'system-lib) + +(ert-deftest test-system-lib-format-region-with-program-replaces-on-success () + "Normal: on exit 0 the buffer is replaced with the program's output, returns t." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest rest) + (with-current-buffer (nth 1 rest) (insert "FORMATTED")) + 0))) + (with-temp-buffer + (insert "raw") + (should (eq t (cj/format-region-with-program "fmt"))) + (should (equal "FORMATTED" (buffer-string)))))) + +(ert-deftest test-system-lib-format-region-with-program-forwards-argv () + "Normal: PROGRAM and ARGS reach call-process-region as argv (no shell)." + (let (got-prog got-args) + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end prog &rest rest) + (setq got-prog prog + got-args (nthcdr 3 rest)) + (with-current-buffer (nth 1 rest) (insert "x")) + 0))) + (with-temp-buffer + (cj/format-region-with-program "jq" "--sort-keys" "."))) + (should (equal "jq" got-prog)) + (should (equal '("--sort-keys" ".") got-args)))) + +(ert-deftest test-system-lib-format-region-with-program-empty-output () + "Boundary: empty program output empties the buffer and still returns t." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest _rest) 0))) ; writes nothing + (with-temp-buffer + (insert "raw") + (should (eq t (cj/format-region-with-program "fmt"))) + (should (equal "" (buffer-string)))))) + +(ert-deftest test-system-lib-format-region-with-program-nonzero-untouched () + "Error: a non-zero exit leaves the buffer untouched and signals user-error +carrying the program's stderr text." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest rest) + (with-current-buffer (nth 1 rest) (insert "boom: bad input")) + 1))) + (with-temp-buffer + (insert "raw") + (let ((err (should-error (cj/format-region-with-program "fmt") + :type 'user-error))) + (should (string-match-p "boom: bad input" (error-message-string err)))) + (should (equal "raw" (buffer-string)))))) + +(provide 'test-system-lib--format-region-with-program) +;;; test-system-lib--format-region-with-program.el ends here diff --git a/tests/test-term-toggle--display.el b/tests/test-term-toggle--display.el index 7fa7f0a98..d6dd33da2 100644 --- a/tests/test-term-toggle--display.el +++ b/tests/test-term-toggle--display.el @@ -17,7 +17,9 @@ (require 'term-config) (ert-deftest test-term-toggle--capture-state-records-direction-and-size () - "Normal: capture-state writes direction and integer body size." + "Normal: capture-state writes direction and integer size. +The vertical axis captures total-height (not body-height) so the toggle +round-trip is immune to the mode line's pixel height." (save-window-excursion (delete-other-windows) (let ((below (split-window (selected-window) nil 'below)) @@ -26,7 +28,7 @@ (cj/--term-toggle-capture-state below) (should (eq cj/--term-toggle-last-direction 'below)) (should (integerp cj/--term-toggle-last-size)) - (should (= cj/--term-toggle-last-size (window-body-height below)))))) + (should (= cj/--term-toggle-last-size (window-total-height below)))))) (ert-deftest test-term-toggle--capture-state-noop-on-dead-window () "Boundary: nil window -> state remains unchanged." @@ -50,7 +52,9 @@ (should (eq (cdr (assq 'inhibit-same-window received-alist)) t)))) (ert-deftest test-term-toggle--display-saved-maps-cardinal-to-edge () - "Normal: saved 'below maps to bottom edge; integer size wraps in body-lines." + "Normal: saved 'below maps to bottom edge; integer size is a plain total-line count. +The height axis replays a total-line integer (not a body-lines cons) so the +round-trip is immune to the mode line's pixel height." (let (received-alist (cj/--term-toggle-last-direction 'below) (cj/--term-toggle-last-size 12)) @@ -58,8 +62,7 @@ (lambda (_b a) (setq received-alist a) 'fake-window))) (cj/--term-toggle-display-saved 'fake-buf nil)) (should (eq (cdr (assq 'direction received-alist)) 'bottom)) - (should (equal (cdr (assq 'window-height received-alist)) - '(body-lines . 12))) + (should (equal (cdr (assq 'window-height received-alist)) 12)) (should-not (assq 'window-width received-alist)))) (ert-deftest test-term-toggle--display-saved-strips-conflicting-alist-entries () diff --git a/tests/test-ui-navigation--window-resize.el b/tests/test-ui-navigation--window-resize.el index 3be0313b8..553219755 100644 --- a/tests/test-ui-navigation--window-resize.el +++ b/tests/test-ui-navigation--window-resize.el @@ -24,8 +24,11 @@ (should (eq (keymap-lookup cj/window-resize-map "<down>") #'windsize-down))) (ert-deftest test-ui-navigation-window-resize-sticky-dispatches-and-arms () - "Normal: `cj/window-resize-sticky' runs the `windsize' command matching the -arrow key that triggered it, then arms the sticky-repeat map." + "Normal: with more than one window, `cj/window-resize-sticky' runs the +`windsize' command matching the arrow key that triggered it, then arms the +sticky-repeat map. `one-window-p' is forced nil so the resize path is taken +deterministically -- in `--batch' the sole frame is one-window-p, which would +otherwise route to the pull-away path." (dolist (case '((left . windsize-left) (right . windsize-right) (up . windsize-up) @@ -33,13 +36,45 @@ arrow key that triggered it, then arms the sticky-repeat map." (let ((ran nil) (overriding-terminal-local-map nil) (pre-command-hook nil)) - (cl-letf (((symbol-function (cdr case)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) nil)) + ((symbol-function (cdr case)) (lambda (&rest _) (interactive) (setq ran t)))) (let ((last-command-event (car case))) (cj/window-resize-sticky))) (should ran) ; dispatched to the right command (should overriding-terminal-local-map)))) ; loop armed +(ert-deftest test-ui-navigation-window-pull-side () + "Normal/Error: each arrow maps to the *opposite* side (where the revealed +window opens, so the current window keeps the arrow's edge); anything else +is nil." + (should (eq (cj/window-pull-side "<down>") 'above)) + (should (eq (cj/window-pull-side "<up>") 'below)) + (should (eq (cj/window-pull-side "<left>") 'right)) + (should (eq (cj/window-pull-side "<right>") 'left)) + (should (null (cj/window-pull-side "<prior>"))) + (should (null (cj/window-pull-side "x")))) + +(ert-deftest test-ui-navigation-window-resize-sticky-sole-window-pulls-away () + "Normal: with a single window, the arrow pulls a sliver away on the side +opposite the arrow (via `cj/window--pull-away') rather than resizing, then +arms the loop. `cj/window--pull-away' is stubbed to capture the side so no +real window split happens under `--batch'." + (dolist (case '((down . above) + (up . below) + (left . right) + (right . left))) + (let ((pulled nil) + (overriding-terminal-local-map nil) + (pre-command-hook nil)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) t)) + ((symbol-function 'cj/window--pull-away) + (lambda (dir) (setq pulled dir)))) + (let ((last-command-event (car case))) + (cj/window-resize-sticky))) + (should (eq pulled (cdr case))) ; pulled toward the arrow + (should overriding-terminal-local-map)))) ; loop armed + (ert-deftest test-ui-navigation-window-resize-bound-under-c-semicolon-b () "Normal: `C-; b <arrow>' (each direction) reaches the sticky-resize command." (require 'custom-buffer-file) diff --git a/tests/test-ui-theme-commands.el b/tests/test-ui-theme-commands.el index 4e3ce7f28..1b273cf57 100644 --- a/tests/test-ui-theme-commands.el +++ b/tests/test-ui-theme-commands.el @@ -7,7 +7,6 @@ ;; cj/switch-themes ;; cj/save-theme-to-file ;; cj/get-active-theme-name -;; cj/load-fallback-theme ;;; Code: @@ -68,23 +67,6 @@ does not raise." (cj/save-theme-to-file)) (should (string-match-p "Cannot save theme" messaged)))) -;;; cj/load-fallback-theme - -(ert-deftest test-ui-theme-load-fallback-disables-then-loads () - "Normal: load-fallback-theme disables all then loads the fallback." - (let ((fallback-theme-name "modus-vivendi") - (custom-enabled-themes '(old-one old-two)) - disabled loaded) - (cl-letf (((symbol-function 'disable-theme) - (lambda (theme) (push theme disabled))) - ((symbol-function 'load-theme) - (lambda (theme &optional _no-confirm _no-enable) - (push theme loaded))) - ((symbol-function 'message) #'ignore)) - (cj/load-fallback-theme "boom")) - (should (equal (sort (copy-sequence disabled) #'string<) '(old-one old-two))) - (should (equal loaded '(modus-vivendi))))) - ;;; cj/switch-themes (ert-deftest test-ui-theme-switch-disables-loads-then-saves () |