diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-auto-dim-config.el | 7 | ||||
| -rw-r--r-- | tests/test-browser-config--preferred-default.el | 89 | ||||
| -rw-r--r-- | tests/test-calendar-sync--syncing-p.el | 116 | ||||
| -rw-r--r-- | tests/test-calendar-sync.el | 45 | ||||
| -rw-r--r-- | tests/test-calibredb-epub-config--epub-mode.el | 70 | ||||
| -rw-r--r-- | tests/test-calibredb-epub-config.el | 51 | ||||
| -rw-r--r-- | tests/test-help-utils--arch-wiki-search.el | 124 | ||||
| -rw-r--r-- | tests/test-hugo-config--keymap.el | 71 | ||||
| -rw-r--r-- | tests/test-integration-org-agenda-frame-load-order.el | 80 | ||||
| -rw-r--r-- | tests/test-integration-recording-device-workflow.el | 178 | ||||
| -rw-r--r-- | tests/test-media-utils--yt-dl-message.el | 64 | ||||
| -rw-r--r-- | tests/test-org-agenda-frame.el | 13 | ||||
| -rw-r--r-- | tests/test-org-refile-config--advice-helpers.el | 87 | ||||
| -rw-r--r-- | tests/test-pre-commit-hook.bats | 126 | ||||
| -rw-r--r-- | tests/test-system-defaults-functions.el | 31 | ||||
| -rw-r--r-- | tests/test-validate-el-hook.bats | 97 | ||||
| -rw-r--r-- | tests/test-video-audio-recording-group-devices-by-hardware.el | 194 | ||||
| -rw-r--r-- | tests/test-wrap-up--bury-buffers.el | 96 |
18 files changed, 1080 insertions, 459 deletions
diff --git a/tests/test-auto-dim-config.el b/tests/test-auto-dim-config.el index 12435fa0..dcab7eff 100644 --- a/tests/test-auto-dim-config.el +++ b/tests/test-auto-dim-config.el @@ -30,7 +30,12 @@ (progn (should (bound-and-true-p auto-dim-other-buffers-mode)) (should (null auto-dim-other-buffers-dim-on-focus-out)) - (should (eq t auto-dim-other-buffers-dim-on-switch-to-minibuffer)) + ;; Entering the minibuffer must not change what is dimmed: a dim window + ;; stays dim, a lit one stays lit. The fork's `adob--update' returns + ;; early when this is nil and the selected window is the minibuffer, so + ;; nil is what keeps a minibuffer prompt from re-dimming the window the + ;; user was just in. + (should (null auto-dim-other-buffers-dim-on-switch-to-minibuffer)) (should-not (assq 'fringe auto-dim-other-buffers-affected-faces))) (when (fboundp 'auto-dim-other-buffers-mode) (auto-dim-other-buffers-mode -1)))) diff --git a/tests/test-browser-config--preferred-default.el b/tests/test-browser-config--preferred-default.el new file mode 100644 index 00000000..113ad540 --- /dev/null +++ b/tests/test-browser-config--preferred-default.el @@ -0,0 +1,89 @@ +;;; test-browser-config--preferred-default.el --- Tests for the first-run browser pick -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/--preferred-default-browser, the pure helper that picks +;; the first-run default when no saved choice exists. +;; +;; The behavior it fixes: EWW is listed first in `cj/browser-definitions' and +;; carries a nil executable, so `cj/discover-browsers' always reports it as +;; available and it sorted first. A fresh machine therefore opened every org +;; link in the Emacs text browser until the user found cj/choose-browser, even +;; with Chrome or Firefox installed. The helper prefers a real external +;; browser and keeps EWW as the genuine last resort. +;; +;; The helper takes the discovered list as an argument rather than calling +;; `cj/discover-browsers' itself, so these tests drive real data structures +;; and never stub executable-find. +;; +;; Test organization: +;; - Normal Cases: external browser preferred over a leading built-in +;; - Boundary Cases: only built-ins, only externals, single entry, empty list +;; - Error Cases: entries missing the :executable key +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'browser-config) + +(defconst test-browser--eww + '(:executable nil :function eww-browse-url :name "EWW (Emacs Browser)" + :path nil :program-var nil)) + +(defconst test-browser--chrome + '(:executable "google-chrome" :function browse-url-chrome :name "Google Chrome" + :path "/usr/bin/google-chrome" :program-var browse-url-chrome-program)) + +(defconst test-browser--firefox + '(:executable "firefox" :function browse-url-firefox :name "Firefox" + :path "/usr/bin/firefox" :program-var browse-url-firefox-program)) + +;;; Normal Cases + +(ert-deftest test-browser-config-preferred-default-skips-leading-builtin () + "Normal: an installed external browser wins over a built-in listed first." + (should (equal (cj/--preferred-default-browser + (list test-browser--eww test-browser--chrome)) + test-browser--chrome))) + +(ert-deftest test-browser-config-preferred-default-keeps-external-order () + "Normal: the FIRST external in list order wins, not merely any external." + (should (equal (cj/--preferred-default-browser + (list test-browser--eww test-browser--chrome test-browser--firefox)) + test-browser--chrome))) + +;;; Boundary Cases + +(ert-deftest test-browser-config-preferred-default-builtin-only-falls-back () + "Boundary: with no external installed, the built-in is still chosen." + (should (equal (cj/--preferred-default-browser (list test-browser--eww)) + test-browser--eww))) + +(ert-deftest test-browser-config-preferred-default-external-only () + "Boundary: a list of externals returns the first one." + (should (equal (cj/--preferred-default-browser + (list test-browser--firefox test-browser--chrome)) + test-browser--firefox))) + +(ert-deftest test-browser-config-preferred-default-empty-list-is-nil () + "Boundary: an empty discovery result yields nil, never an error." + (should (null (cj/--preferred-default-browser '())))) + +(ert-deftest test-browser-config-preferred-default-single-builtin () + "Boundary: a one-element built-in list returns that element." + (should (equal (cj/--preferred-default-browser (list test-browser--eww)) + test-browser--eww))) + +;;; Error Cases + +(ert-deftest test-browser-config-preferred-default-missing-executable-key () + "Error: a plist with no :executable key counts as built-in, not a crash." + (let ((malformed '(:name "Odd" :function ignore))) + (should (equal (cj/--preferred-default-browser + (list malformed test-browser--chrome)) + test-browser--chrome)) + (should (equal (cj/--preferred-default-browser (list malformed)) + malformed)))) + +(provide 'test-browser-config--preferred-default) +;;; test-browser-config--preferred-default.el ends here diff --git a/tests/test-calendar-sync--syncing-p.el b/tests/test-calendar-sync--syncing-p.el index b346bf77..df8bcd52 100644 --- a/tests/test-calendar-sync--syncing-p.el +++ b/tests/test-calendar-sync--syncing-p.el @@ -4,81 +4,111 @@ ;; Unit tests for `calendar-sync--syncing-p' (the per-calendar in-flight check ;; that lets the dispatcher skip an overlapping timer tick) and for the ;; load-state sanitize that clears a stale `syncing' status in a fresh process. +;; +;; Every test runs inside `test-cs-syncing--with-fresh-state', which let-binds +;; a private state hash. These tests previously cleared the module's global +;; hash on entry and left whatever they wrote in it on exit, which leaked: +;; `...-sync-calendar-skips-when-in-flight' marks "proton" as syncing to +;; exercise the guard, and `test-calendar-sync--sync-dispatch-normal-ics-fetcher' +;; in the sibling dispatch file dispatches a calendar also named "proton". +;; ERT runs them in that order, so the leftover in-flight status made the +;; dispatch a no-op and the sibling failed -- but only when the calendar-sync +;; files ran in one process. `make test' runs each file separately and the +;; editor hook skipped this family for being over its file cap, so nothing +;; caught it. Let-binding is what the sibling files already do +;; (test-calendar-sync.el, test-calendar-sync-async-worker.el); this file was +;; the odd one out. ;;; Code: (require 'ert) (require 'calendar-sync) -(defun test-cs-syncing--reset () - "Clear the module's per-calendar state hash." - (clrhash calendar-sync--calendar-states)) +(defmacro test-cs-syncing--with-fresh-state (&rest body) + "Run BODY with a private, empty per-calendar state hash. +Let-bound rather than cleared in place, so nothing this test writes can +reach a later test." + (declare (indent 0)) + `(let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + ,@body)) ;;; calendar-sync--syncing-p (ert-deftest test-calendar-sync--syncing-p-normal-true-when-syncing () "Normal: a calendar whose status is `syncing' reads as in-flight." - (test-cs-syncing--reset) - (calendar-sync--set-calendar-state "google" '(:status syncing)) - (should (calendar-sync--syncing-p "google"))) + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "google" '(:status syncing)) + (should (calendar-sync--syncing-p "google")))) (ert-deftest test-calendar-sync--syncing-p-boundary-nil-when-no-state () "Boundary: a calendar with no recorded state is not in-flight." - (test-cs-syncing--reset) - (should-not (calendar-sync--syncing-p "never-seen"))) + (test-cs-syncing--with-fresh-state + (should-not (calendar-sync--syncing-p "never-seen")))) (ert-deftest test-calendar-sync--syncing-p-error-nil-for-terminal-status () "Error: a terminal status (ok / error) is not in-flight." - (test-cs-syncing--reset) - (calendar-sync--set-calendar-state "google" '(:status ok)) - (should-not (calendar-sync--syncing-p "google")) - (calendar-sync--set-calendar-state "proton" '(:status error)) - (should-not (calendar-sync--syncing-p "proton"))) + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "google" '(:status ok)) + (should-not (calendar-sync--syncing-p "google")) + (calendar-sync--set-calendar-state "proton" '(:status error)) + (should-not (calendar-sync--syncing-p "proton")))) ;;; Dispatcher guard: an in-flight calendar skips both leaf syncers (ert-deftest test-calendar-sync--sync-calendar-skips-when-in-flight () "Normal: `calendar-sync--sync-calendar' does not launch a second sync for a calendar already marked syncing, so an overlapping timer tick is a no-op." - (test-cs-syncing--reset) - (let ((api-calls '()) (ics-calls '())) - (cl-letf (((symbol-function 'calendar-sync--sync-calendar-api) - (lambda (cal) (push cal api-calls))) - ((symbol-function 'calendar-sync--sync-calendar-ics) - (lambda (cal) (push cal ics-calls)))) - (calendar-sync--set-calendar-state "proton" '(:status syncing)) - (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" - :file "/tmp/c.org")) - (should (null api-calls)) - (should (null ics-calls))))) + (test-cs-syncing--with-fresh-state + (let ((api-calls '()) (ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-api) + (lambda (cal) (push cal api-calls))) + ((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--set-calendar-state "proton" '(:status syncing)) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (null api-calls)) + (should (null ics-calls)))))) (ert-deftest test-calendar-sync--sync-calendar-dispatches-when-idle () "Boundary: an idle calendar (no in-flight status) still dispatches normally." - (test-cs-syncing--reset) - (let ((ics-calls '())) - (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) - (lambda (cal) (push cal ics-calls)))) - (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" - :file "/tmp/c.org")) - (should (= 1 (length ics-calls)))))) + (test-cs-syncing--with-fresh-state + (let ((ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (= 1 (length ics-calls))))))) + +;;; Isolation guard + +(ert-deftest test-calendar-sync--syncing-state-does-not-leak () + "Error: state written inside the macro is gone once it returns. +Pins the isolation itself. Without it a test marking a calendar syncing +leaves that status set for every later test in the same process, which is +exactly what broke the sibling dispatch test." + (test-cs-syncing--with-fresh-state + (calendar-sync--set-calendar-state "leak-probe" '(:status syncing)) + (should (calendar-sync--syncing-p "leak-probe"))) + (should-not (calendar-sync--syncing-p "leak-probe"))) ;;; load-state sanitize: a persisted `syncing' status is cleared on load (ert-deftest test-calendar-sync--load-state-clears-stale-syncing () "Error: a `syncing' status persisted before a crash is reset on load, so the in-flight guard cannot skip that calendar forever in the new session." - (test-cs-syncing--reset) - (let* ((dir (make-temp-file "cs-state-" t)) - (calendar-sync--state-file (expand-file-name "state.el" dir))) - (unwind-protect - (progn - (with-temp-file calendar-sync--state-file - (prin1 '((timezone-offset . nil) - (calendar-states . (("google" . (:status syncing))))) - (current-buffer))) - (calendar-sync--load-state) - (should-not (calendar-sync--syncing-p "google"))) - (delete-directory dir t)))) + (test-cs-syncing--with-fresh-state + (let* ((dir (make-temp-file "cs-state-" t)) + (calendar-sync--state-file (expand-file-name "state.el" dir))) + (unwind-protect + (progn + (with-temp-file calendar-sync--state-file + (prin1 '((timezone-offset . nil) + (calendar-states . (("google" . (:status syncing))))) + (current-buffer))) + (calendar-sync--load-state) + (should-not (calendar-sync--syncing-p "google"))) + (delete-directory dir t))))) (provide 'test-calendar-sync--syncing-p) ;;; test-calendar-sync--syncing-p.el ends here diff --git a/tests/test-calendar-sync.el b/tests/test-calendar-sync.el index f562cfc6..8a7c2549 100644 --- a/tests/test-calendar-sync.el +++ b/tests/test-calendar-sync.el @@ -713,5 +713,50 @@ Valid events should be parsed, invalid ones skipped." (should-not (and org-content (string-match-p "OutOfRangeEvent" org-content))))) +;;; calendar-sync--sync-timer-function — hourly-timer body hygiene + +(ert-deftest test-calendar-sync-timer-function-does-not-propagate-a-signal () + "Error: a signal in the timer body is caught, not propagated. +The function runs from an hourly `run-at-time' timer. An unguarded signal +in the timezone check or the sync fan-out would error on every tick — the +same error, once an hour, forever. It must swallow-and-log instead." + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) + (lambda (&rest _) (error "boom from the timezone check"))) + ((symbol-function 'calendar-sync--sync-all-calendars) #'ignore) + ((symbol-function 'calendar-sync--log-silently) #'ignore)) + ;; Must return normally rather than signal. + (should (progn (calendar-sync--sync-timer-function) t)))) + +(ert-deftest test-calendar-sync-timer-function-signal-in-sync-is-caught () + "Error: a signal from the sync fan-out is also caught, not propagated." + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) #'ignore) + ((symbol-function 'calendar-sync--sync-all-calendars) + (lambda (&rest _) (error "boom from sync-all"))) + ((symbol-function 'calendar-sync--log-silently) #'ignore)) + (should (progn (calendar-sync--sync-timer-function) t)))) + +(ert-deftest test-calendar-sync-timer-function-timezone-change-is-not-echoed () + "Normal: a detected timezone change is logged silently, not echoed. +An hourly timer that calls `message' spams the echo area; the notice belongs +in the silent log like the module's other timer-path notices." + (let (silent-logged echoed) + (cl-letf (((symbol-function 'calendar-sync--timezone-changed-p) + (lambda (&rest _) t)) + ((symbol-function 'calendar-sync--format-timezone-offset) + (lambda (&rest _) "UTC+0")) + ((symbol-function 'calendar-sync--current-timezone-offset) + (lambda (&rest _) 0)) + ((symbol-function 'calendar-sync--sync-all-calendars) #'ignore) + ((symbol-function 'calendar-sync--log-silently) + (lambda (fmt &rest _) (when (string-match-p "Timezone" fmt) + (setq silent-logged t)))) + ((symbol-function 'message) + (lambda (fmt &rest _) (when (and (stringp fmt) + (string-match-p "Timezone" fmt)) + (setq echoed t))))) + (calendar-sync--sync-timer-function) + (should silent-logged) + (should-not echoed)))) + (provide 'test-calendar-sync) ;;; test-calendar-sync.el ends here diff --git a/tests/test-calibredb-epub-config--epub-mode.el b/tests/test-calibredb-epub-config--epub-mode.el new file mode 100644 index 00000000..a65bdabf --- /dev/null +++ b/tests/test-calibredb-epub-config--epub-mode.el @@ -0,0 +1,70 @@ +;;; test-calibredb-epub-config--epub-mode.el --- Tests for epub mode resolution -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests that .epub files reach nov-mode through `auto-mode-alist' alone, with +;; no advice on `set-auto-mode'. +;; +;; Background: the module used to carry an :around advice on `set-auto-mode' +;; forcing nov-mode for .epub, added to keep `magic-fallback-mode-alist' from +;; opening the zip container in archive-mode. It was never needed. +;; `set-auto-mode' consults `auto-mode-alist' before `magic-fallback-mode-alist', +;; and nov's use-package :mode registers "\\.epub\\'" there, so the alist +;; already won. Verified live on the daemon: a real zip-format .epub opened in +;; nov-mode both with the advice and with it removed. +;; +;; The advice was not free. `set-auto-mode' runs on every file visit, so the +;; advice put a redundant frame and an extra failure surface on the path for +;; every file of every type. +;; +;; The second test is a regression guard: it fails if the advice is ever +;; reinstated, which is the mistake this cleanup exists to prevent. +;; +;; Test organization: +;; - Normal Cases: .epub resolves to nov-mode; no advice on set-auto-mode +;; - Boundary Cases: a path merely containing "epub", and a bare "epub" name +;; - Error Cases: an unrelated extension does not resolve to nov-mode +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calibredb-epub-config) + +(defun test-epub-mode--resolve (filename) + "Return the major mode `auto-mode-alist' assigns to FILENAME." + (assoc-default filename auto-mode-alist 'string-match)) + +;;; Normal Cases + +(ert-deftest test-calibredb-epub-config-epub-resolves-to-nov-mode () + "Normal: auto-mode-alist maps a .epub file to nov-mode on its own." + (should (eq 'nov-mode (test-epub-mode--resolve "book.epub")))) + +(ert-deftest test-calibredb-epub-config-no-set-auto-mode-advice () + "Normal: nothing advises set-auto-mode to force nov-mode. +Regression guard. auto-mode-alist already wins over +magic-fallback-mode-alist, so an advice here would be redundant work on +every file visit." + (should-not (advice-member-p 'cj/force-nov-mode-for-epub 'set-auto-mode)) + (should-not (fboundp 'cj/force-nov-mode-for-epub))) + +;;; Boundary Cases + +(ert-deftest test-calibredb-epub-config-epub-in-directory-name () + "Boundary: the extension anchors at the end, so a directory named epub +does not by itself select nov-mode." + (should-not (eq 'nov-mode (test-epub-mode--resolve "/home/user/epub/notes.txt")))) + +(ert-deftest test-calibredb-epub-config-epub-with-path () + "Boundary: a full path with directories still resolves on the extension." + (should (eq 'nov-mode (test-epub-mode--resolve "/home/user/books/a b.epub")))) + +;;; Error Cases + +(ert-deftest test-calibredb-epub-config-other-extension-not-nov () + "Error: an unrelated extension must not resolve to nov-mode." + (should-not (eq 'nov-mode (test-epub-mode--resolve "archive.zip"))) + (should-not (eq 'nov-mode (test-epub-mode--resolve "notes.org")))) + +(provide 'test-calibredb-epub-config--epub-mode) +;;; test-calibredb-epub-config--epub-mode.el ends here diff --git a/tests/test-calibredb-epub-config.el b/tests/test-calibredb-epub-config.el index 71581d4c..7afc58f3 100644 --- a/tests/test-calibredb-epub-config.el +++ b/tests/test-calibredb-epub-config.el @@ -285,57 +285,6 @@ so the search buffer rebuilds against the now-unfiltered set." (cj/calibredb-clear-filters)) (should (equal "" passed)))) -;;; --------------------------- cj/force-nov-mode-for-epub --------------------- - -(ert-deftest test-calibredb-epub-force-nov-mode-on-epub-calls-nov-mode () - "Normal: a .epub buffer with nov-mode bound dispatches to `nov-mode' and -does not fall through to the original mode dispatcher." - (skip-unless (fboundp 'nov-mode)) - (let (orig-called nov-called) - (cl-letf (((symbol-function 'nov-mode) - (lambda () (setq nov-called t)))) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.epub") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t))))) - (should nov-called) - (should-not orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-non-epub () - "Boundary: a non-epub buffer falls through to the original mode dispatcher." - (let (orig-called) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.txt") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t)))) - (should orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-no-filename () - "Boundary: a buffer with no associated filename falls through to the -original mode dispatcher." - (let (orig-called) - (with-temp-buffer - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t)))) - (should orig-called))) - -(ert-deftest test-calibredb-epub-force-nov-mode-passes-through-when-nov-missing () - "Error: a .epub buffer falls through to the original dispatcher when nov-mode -is not defined (the require failed and there is nothing to dispatch to)." - (let ((saved (and (fboundp 'nov-mode) (symbol-function 'nov-mode))) - orig-called) - (when saved (fmakunbound 'nov-mode)) - (unwind-protect - (cl-letf (((symbol-function 'require) - ;; Pretend the (require 'nov nil t) call fails too. - (lambda (&rest _) nil))) - (with-temp-buffer - (setq buffer-file-name "/tmp/sample.epub") - (cj/force-nov-mode-for-epub - (lambda (&rest _) (setq orig-called t))))) - (when saved (fset 'nov-mode saved))) - (should orig-called))) - ;;; ---------------------------- cj/nov--metadata-get -------------------------- (ert-deftest test-calibredb-epub-metadata-get-symbol-key () diff --git a/tests/test-help-utils--arch-wiki-search.el b/tests/test-help-utils--arch-wiki-search.el new file mode 100644 index 00000000..d02dd041 --- /dev/null +++ b/tests/test-help-utils--arch-wiki-search.el @@ -0,0 +1,124 @@ +;;; test-help-utils--arch-wiki-search.el --- Tests for the ArchWiki search guard -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--arch-wiki-topics and the cj/local-arch-wiki-search command. +;; +;; The bug: the command read "/usr/share/doc/arch-wiki/html/en" with +;; `directory-files' before checking the directory existed. On a machine +;; without arch-wiki-docs -- the exact state the command's own error text is +;; written for -- that signaled file-missing on the first line, so the friendly +;; "Is arch-wiki-docs installed?" message below it was unreachable. The user +;; got a raw Lisp error naming a path instead of the install hint. +;; +;; Two things had to change to make this testable. The directory was +;; hardcoded inside the command, so a test could only ever exercise whatever +;; the developer's own machine happened to have installed; it is now +;; `cj/arch-wiki-html-dir'. And the directory read is now the pure helper +;; cj/--arch-wiki-topics, which takes a directory and returns an alist, so the +;; interesting cases are driven with real temporary directories instead of +;; mocking `directory-files'. +;; +;; Test organization: +;; - Normal Cases: topics found and returned; the command opens the choice +;; - Boundary Cases: empty dir, single topic, a name matching no topic +;; - Error Cases: missing dir returns nil and reports the install hint +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'help-utils) + +(defmacro test-arch-wiki--with-topics (dir-var topics &rest body) + "Bind DIR-VAR to a temp dir holding TOPICS (a list of html basenames). +The directory is removed after BODY." + (declare (indent 2)) + `(let ((,dir-var (make-temp-file "arch-wiki-test" t))) + (unwind-protect + (progn + (dolist (name ,topics) + (write-region "" nil (expand-file-name (concat name ".html") ,dir-var))) + ,@body) + (delete-directory ,dir-var t)))) + +;;; Normal Cases — the pure helper + +(ert-deftest test-help-utils-arch-wiki-topics-lists-html-basenames () + "Normal: each .html file becomes a (basename . fullpath) pair." + (test-arch-wiki--with-topics dir '("Systemd" "Pacman") + (let ((topics (cj/--arch-wiki-topics dir))) + (should (equal '("Pacman" "Systemd") (sort (mapcar #'car topics) #'string<))) + (should (string-suffix-p "Systemd.html" (cdr (assoc "Systemd" topics))))))) + +(ert-deftest test-help-utils-arch-wiki-topics-ignores-non-html () + "Normal: files without the .html extension are not topics." + (test-arch-wiki--with-topics dir '("Systemd") + (write-region "" nil (expand-file-name "README.txt" dir)) + (should (equal '("Systemd") (mapcar #'car (cj/--arch-wiki-topics dir)))))) + +;;; Boundary Cases + +(ert-deftest test-help-utils-arch-wiki-topics-empty-dir-is-nil () + "Boundary: an existing but empty directory yields no topics." + (test-arch-wiki--with-topics dir '() + (should (null (cj/--arch-wiki-topics dir))))) + +(ert-deftest test-help-utils-arch-wiki-topics-single-topic () + "Boundary: one topic returns a one-element alist." + (test-arch-wiki--with-topics dir '("Systemd") + (should (= 1 (length (cj/--arch-wiki-topics dir)))))) + +;;; Error Cases — the missing-install path + +(ert-deftest test-help-utils-arch-wiki-topics-missing-dir-returns-nil () + "Error: an absent directory returns nil rather than signaling file-missing." + (let ((missing (expand-file-name "definitely-absent-arch-wiki" + temporary-file-directory))) + (should-not (file-directory-p missing)) + (should (null (cj/--arch-wiki-topics missing))))) + +(ert-deftest test-help-utils-arch-wiki-search-missing-dir-reports-hint () + "Error: the command reports the install hint and opens nothing." + (let ((cj/arch-wiki-html-dir (expand-file-name "definitely-absent-arch-wiki" + temporary-file-directory)) + (said nil) + (opened nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq said (apply #'format fmt args)) nil)) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + ;; Must not signal: this is the case that used to raise file-missing. + (cj/local-arch-wiki-search)) + (should-not opened) + (should (string-match-p "arch-wiki-docs" said)))) + +;;; Normal Cases — the command + +(ert-deftest test-help-utils-arch-wiki-search-opens-chosen-topic () + "Normal: the chosen topic is opened as a file URL in EWW." + (test-arch-wiki--with-topics dir '("Systemd") + (let ((cj/arch-wiki-html-dir dir) + (opened nil)) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Systemd")) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + (cj/local-arch-wiki-search)) + (should (string-prefix-p "file://" opened)) + (should (string-suffix-p "Systemd.html" opened)) + ;; The opened path is the one in the temp dir, not a system copy. + (should (string-match-p (regexp-quote dir) opened))))) + +(ert-deftest test-help-utils-arch-wiki-search-unknown-topic-opens-nothing () + "Boundary: a name matching no topic reports rather than opening." + (test-arch-wiki--with-topics dir '("Systemd") + (let ((cj/arch-wiki-html-dir dir) + (opened nil)) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "NotATopic")) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'eww-browse-url) + (lambda (url &rest _) (setq opened url)))) + (cj/local-arch-wiki-search)) + (should-not opened)))) + +(provide 'test-help-utils--arch-wiki-search) +;;; test-help-utils--arch-wiki-search.el ends here diff --git a/tests/test-hugo-config--keymap.el b/tests/test-hugo-config--keymap.el new file mode 100644 index 00000000..0f8df257 --- /dev/null +++ b/tests/test-hugo-config--keymap.el @@ -0,0 +1,71 @@ +;;; test-hugo-config--keymap.el --- Tests for the Hugo prefix keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Pins the eight Hugo commands reachable under the "C-; h" prefix. +;; +;; The module used to install these with eight raw `global-set-key' calls plus +;; a hand-written which-key block, writing into the global map directly instead +;; of going through `cj/register-prefix-map' the way its siblings +;; (erc-config, custom-ordering, org-reveal-config) do. These tests were added +;; alongside that conversion so the refactor is checkable: every key must still +;; reach the same command afterward. +;; +;; Test organization: +;; - Normal Cases: each of the eight keys resolves to its command +;; - Boundary Cases: case-distinct pairs stay distinct; the map is a prefix map +;; - Error Cases: an unbound key in the map resolves to nothing +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(provide 'ox-hugo) +(require 'hugo-config) +(require 'keybindings) + +(defconst test-hugo--expected-bindings + '(("n" . cj/hugo-new-post) + ("e" . cj/hugo-export-post) + ("o" . cj/hugo-open-blog-dir) + ("O" . cj/hugo-open-blog-dir-external) + ("d" . cj/hugo-open-draft) + ("D" . cj/hugo-toggle-draft) + ("p" . cj/hugo-preview) + ("P" . cj/hugo-publish)) + "Every key the Hugo prefix map must carry, and the command it runs.") + +;;; Normal Cases + +(ert-deftest test-hugo-config-keymap-binds-every-command () + "Normal: each Hugo key resolves to its command inside the prefix map." + (dolist (pair test-hugo--expected-bindings) + (should (eq (cdr pair) (keymap-lookup cj/hugo-keymap (car pair)))))) + +(ert-deftest test-hugo-config-keymap-registered-under-custom-prefix () + "Normal: the map is reachable at \"h\" within `cj/custom-keymap'." + (should (eq cj/hugo-keymap (keymap-lookup cj/custom-keymap "h")))) + +;;; Boundary Cases + +(ert-deftest test-hugo-config-keymap-case-pairs-stay-distinct () + "Boundary: the shifted variants run different commands than their lowercase +counterparts, which a case-folding binding would silently collapse." + (should-not (eq (keymap-lookup cj/hugo-keymap "o") + (keymap-lookup cj/hugo-keymap "O"))) + (should-not (eq (keymap-lookup cj/hugo-keymap "d") + (keymap-lookup cj/hugo-keymap "D"))) + (should-not (eq (keymap-lookup cj/hugo-keymap "p") + (keymap-lookup cj/hugo-keymap "P")))) + +(ert-deftest test-hugo-config-keymap-is-a-keymap () + "Boundary: the value registered as a prefix is an actual keymap." + (should (keymapp cj/hugo-keymap))) + +;;; Error Cases + +(ert-deftest test-hugo-config-keymap-unbound-key-is-nil () + "Error: a key the map does not define resolves to nothing." + (should-not (keymap-lookup cj/hugo-keymap "z"))) + +(provide 'test-hugo-config--keymap) +;;; test-hugo-config--keymap.el ends here diff --git a/tests/test-integration-org-agenda-frame-load-order.el b/tests/test-integration-org-agenda-frame-load-order.el new file mode 100644 index 00000000..6541d250 --- /dev/null +++ b/tests/test-integration-org-agenda-frame-load-order.el @@ -0,0 +1,80 @@ +;;; test-integration-org-agenda-frame-load-order.el --- Frame allowlist survives load order -*- lexical-binding: t; -*- + +;;; Commentary: +;; Regression test for a load-order bug in the Full Agenda frame's read-only +;; shadow. +;; +;; Components integrated: +;; - org-agenda-frame (real, loaded in a subprocess) +;; - org-agenda (real, loaded BEFORE the frame module to reproduce the bug) +;; +;; The bug: cj/--agenda-frame-shadow-mutations walks org-agenda-mode-map and +;; keeps a key only when the frame map already binds it to a `commandp' value. +;; The view/redo handlers (day-view, week-view, safe-redo) were defined LOWER in +;; the file than the `with-eval-after-load' that ran the walk. When org-agenda +;; was already loaded at frame-load time -- the normal startup order and every +;; reload -- the walk fired before those defuns existed, read them as not-yet +;; commands, and denied d/w/g/r, the very keys the allowlist grants. Moving the +;; walk to the end of the file (after the defuns) fixed it. +;; +;; This test can't reproduce the ordering in-process (the module is already +;; loaded), so it drives a fresh Emacs that requires org-agenda first, then the +;; frame module, and inspects the resulting keymap. +;; +;; Validates: +;; - d/w/g/r keep their allowlist commands in the org-first load order +;; - a real mutation key (t) is still denied (the read-only guarantee holds) +;; +;;; Code: + +(require 'ert) + +(defconst test-oaf--repo-root + (file-name-directory (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "Repo root, one level up from tests/.") + +(defun test-oaf--lookup-in-subprocess (keys) + "Load org-agenda then org-agenda-frame in a fresh Emacs, return KEYS' bindings. +Returns an alist of (KEY . BINDING-SYMBOL-NAME-OR-nil)." + (let* ((root test-oaf--repo-root) + (form + (prin1-to-string + `(progn + (setq load-prefer-newer t) + (package-initialize) + (require 'org-agenda) ; the bad order: org first + (require 'org-agenda-frame) + (princ (prin1-to-string + (mapcar + (lambda (k) + (cons k (let ((b (lookup-key cj/agenda-frame-mode-map (kbd k)))) + (and (symbolp b) (symbol-name b))))) + ',keys)))))) + (out (with-output-to-string + (with-current-buffer standard-output + (call-process + (expand-file-name invocation-name invocation-directory) + nil t nil + "--batch" "--no-site-file" "--no-site-lisp" + "-L" root + "-L" (expand-file-name "modules" root) + "-L" (expand-file-name "themes" root) + "--eval" form))))) + (car (read-from-string out)))) + +(ert-deftest test-integration-org-agenda-frame-allowlist-survives-org-first-load () + "Integration: with org-agenda loaded before the frame module, the allowlisted +view/redo keys keep their commands and a mutation key stays denied." + (skip-unless (file-exists-p (expand-file-name "modules/org-agenda-frame.el" + test-oaf--repo-root))) + (let ((got (test-oaf--lookup-in-subprocess '("d" "w" "g" "r" "t")))) + (should (equal "cj/--agenda-frame-day-view" (cdr (assoc "d" got)))) + (should (equal "cj/--agenda-frame-week-view" (cdr (assoc "w" got)))) + (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "g" got)))) + (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "r" got)))) + ;; t is a real org mutation key; it must be denied, not allowlisted. + (should (equal "cj/--agenda-frame-denied-readonly" (cdr (assoc "t" got)))))) + +(provide 'test-integration-org-agenda-frame-load-order) +;;; test-integration-org-agenda-frame-load-order.el ends here diff --git a/tests/test-integration-recording-device-workflow.el b/tests/test-integration-recording-device-workflow.el index 3ef631f3..27ffac56 100644 --- a/tests/test-integration-recording-device-workflow.el +++ b/tests/test-integration-recording-device-workflow.el @@ -1,26 +1,24 @@ ;;; test-integration-recording-device-workflow.el --- Integration tests for recording device workflow -*- lexical-binding: t; -*- ;;; Commentary: -;; Integration tests covering the complete device detection and grouping workflow. -;; -;; This tests the full pipeline from raw pactl output through parsing, grouping, -;; and friendly name assignment. The workflow enables users to select audio devices -;; for recording calls/meetings. +;; Integration test covering the device detection path that recording actually +;; uses: raw pactl output through parsing and into friendly state names. ;; ;; Components integrated: ;; - cj/recording--parse-pactl-output (parse raw pactl output into structured data) -;; - cj/recording-parse-sources (shell command wrapper) -;; - cj/recording-group-devices-by-hardware (group inputs/monitors by device) +;; - cj/recording-parse-sources (shell command wrapper, MOCKED at +;; shell-command-to-string so no pactl runs) ;; - cj/recording-friendly-state (convert technical state names) -;; - Bluetooth MAC address normalization (colons → underscores) -;; - Device name pattern matching (USB, PCI, Bluetooth) -;; - Friendly name assignment (user-facing device names) ;; ;; Critical integration points: -;; - Parse output must produce data that group-devices can process -;; - Bluetooth MAC normalization must work across parse→group boundary -;; - Incomplete devices (only mic OR only monitor) must be filtered -;; - Friendly names must correctly identify device types +;; - Parse output must carry device state through to the friendly-name conversion +;; +;; This file once covered a parse-to-group pipeline as well. That half tested +;; cj/recording-group-devices-by-hardware, a second device-grouping +;; implementation nothing ever called -- cj/recording-select-device is the live +;; selection path and reaches parse-sources directly. The function and its +;; tests were removed rather than left as coverage that proved an unused code +;; path worked. ;;; Code: @@ -46,58 +44,6 @@ ;;; Normal Cases - Complete Workflow -(ert-deftest test-integration-recording-device-workflow-parse-to-group-all-devices () - "Test complete workflow from pactl output to grouped devices. - -When pactl output contains all three device types (built-in, USB, Bluetooth), -the workflow should parse, group, and assign friendly names to all devices. - -Components integrated: -- cj/recording--parse-pactl-output (parsing) -- cj/recording-group-devices-by-hardware (grouping + MAC normalization) -- Device pattern matching (USB/PCI/Bluetooth detection) -- Friendly name assignment - -Validates: -- All three device types are detected -- Bluetooth MAC addresses normalized (colons → underscores) -- Each device has both mic and monitor -- Friendly names correctly assigned -- Complete data flow: raw output → parsed list → grouped pairs" - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - ;; Test parse step - (let ((parsed (cj/recording-parse-sources))) - (should (= 6 (length parsed))) - - ;; Test group step (receives parsed data) - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 3 (length grouped))) - - ;; Validate built-in device - (let ((built-in (assoc "Built-in Audio" grouped))) - (should built-in) - (should (string-prefix-p "alsa_input.pci" (cadr built-in))) - (should (string-prefix-p "alsa_output.pci" (cddr built-in)))) - - ;; Validate USB device - (let ((usb (assoc "Jabra SPEAK 510 USB" grouped))) - (should usb) - (should (string-match-p "Jabra" (cadr usb))) - (should (string-match-p "Jabra" (cddr usb)))) - - ;; Validate Bluetooth device (CRITICAL: MAC normalization) - (let ((bluetooth (assoc "Bluetooth Headset" grouped))) - (should bluetooth) - ;; Input has colons - (should (string-match-p "00:1B:66:C0:91:6D" (cadr bluetooth))) - ;; Output has underscores - (should (string-match-p "00_1B_66_C0_91_6D" (cddr bluetooth))) - ;; But they're grouped together! - (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) - (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))))) - (ert-deftest test-integration-recording-device-workflow-friendly-states-in-list () "Test that friendly state names appear in device list output. @@ -128,105 +74,5 @@ Validates: ;;; Boundary Cases - Incomplete Devices -(ert-deftest test-integration-recording-device-workflow-incomplete-devices-filtered () - "Test that devices with only mic OR only monitor are filtered out. - -For call recording, we need BOTH mic and monitor from the same device. -Incomplete devices should not appear in the grouped output. - -Components integrated: -- cj/recording-parse-sources (parsing all devices) -- cj/recording-group-devices-by-hardware (filtering incomplete pairs) - -Validates: -- Device with only mic is filtered -- Device with only monitor is filtered -- Only complete devices (both mic and monitor) are returned -- Filtering happens at group stage, not parse stage" - (let ((output (concat - ;; Complete device - "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - ;; Incomplete: USB mic with no monitor - "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" - ;; Incomplete: Bluetooth monitor with no mic - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - ;; Parse sees all 4 devices - (let ((parsed (cj/recording-parse-sources))) - (should (= 4 (length parsed))) - - ;; Group returns only 1 complete device - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 1 (length grouped))) - (should (equal "Built-in Audio" (caar grouped)))))))) - -;;; Edge Cases - Bluetooth MAC Normalization - -(ert-deftest test-integration-recording-device-workflow-bluetooth-mac-variations () - "Test Bluetooth MAC normalization with different formats. - -Bluetooth devices use colons in input names but underscores in output names. -The grouping must normalize these to match devices correctly. - -Components integrated: -- cj/recording-parse-sources (preserves original MAC format) -- cj/recording-group-devices-by-hardware (normalizes MAC for matching) -- Base name extraction (regex patterns) -- MAC address transformation (underscores → colons) - -Validates: -- Input with colons (bluez_input.AA:BB:CC:DD:EE:FF) parsed correctly -- Output with underscores (bluez_output.AA_BB_CC_DD_EE_FF) parsed correctly -- Normalization happens during grouping -- Devices paired despite format difference -- Original device names preserved (not mutated)" - (let ((output (concat - "79\tbluez_input.11:22:33:44:55:66\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" - "81\tbluez_output.11_22_33_44_55_66.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((parsed (cj/recording-parse-sources))) - ;; Original formats preserved in parse - (should (string-match-p "11:22:33" (caar parsed))) - (should (string-match-p "11_22_33" (caadr parsed))) - - ;; But grouping matches them - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (= 1 (length grouped))) - (should (equal "Bluetooth Headset" (caar grouped))) - ;; Original names preserved - (should (equal "bluez_input.11:22:33:44:55:66" (cadar grouped))) - (should (equal "bluez_output.11_22_33_44_55_66.1.monitor" (cddar grouped)))))))) - -;;; Error Cases - Malformed Data - -(ert-deftest test-integration-recording-device-workflow-malformed-output-handled () - "Test that malformed pactl output is handled gracefully. - -When pactl output is malformed or unparseable, the workflow should not crash. -It should return empty results at appropriate stages. - -Components integrated: -- cj/recording--parse-pactl-output (malformed line handling) -- cj/recording-group-devices-by-hardware (empty input handling) - -Validates: -- Malformed lines are silently skipped during parse -- Empty parse results don't crash grouping -- Workflow degrades gracefully -- No exceptions thrown" - (let ((output (test-load-fixture "pactl-output-malformed.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((parsed (cj/recording-parse-sources))) - ;; Malformed output produces empty parse - (should (null parsed)) - - ;; Empty parse produces empty grouping (no crash) - (let ((grouped (cj/recording-group-devices-by-hardware))) - (should (null grouped))))))) - (provide 'test-integration-recording-device-workflow) ;;; test-integration-recording-device-workflow.el ends here diff --git a/tests/test-media-utils--yt-dl-message.el b/tests/test-media-utils--yt-dl-message.el new file mode 100644 index 00000000..491b64cf --- /dev/null +++ b/tests/test-media-utils--yt-dl-message.el @@ -0,0 +1,64 @@ +;;; test-media-utils--yt-dl-message.el --- Tests for the yt-dl sentinel message -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/media--yt-dl-message, the pure helper behind +;; cj/yt-dl-it's process sentinel. +;; +;; The behavior under test is a correctness fix, not cosmetics. cj/yt-dl-it +;; launches "tsp yt-dlp ...", and tsp enqueues the job and exits immediately. +;; The sentinel therefore fires on tsp's exit, not on yt-dlp's, so the old +;; "Finished downloading" text claimed a completed download at the moment the +;; download was merely queued -- and a yt-dlp failure minutes later was silent. +;; The helper reports queueing, which is the only thing tsp's exit actually +;; proves. +;; +;; Test organization: +;; - Normal Cases: clean tsp exit reports queued; abnormal exit reports failure +;; - Boundary Cases: unrelated events return nil; URL text passes through verbatim +;; - Error Cases: empty event string returns nil +;; +;;; Code: + +(require 'ert) +(require 'media-utils) + +;;; Normal Cases + +(ert-deftest test-media-utils--yt-dl-message-normal-finished-says-queued () + "Normal: a clean tsp exit reports the job queued, never downloaded." + (let ((msg (cj/media--yt-dl-message "finished\n" "https://example.com/v"))) + (should (string-match-p "[Qq]ueued" msg)) + (should-not (string-match-p "[Ff]inished downloading" msg)))) + +(ert-deftest test-media-utils--yt-dl-message-normal-abnormal-reports-failure () + "Normal: an abnormal tsp exit reports that queueing failed." + (let ((msg (cj/media--yt-dl-message "exited abnormally with code 1\n" + "https://example.com/v"))) + (should msg) + (should-not (string-match-p "[Qq]ueued for" msg)))) + +;;; Boundary Cases + +(ert-deftest test-media-utils--yt-dl-message-boundary-unrelated-event-is-nil () + "Boundary: an event that reports neither outcome produces no message." + (should (null (cj/media--yt-dl-message "run\n" "https://example.com/v"))) + (should (null (cj/media--yt-dl-message "stopped\n" "https://example.com/v")))) + +(ert-deftest test-media-utils--yt-dl-message-boundary-url-passes-through () + "Boundary: the URL text is carried into the message verbatim." + (let ((url "https://example.com/watch?v=a&b=c%20d")) + (should (string-match-p (regexp-quote url) + (cj/media--yt-dl-message "finished\n" url))))) + +(ert-deftest test-media-utils--yt-dl-message-boundary-empty-url () + "Boundary: an empty URL still yields a message rather than signaling." + (should (stringp (cj/media--yt-dl-message "finished\n" "")))) + +;;; Error Cases + +(ert-deftest test-media-utils--yt-dl-message-error-empty-event-is-nil () + "Error: an empty event string matches no outcome and returns nil." + (should (null (cj/media--yt-dl-message "" "https://example.com/v")))) + +(provide 'test-media-utils--yt-dl-message) +;;; test-media-utils--yt-dl-message.el ends here diff --git a/tests/test-org-agenda-frame.el b/tests/test-org-agenda-frame.el index fd8bd839..3c56d361 100644 --- a/tests/test-org-agenda-frame.el +++ b/tests/test-org-agenda-frame.el @@ -418,10 +418,15 @@ removed after a later success -- the failure banner would stick forever." (should (= 0 (seq-count (lambda (o) (overlay-get o 'before-string)) (overlays-in (point-min) (point-max))))))) -(ert-deftest test-org-agenda-frame-map-mutation-keys-not-explicitly-bound () - "Boundary: a mutation key (t = org-agenda-todo) is not explicitly bound, so the -[t] catch-all denies it as read-only." - (should (null (lookup-key cj/agenda-frame-mode-map (kbd "t"))))) +(ert-deftest test-org-agenda-frame-map-mutation-keys-denied () + "Boundary: a mutation key (t = org-agenda-todo) is denied, never allowlisted. +It is denied two ways depending on whether the shadow walk has run: the `[t]' +catch-all handles it (lookup returns nil) before the walk, and the walk binds +it explicitly to the deny handler once `org-agenda-mode-map' is present. Both +are a read-only denial; the test asserts the outcome, not which path produced +it, so it holds whether or not org-agenda is loaded in the test process." + (let ((b (lookup-key cj/agenda-frame-mode-map (kbd "t")))) + (should (or (null b) (eq b 'cj/--agenda-frame-denied-readonly))))) ;;; Default-deny policy — the minor mode + finalize re-enable diff --git a/tests/test-org-refile-config--advice-helpers.el b/tests/test-org-refile-config--advice-helpers.el new file mode 100644 index 00000000..0d9979d8 --- /dev/null +++ b/tests/test-org-refile-config--advice-helpers.el @@ -0,0 +1,87 @@ +;;; test-org-refile-config--advice-helpers.el --- Tests for the refile advice helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for the two named advice helpers extracted from anonymous lambdas +;; in the org-refile use-package :config block: +;; +;; cj/org-refile--save-all-buffers (:after org-refile) +;; cj/org-refile--ensure-targets-in-org-mode (:before org-refile-get-targets) +;; +;; They were anonymous `(lambda (&rest _) ...)' advices, which cannot be +;; `advice-remove'd by reference and cannot be tested. Naming them makes both +;; possible. The install-by-reference and removability are verified live in the +;; daemon (the :config block doesn't run under batch make test); these tests +;; pin the extracted logic. +;; +;; Test organization: +;; - Normal Cases: ensure-targets visits each string-named target +;; - Boundary Cases: empty targets, non-string cars, mixed list +;; - Error Cases: a nil target list is a no-op +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-refile-config) + +;; The module's bare `(defvar org-refile-targets)' marks the symbol special only +;; within its own file, so it isn't special here. Declare it (with a value) so +;; the `let' bindings below bind it dynamically, the way the sibling +;; test-org-refile-config-commands.el does. +(defvar org-refile-targets nil) + +;;; cj/org-refile--ensure-targets-in-org-mode + +(ert-deftest test-org-refile-ensure-targets-visits-each-string-target () + "Normal: every string-named target file is passed to the ensure helper." + (let ((org-refile-targets '(("/a.org" :maxlevel . 3) + ("/b.org" :maxlevel . 3))) + (seen '())) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (f) (push f seen)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should (equal '("/a.org" "/b.org") (nreverse seen))))) + +;;; Boundary + +(ert-deftest test-org-refile-ensure-targets-skips-non-string-cars () + "Boundary: a target whose car is not a string (a function/symbol spec) is +skipped rather than passed to the ensure helper." + (let ((org-refile-targets `((,(lambda () '("/x.org")) :maxlevel . 2) + ("/real.org" :maxlevel . 2) + (org-agenda-files :maxlevel . 2))) + (seen '())) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (f) (push f seen)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should (equal '("/real.org") seen)))) + +(ert-deftest test-org-refile-ensure-targets-empty-list-is-noop () + "Boundary: no targets means the ensure helper is never called." + (let ((org-refile-targets '()) + (called nil)) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) + (lambda (_f) (setq called t)))) + (cj/org-refile--ensure-targets-in-org-mode)) + (should-not called))) + +;;; Error + +(ert-deftest test-org-refile-ensure-targets-nil-targets-does-not-signal () + "Error: a nil `org-refile-targets' completes without signaling." + (let ((org-refile-targets nil)) + (cl-letf (((symbol-function 'cj/org-refile-ensure-org-mode) #'ignore)) + (should (progn (cj/org-refile--ensure-targets-in-org-mode) t))))) + +;;; cj/org-refile--save-all-buffers + +(ert-deftest test-org-refile-save-all-buffers-delegates () + "Normal: the save helper calls `org-save-all-org-buffers'." + (let ((called nil)) + (cl-letf (((symbol-function 'org-save-all-org-buffers) + (lambda (&rest _) (setq called t)))) + (cj/org-refile--save-all-buffers)) + (should called))) + +(provide 'test-org-refile-config--advice-helpers) +;;; test-org-refile-config--advice-helpers.el ends here diff --git a/tests/test-pre-commit-hook.bats b/tests/test-pre-commit-hook.bats new file mode 100644 index 00000000..413c71d0 --- /dev/null +++ b/tests/test-pre-commit-hook.bats @@ -0,0 +1,126 @@ +#!/usr/bin/env bats +# Tests for githooks/pre-commit — the secret scan and paren check. +# +# The scan reads its input through a pipeline: +# +# added_lines="$(git diff --cached ... | grep '^+' | grep -v '^+++' || true)" +# +# `grep` exits 1 when it matches nothing, which is the ordinary case, so the +# `|| true` has to stay. But with no `pipefail` it also swallows a failure of +# `git diff` itself, and an empty `added_lines` makes the scan search nothing, +# find nothing, and report clean. A gate that passes without looking is the +# failure this file exists to pin: the fail-open test drives a broken `git diff` +# and asserts the hook refuses rather than exiting 0. +# +# Each test builds a throwaway git repo in BATS_TEST_TMPDIR, so nothing touches +# the real repository or its hooks. + +setup() { + HOOK="${BATS_TEST_DIRNAME}/../githooks/pre-commit" + REPO="${BATS_TEST_TMPDIR}/repo" + mkdir -p "$REPO" + cd "$REPO" || return 1 + git init -q . + git config user.email t@example.com + git config user.name Test + # Split so the fixtures never appear as credential-shaped literals here. + AWS_TAIL="IOSFODNN7EXAMPLE" + WORD_TAIL="word" +} + +# Put a stub `git` ahead of the real one that fails for the staged-diff call +# and delegates everything else, so only the pipeline under test breaks. +break_staged_diff() { + mkdir -p "${BATS_TEST_TMPDIR}/bin" + cat > "${BATS_TEST_TMPDIR}/bin/git" <<'STUB' +#!/usr/bin/env bash +if [ "${1:-}" = "diff" ] && [ "${2:-}" = "--cached" ] && [ "${3:-}" = "-U0" ]; then + echo "simulated git failure" >&2 + exit 128 +fi +exec /usr/bin/git "$@" +STUB + chmod +x "${BATS_TEST_TMPDIR}/bin/git" + PATH="${BATS_TEST_TMPDIR}/bin:$PATH" +} + +# ------------------------------- Normal cases ------------------------------- + +@test "secret scan: blocks a staged AWS key" { + # Assembled at runtime: a literal key-shaped string in this file would trip + # the very hook under test on every commit that touches it, and this repo + # mirrors to a public remote. + printf 'aws = "%s"\n' "AKIA${AWS_TAIL}" > creds.txt + git add creds.txt + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"potential secret"* ]] +} + +@test "secret scan: blocks a staged keyword=value password" { + printf '%s = "%s"\n' "pass${WORD_TAIL}" "correcthorsebatterystaple" > conf.txt + git add conf.txt + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"potential secret"* ]] +} + +@test "secret scan: allows an ordinary staged file" { + printf 'just some prose\n' > notes.txt + git add notes.txt + run "$HOOK" + [ "$status" -eq 0 ] +} + +# ------------------------------ Boundary cases ------------------------------ + +@test "secret scan: allows a commit with nothing staged" { + run "$HOOK" + [ "$status" -eq 0 ] +} + +@test "paren check: blocks an unbalanced staged .el file" { + printf '(defun broken ()\n (message "no close"\n' > bad.el + git add bad.el + run "$HOOK" + [ "$status" -eq 1 ] + [[ "$output" == *"paren check failed"* ]] +} + +@test "paren check: allows a balanced staged .el file" { + printf '(defun fine ()\n (message "ok"))\n' > good.el + git add good.el + run "$HOOK" + [ "$status" -eq 0 ] +} + +# -------------------------------- Error cases ------------------------------- + +@test "secret scan: refuses to pass when the staged diff cannot be read" { + # The scan must not report clean after searching nothing. Without a + # pipefail-aware guard the broken diff yields an empty added_lines and the + # hook exits 0, letting a real secret through unscanned. + printf 'aws = "%s"\n' "AKIA${AWS_TAIL}" > creds.txt + git add creds.txt + break_staged_diff + run "$HOOK" + [ "$status" -ne 0 ] +} + +@test "paren check: refuses to pass when the staged file list cannot be read" { + printf '(defun broken ()\n (message "no close"\n' > bad.el + git add bad.el + mkdir -p "${BATS_TEST_TMPDIR}/bin2" + cat > "${BATS_TEST_TMPDIR}/bin2/git" <<'STUB' +#!/usr/bin/env bash +if [ "${1:-}" = "diff" ] && [ "${2:-}" = "--cached" ] && [ "${3:-}" = "--name-only" ]; then + echo "simulated git failure" >&2 + exit 128 +fi +exec /usr/bin/git "$@" +STUB + chmod +x "${BATS_TEST_TMPDIR}/bin2/git" + PATH="${BATS_TEST_TMPDIR}/bin2:$PATH" + run "$HOOK" + [ "$status" -ne 0 ] +} diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index c603fc7e..4b647166 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -162,5 +162,36 @@ and the rendered S-expression lands in the log." (should (string-match-p ":slot" contents))))) (delete-file comp-warnings-log)))) +(ert-deftest test-system-defaults-log-comp-warning-unwritable-log-does-not-signal () + "Error: an unwritable log path must not signal. +The function is `:before-until' advice on `display-warning'; a signal here +propagates out of `display-warning' and breaks warning display for every +async native-comp notice. It swallows the write failure and still returns +t (the warning stays suppressed), rather than crashing." + (let ((comp-warnings-log "/proc/nonexistent-dir/cannot-write.log")) + (should (eq t (cj/log-comp-warning 'comp "boom"))))) + +(ert-deftest test-system-defaults-log-comp-warning-caps-log-growth () + "Boundary: the log is bounded — once it exceeds the cap, a further write +resets it (deletes the old file, keeping only the new entry) rather than +growing without limit. A hard reset, not a tail-trim: on overflow the old +history is discarded, which is fine for a transient diagnostic log." + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + ;; Seed the file well over the cap. + (with-temp-file comp-warnings-log + (insert (make-string (1+ cj/comp-warnings-log-max-bytes) ?x))) + (should (> (file-attribute-size (file-attributes comp-warnings-log)) + cj/comp-warnings-log-max-bytes)) + (cj/log-comp-warning 'comp "after the cap") + (should (<= (file-attribute-size (file-attributes comp-warnings-log)) + cj/comp-warnings-log-max-bytes)) + ;; The newest entry survives the trim. + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (should (string-match-p "after the cap" (buffer-string))))) + (delete-file comp-warnings-log)))) + (provide 'test-system-defaults-functions) ;;; test-system-defaults-functions.el ends here diff --git a/tests/test-validate-el-hook.bats b/tests/test-validate-el-hook.bats new file mode 100644 index 00000000..43c3569c --- /dev/null +++ b/tests/test-validate-el-hook.bats @@ -0,0 +1,97 @@ +#!/usr/bin/env bats +# Tests for .claude/hooks/validate-el.sh — the auto-test runner. +# +# The runner used to skip entirely above MAX_AUTO_TEST_FILES=20, with no else +# branch: nothing printed, exit 0, indistinguishable from a passing run. That +# was live for the three largest families here (calendar-sync 63 test files, +# music 45, ai-term 35), so every edit to those ran parens and byte-compile and +# zero tests, silently. +# +# The cap was removed rather than made loud, because its premise did not hold. +# Measured on this machine, running a whole family takes about a second: +# ai-term 208 tests in 1.0s, music 403 in 1.7s, calendar-sync 633 in 0.9s. It +# was also concealing a real cross-test pollution bug in calendar-sync that +# only appears when that family runs in one process. +# +# These tests pin that no file count is skipped. Each builds a synthetic +# project in BATS_TEST_TMPDIR and points CLAUDE_PROJECT_DIR at it, so nothing +# runs against the real tree. + +setup() { + HOOK="${BATS_TEST_DIRNAME}/../.claude/hooks/validate-el.sh" + PROJ="${BATS_TEST_TMPDIR}/proj" + mkdir -p "$PROJ/modules" "$PROJ/tests" + export CLAUDE_PROJECT_DIR="$PROJ" + printf '(provide (quote widget))\n' > "$PROJ/modules/widget.el" +} + +# N green test files matching the widget stem. +make_tests() { + local n="$1" i + for ((i = 1; i <= n; i++)); do + printf '(require (quote ert))\n(ert-deftest test-widget-%d () (should t))\n' \ + "$i" > "$PROJ/tests/test-widget-${i}.el" + done +} + +# One failing test file, to prove the run is real rather than merely quiet. +make_failing_test() { + printf '(require (quote ert))\n(ert-deftest test-widget-bad () (should nil))\n' \ + > "$PROJ/tests/test-widget-bad.el" +} + +hook_input() { + printf '{"tool_input":{"file_path":"%s"}}' "$PROJ/modules/widget.el" +} + +run_hook() { + run bash -c "$(printf '%q' "$HOOK") <<< '$(hook_input)'" +} + +# ------------------------------- Normal cases ------------------------------- + +@test "a small family runs and passes quietly" { + make_tests 3 + run_hook + [ "$status" -eq 0 ] +} + +@test "a failing test blocks, so a quiet pass means the tests really ran" { + make_tests 3 + make_failing_test + run_hook + [ "$status" -eq 2 ] + [[ "$output" == *"TESTS FAILED"* ]] +} + +# ------------------------------ Boundary cases ------------------------------ + +@test "at the old cap of 20 files: runs" { + make_tests 20 + run_hook + [ "$status" -eq 0 ] +} + +@test "past the old cap: still runs, no longer skipped" { + make_tests 21 + run_hook + [ "$status" -eq 0 ] + [[ "${output,,}" != *"skipped"* ]] +} + +@test "well past the old cap: a failure in file 63 is still caught" { + # The regression this guards: at 63 files the runner used to skip, so a red + # test in a big family reported clean. calendar-sync is exactly this size. + make_tests 63 + make_failing_test + run_hook + [ "$status" -eq 2 ] + [[ "$output" == *"TESTS FAILED"* ]] +} + +# -------------------------------- Error cases ------------------------------- + +@test "no matching tests: exits clean without running anything" { + run_hook + [ "$status" -eq 0 ] +} diff --git a/tests/test-video-audio-recording-group-devices-by-hardware.el b/tests/test-video-audio-recording-group-devices-by-hardware.el deleted file mode 100644 index 2be4982f..00000000 --- a/tests/test-video-audio-recording-group-devices-by-hardware.el +++ /dev/null @@ -1,194 +0,0 @@ -;;; test-video-audio-recording-group-devices-by-hardware.el --- Tests for cj/recording-group-devices-by-hardware -*- lexical-binding: t; -*- - -;;; Commentary: -;; Unit tests for cj/recording-group-devices-by-hardware function. -;; Tests grouping of audio sources by physical hardware device. -;; Critical test: Bluetooth MAC address normalization (colons vs underscores). -;; -;; This function is used by the quick setup command to automatically pair -;; microphone and monitor devices from the same hardware. - -;;; Code: - -(require 'ert) - -;; Stub dependencies before loading the module -(defvar cj/custom-keymap (make-sparse-keymap) - "Stub keymap for testing.") - -;; Now load the actual production module -(require 'video-audio-recording) - -;;; Test Fixtures Helper - -(defun test-load-fixture (filename) - "Load fixture file FILENAME from tests/fixtures directory." - (let ((fixture-path (expand-file-name - (concat "tests/fixtures/" filename) - user-emacs-directory))) - (with-temp-buffer - (insert-file-contents fixture-path) - (buffer-string)))) - -;;; Normal Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-all-types-grouped () - "Test grouping of all three device types (built-in, USB, Bluetooth). -This is the key test validating the complete grouping logic." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (= 3 (length result))) - ;; Check that we have all three device types - (let ((names (mapcar #'car result))) - (should (member "Built-in Audio" names)) - (should (member "Bluetooth Headset" names)) - (should (member "Jabra SPEAK 510 USB" names))) - ;; Verify each device has both mic and monitor - (dolist (device result) - (should (stringp (car device))) ; friendly name - (should (stringp (cadr device))) ; mic device - (should (stringp (cddr device))) ; monitor device - (should-not (string-suffix-p ".monitor" (cadr device))) ; mic not monitor - (should (string-suffix-p ".monitor" (cddr device)))))))) ; monitor has suffix - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-built-in-paired () - "Test that built-in laptop audio devices are correctly paired." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (built-in (assoc "Built-in Audio" result))) - (should built-in) - (should (string-match-p "pci-0000_00_1f" (cadr built-in))) - (should (string-match-p "pci-0000_00_1f" (cddr built-in))) - (should (equal "alsa_input.pci-0000_00_1f.3.analog-stereo" (cadr built-in))) - (should (equal "alsa_output.pci-0000_00_1f.3.analog-stereo.monitor" (cddr built-in))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-usb-paired () - "Test that USB devices (Jabra) are correctly paired." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (jabra (assoc "Jabra SPEAK 510 USB" result))) - (should jabra) - (should (string-match-p "Jabra" (cadr jabra))) - (should (string-match-p "Jabra" (cddr jabra))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-bluetooth-paired () - "Test that Bluetooth devices are correctly paired. -CRITICAL: Tests MAC address normalization (colons in input, underscores in output)." - (let ((output (test-load-fixture "pactl-output-normal.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let* ((result (cj/recording-group-devices-by-hardware)) - (bluetooth (assoc "Bluetooth Headset" result))) - (should bluetooth) - ;; Input has colons: bluez_input.00:1B:66:C0:91:6D - (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) - ;; Output has underscores: bluez_output.00_1B_66_C0_91_6D.1.monitor - ;; But they should still be grouped together (MAC address normalized) - (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))) - -;;; Boundary Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-empty-returns-empty () - "Test that empty pactl output returns empty list." - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) ""))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-inputs-returns-empty () - "Test that only input devices (no monitors) returns empty list. -Devices must have BOTH mic and monitor to be included." - (let ((output (test-load-fixture "pactl-output-inputs-only.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-monitors-returns-empty () - "Test that only monitor devices (no inputs) returns empty list." - (let ((output (test-load-fixture "pactl-output-monitors-only.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-single-complete-device () - "Test that single device with both mic and monitor is returned." - (let ((output "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n")) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - (should (equal "Built-in Audio" (caar result))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-mixed-complete-incomplete () - "Test that only devices with BOTH mic and monitor are included. -Incomplete devices (only mic or only monitor) are filtered out." - (let ((output (concat - ;; Complete device (built-in) - "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" - ;; Incomplete: USB mic with no monitor - "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" - ;; Incomplete: Bluetooth monitor with no mic - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - ;; Only the complete built-in device should be returned - (should (= 1 (length result))) - (should (equal "Built-in Audio" (caar result))))))) - -;;; Error Cases - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-malformed-output-returns-empty () - "Test that malformed pactl output returns empty list." - (let ((output (test-load-fixture "pactl-output-malformed.txt"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (listp result)) - (should (null result)))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-unknown-device-type () - "Test that unknown device types get generic 'USB Audio Device' name." - (let ((output (concat - "100\talsa_input.usb-unknown_device-00.analog-stereo\tPipeWire\ts16le 2ch 16000Hz\tSUSPENDED\n" - "99\talsa_output.usb-unknown_device-00.analog-stereo.monitor\tPipeWire\ts16le 2ch 48000Hz\tSUSPENDED\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - ;; Should get generic USB name (not matching Jabra pattern) - (should (equal "USB Audio Device" (caar result))))))) - -(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-bluetooth-mac-case-variations () - "Test that Bluetooth MAC addresses work with different formatting. -Tests the normalization logic handles various MAC address formats." - (let ((output (concat - ;; Input with colons (typical) - "79\tbluez_input.AA:BB:CC:DD:EE:FF\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" - ;; Output with underscores (typical) - "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) - (cl-letf (((symbol-function 'shell-command-to-string) - (lambda (_cmd) output))) - (let ((result (cj/recording-group-devices-by-hardware))) - (should (= 1 (length result))) - (should (equal "Bluetooth Headset" (caar result))) - ;; Verify both devices paired despite different MAC formats - (let ((device (car result))) - (should (string-match-p "AA:BB:CC" (cadr device))) - (should (string-match-p "AA_BB_CC" (cddr device)))))))) - -(provide 'test-video-audio-recording-group-devices-by-hardware) -;;; test-video-audio-recording-group-devices-by-hardware.el ends here diff --git a/tests/test-wrap-up--bury-buffers.el b/tests/test-wrap-up--bury-buffers.el new file mode 100644 index 00000000..00df69c7 --- /dev/null +++ b/tests/test-wrap-up--bury-buffers.el @@ -0,0 +1,96 @@ +;;; test-wrap-up--bury-buffers.el --- Tests for cj/bury-buffers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Characterization tests for cj/bury-buffers, which buries the noisy +;; compile-and-shell buffers at the end of startup. +;; +;; Written to pin the buried set while a dead clause was removed. The function +;; tested `(derived-mode-p 'elisp-compile-mode)', and no such mode exists in +;; Emacs -- the real one is `emacs-lisp-compilation-mode', which derives from +;; `compilation-mode' and so was already matched by the clause above it. The +;; clause could never be true, and removing it must not change which buffers +;; get buried. These tests are what makes that claim checkable. +;; +;; Test organization: +;; - Normal Cases: each buried mode is buried; byte-compilation output included +;; - Boundary Cases: an ordinary buffer is left alone; an empty buffer list +;; - Error Cases: a killed buffer in the list does not break the sweep +;; +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'wrap-up) + +;; Required explicitly so each test stands alone. Without these the +;; comint-mode test passed only because ERT runs tests in alphabetical order +;; and an earlier test loaded `compile', which pulls in comint -- so renaming +;; or running that test by itself made it fail with void-function comint-mode. +(require 'comint) +(require 'bytecomp) + +(defmacro test-wrap-up--with-mode-buffer (mode &rest body) + "Create a buffer in MODE, bind it to `buf', run BODY, then kill it." + (declare (indent 1)) + `(let ((buf (generate-new-buffer "*test-bury*"))) + (unwind-protect + (progn + (with-current-buffer buf (funcall ,mode)) + ,@body) + (kill-buffer buf)))) + +;;; Normal Cases + +(ert-deftest test-wrap-up-bury-buffers-buries-compilation () + "Normal: a compilation-mode buffer is buried." + (test-wrap-up--with-mode-buffer #'compilation-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-buries-byte-compilation-output () + "Normal: the real byte-compilation mode is buried. +`emacs-lisp-compilation-mode' derives from `compilation-mode', which is +why the never-matching elisp-compile-mode clause was redundant." + (should (eq 'compilation-mode + (get 'emacs-lisp-compilation-mode 'derived-mode-parent))) + (test-wrap-up--with-mode-buffer #'emacs-lisp-compilation-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-buries-comint () + "Normal: a comint-mode buffer is buried." + (test-wrap-up--with-mode-buffer #'comint-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should-not (eq buf (car (buffer-list)))))) + +;;; Boundary Cases + +(ert-deftest test-wrap-up-bury-buffers-leaves-ordinary-buffer () + "Boundary: a fundamental-mode buffer is not buried." + (test-wrap-up--with-mode-buffer #'fundamental-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should (eq buf (car (buffer-list)))))) + +(ert-deftest test-wrap-up-bury-buffers-leaves-text-buffer () + "Boundary: an ordinary text-mode buffer is not buried." + (test-wrap-up--with-mode-buffer #'text-mode + (switch-to-buffer buf) + (cj/bury-buffers) + (should (eq buf (car (buffer-list)))))) + +;;; Error Cases + +(ert-deftest test-wrap-up-bury-buffers-survives-dead-mode-name () + "Error: the sweep completes even though elisp-compile-mode does not exist. +The removed clause named a mode Emacs has never defined; this pins that +the function still runs cleanly with no such mode anywhere." + (should-not (fboundp 'elisp-compile-mode)) + (should-not (get 'elisp-compile-mode 'derived-mode-parent)) + (cj/bury-buffers)) + +(provide 'test-wrap-up--bury-buffers) +;;; test-wrap-up--bury-buffers.el ends here |
