diff options
Diffstat (limited to 'tests')
19 files changed, 868 insertions, 150 deletions
diff --git a/tests/test-agenda-query--render.el b/tests/test-agenda-query--render.el index 48d28773..da5c3f60 100644 --- a/tests/test-agenda-query--render.el +++ b/tests/test-agenda-query--render.el @@ -162,10 +162,17 @@ still parses as JSON, which is the worst kind." Pinning the failure mode, not endorsing it. This is what the surface showed before the batch writer learned the vocabulary, and it is why the test above exists." + ;; No priority cookie in this fixture. org 9.8 (Emacs 31.1) parses the + ;; cookie with `org-priority-regexp' under `looking-at', and that regexp's + ;; lazy `.*?' prefix swallows everything between the stars and the cookie, + ;; unknown keyword included. A cookie here would test org's bug rather than + ;; the vocabulary gap this test pins. (let ((org-todo-keywords '((sequence "TODO" "|" "DONE")))) (test-aq-render--with-agenda-file - "* DOING [#A] Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" - (should (string-prefix-p "DOING" (alist-get 't (car rows))))))) + "* DOING Justin Johns advisor projects\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (let ((row (car rows))) + (should (string-prefix-p "DOING" (alist-get 't row))) + (should-not (equal "DOING" (alist-get 'keyword row))))))) ;;; ---------- the cache writer ---------- diff --git a/tests/test-calibredb-epub-config.el b/tests/test-calibredb-epub-config.el index 7afc58f3..0e430a4e 100644 --- a/tests/test-calibredb-epub-config.el +++ b/tests/test-calibredb-epub-config.el @@ -16,6 +16,11 @@ (package-initialize) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'calibredb-epub-config) +;; Load calibredb before any test stubs its functions with `cl-letf'. The +;; module's jump path calls `(require 'calibredb)' inside the body; if the +;; package is still an autoload at that point, the real `defun' lands on top of +;; the stub and the test runs the real command against the real library. +(require 'calibredb) (require 'nov nil t) ; for the nov-mode-map keybinding test; harmless if absent (declare-function cj/nov--text-width "calibredb-epub-config" (total-cols)) diff --git a/tests/test-config-utilities--compile-this-elisp-buffer.el b/tests/test-config-utilities--compile-this-elisp-buffer.el index a06440ab..f1a442b4 100644 --- a/tests/test-config-utilities--compile-this-elisp-buffer.el +++ b/tests/test-config-utilities--compile-this-elisp-buffer.el @@ -1,10 +1,14 @@ ;;; test-config-utilities--compile-this-elisp-buffer.el --- Tests for cj/compile-this-elisp-buffer -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for `cj/compile-this-elisp-buffer'. The function dispatches -;; among native-compile-async, native-compile (sync), and -;; byte-compile-file based on which is fboundp. Tests force each -;; branch by mocking fboundp at the boundary. +;; Tests for `cj/compile-this-elisp-buffer' and its helper +;; `cj/--compile-elisp-file'. The helper dispatches among +;; native-compile-async, native-compile (sync), and byte-compile-file based +;; on an AVAILABLE-P predicate that defaults to `fboundp'. Tests force each +;; branch by passing the predicate, never by redefining `fboundp': an `fset' +;; on that subr autoloads comp-run, which requires bytecomp, whose `defun' of +;; `byte-compile-file' replaces any test double installed earlier in the same +;; `cl-letf' (Emacs 30.2 hid this because ert happened to preload bytecomp). ;;; Code: @@ -14,6 +18,10 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'config-utilities) +(defun test-config-utilities--available (&rest syms) + "Return a predicate that reports only SYMS as available compilers." + (lambda (sym) (memq sym syms))) + (defmacro test-config-utilities--with-elisp-buffer (path &rest body) "Run BODY in a temp buffer visiting PATH (a .el file path). Skips the interactive `save-buffer' so tests stay free of disk side @@ -24,72 +32,108 @@ effects." (cl-letf (((symbol-function 'save-buffer) (lambda (&rest _) nil))) ,@body))) +;; -- the interactive wrapper ------------------------------------------------- + (ert-deftest test-config-utilities-compile-buffer-not-elisp-raises () "Error: a buffer whose file isn't .el raises `user-error'." (test-config-utilities--with-elisp-buffer "/tmp/not-elisp.txt" (should-error (cj/compile-this-elisp-buffer) :type 'user-error))) -(ert-deftest test-config-utilities-compile-buffer-no-buffer-file-name-raises () - "Error: a buffer with no `buffer-file-name' raises `user-error'." +(ert-deftest test-config-utilities-compile-buffer-no-file-raises () + "Boundary: a buffer visiting no file raises `user-error' rather than +passing nil to the compiler." (with-temp-buffer - (setq buffer-file-name nil) (should-error (cj/compile-this-elisp-buffer) :type 'user-error))) +(ert-deftest test-config-utilities-compile-buffer-saves-then-delegates () + "Normal: the wrapper saves the buffer and hands its file to the helper." + (let (saved compiled) + (with-temp-buffer + (setq buffer-file-name "/tmp/some.el") + (cl-letf (((symbol-function 'save-buffer) (lambda (&rest _) (setq saved t))) + ((symbol-function 'cj/--compile-elisp-file) + (lambda (file &optional _) (setq compiled file)))) + (cj/compile-this-elisp-buffer))) + (should saved) + (should (equal compiled "/tmp/some.el")))) + +;; -- the helper's dispatch --------------------------------------------------- + (ert-deftest test-config-utilities-compile-buffer-prefers-native-async () "Normal: `native-compile-async' is preferred when available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) - (memq sym '(native-compile-async native-compile byte-compile-file)))) - ((symbol-function 'native-compile-async) - (lambda (file) (setq called-with file))) - ((symbol-function 'native-compile) - (lambda (_) (error "should not call sync native-compile"))) - ((symbol-function 'byte-compile-file) - (lambda (&rest _) (error "should not call byte-compile-file")))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'native-compile-async) + (lambda (file) (setq called-with file))) + ((symbol-function 'native-compile) + (lambda (_) (error "should not call sync native-compile"))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file")))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile-async 'native-compile + 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) (ert-deftest test-config-utilities-compile-buffer-falls-back-to-sync-native () "Normal: `native-compile' is used when async isn't available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (memq sym '(native-compile byte-compile-file)))) - ((symbol-function 'native-compile) - (lambda (file) (setq called-with file))) - ((symbol-function 'byte-compile-file) - (lambda (&rest _) (error "should not call byte-compile-file")))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'native-compile) + (lambda (file) (setq called-with file))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file")))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) (ert-deftest test-config-utilities-compile-buffer-falls-back-to-byte-compile () "Normal: `byte-compile-file' is used when neither native option is available." (let (called-with) - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (eq sym 'byte-compile-file))) - ((symbol-function 'byte-compile-file) - (lambda (file &rest _) (setq called-with file) "/tmp/some.elc"))) - (cj/compile-this-elisp-buffer) - (should (equal called-with "/tmp/some.el")))))) + (cl-letf (((symbol-function 'byte-compile-file) + (lambda (file &rest _) (setq called-with file) "/tmp/some.elc"))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'byte-compile-file)) + (should (equal called-with "/tmp/some.el"))))) + +(ert-deftest test-config-utilities-compile-buffer-reports-when-nothing-available () + "Boundary: with no compiler available the helper only messages, calling none." + (let (captured) + (cl-letf (((symbol-function 'native-compile-async) + (lambda (&rest _) (error "should not call native-compile-async"))) + ((symbol-function 'native-compile) + (lambda (&rest _) (error "should not call native-compile"))) + ((symbol-function 'byte-compile-file) + (lambda (&rest _) (error "should not call byte-compile-file"))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file "/tmp/some.el" (test-config-utilities--available))) + (should (string-match-p "No compilation available" captured)))) (ert-deftest test-config-utilities-compile-buffer-handles-sync-native-error () "Error: a sync `native-compile' that signals is caught and reported. -Asserts no error escapes by running the function and checking that the +Asserts no error escapes by running the helper and checking that the message captured contains the failure prefix." - (test-config-utilities--with-elisp-buffer "/tmp/some.el" - (let (captured) - (cl-letf (((symbol-function 'fboundp) - (lambda (sym) (memq sym '(native-compile byte-compile-file)))) - ((symbol-function 'native-compile) - (lambda (_) (error "boom"))) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq captured (apply #'format fmt args))))) - (cj/compile-this-elisp-buffer)) - (should (string-match-p "Native compile failed" captured))))) + (let (captured) + (cl-letf (((symbol-function 'native-compile) + (lambda (_) (error "boom"))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file + "/tmp/some.el" + (test-config-utilities--available 'native-compile 'byte-compile-file))) + (should (string-match-p "Native compile failed" captured)))) + +(ert-deftest test-config-utilities-compile-buffer-default-predicate-is-fboundp () + "Normal: with no predicate the helper consults `fboundp', so on a real +Emacs it reaches whichever compiler exists rather than the no-compiler +message." + (let (captured) + (cl-letf (((symbol-function 'native-compile-async) (lambda (&rest _) nil)) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) + (cj/--compile-elisp-file "/tmp/some.el")) + (should (string-match-p "Queued native compilation" captured)))) (provide 'test-config-utilities--compile-this-elisp-buffer) ;;; test-config-utilities--compile-this-elisp-buffer.el ends here diff --git a/tests/test-dirvish-config--side-key.el b/tests/test-dirvish-config--side-key.el new file mode 100644 index 00000000..1f08314c --- /dev/null +++ b/tests/test-dirvish-config--side-key.el @@ -0,0 +1,40 @@ +;;; test-dirvish-config--side-key.el --- dirvish-side lives on F9 -*- lexical-binding: t; -*- + +;;; Commentary: +;; The sidebar toggle moved from F11 to F9 on 2026-09-22 so F11 could go back +;; to `toggle-frame-fullscreen', the stock binding every other application +;; shares and which the :bind had been shadowing. F9 was the free bare +;; F-key: ai-term left it for M-SPC in June and the recording chord came off +;; it the same day this moved. F2 is the preview key and F5 is reserved for +;; the debug backend, so neither was a candidate. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'keybindings) +(require 'dirvish-config) + +;;; Normal + +(ert-deftest test-dirvish-config-side-on-f9 () + "Normal: F9 toggles the dirvish sidebar." + (should (eq (keymap-lookup global-map "<f9>") #'dirvish-side))) + +;;; Boundary + +(ert-deftest test-dirvish-config-side-not-on-f11 () + "Boundary/regression: F11 no longer reaches dirvish-side, so the stock +`toggle-frame-fullscreen' binding is no longer shadowed." + (should-not (eq (keymap-lookup global-map "<f11>") #'dirvish-side)) + (should (eq (keymap-lookup global-map "<f11>") #'toggle-frame-fullscreen))) + +;;; Error + +(ert-deftest test-dirvish-config-side-target-is-a-command () + "Error (positive control): the binding points at a real interactive +command, so a keypress does not fail with a `commandp' error at press time." + (should (commandp (keymap-lookup global-map "<f9>")))) + +(provide 'test-dirvish-config--side-key) +;;; test-dirvish-config--side-key.el ends here diff --git a/tests/test-init-defer-games.el b/tests/test-init-defer-games.el index f3ec94de..4f349908 100644 --- a/tests/test-init-defer-games.el +++ b/tests/test-init-defer-games.el @@ -42,5 +42,36 @@ load failed to define malyon." (should (featurep 'games-config)) (should (equal malyon-stories-directory "/tmp/games-defer-test/text.games/")))) +(defun test-init-defer-games--declaration-installs-p (init package) + "Return non-nil when INIT (init.el's text) declares PACKAGE in an installing form. +A `use-package' form that carries `:ensure nil' or `:load-path' does not +install (use-package suppresses `use-package-always-ensure' for both), so +the check rejects those rather than accepting any form that names the package." + (and (string-match (format "^(use-package %s\\b\\([^\n]*\\))[ \t]*$" + (regexp-quote package)) + init) + (let ((args (match-string 1 init))) + (not (string-match-p ":ensure nil\\|:load-path" args))))) + +(ert-deftest test-init-defer-games-init-declares-both-packages () + "Normal: init.el declares malyon and 2048-game in forms that install them. +`use-package-always-ensure' is the installer for these two. a8571eff dropped +the declarations along with the eager require, and both packages silently +vanished on the next rebuild while every other test still passed." + (let ((init (with-temp-buffer + (insert-file-contents (expand-file-name "init.el" default-directory)) + (buffer-string)))) + (should (test-init-defer-games--declaration-installs-p init "malyon")) + (should (test-init-defer-games--declaration-installs-p init "2048-game")))) + +(ert-deftest test-init-defer-games-declaration-check-rejects-non-installing-forms () + "Boundary: the declaration check refuses forms use-package would not install." + (should-not (test-init-defer-games--declaration-installs-p + "(use-package malyon :ensure nil :defer t)\n" "malyon")) + (should-not (test-init-defer-games--declaration-installs-p + "(use-package malyon :load-path \"~/x\" :defer t)\n" "malyon")) + (should (test-init-defer-games--declaration-installs-p + "(use-package malyon :defer t :commands (malyon))\n" "malyon"))) + (provide 'test-init-defer-games) ;;; test-init-defer-games.el ends here diff --git a/tests/test-integration-recurring-events.el b/tests/test-integration-recurring-events.el index 8339d167..44ddfb00 100644 --- a/tests/test-integration-recurring-events.el +++ b/tests/test-integration-recurring-events.el @@ -24,13 +24,22 @@ ;;; Setup and Teardown +(defvar test-integration-recurring-events--saved-tz nil + "The TZ in force before setup pinned it, restored by teardown.") + (defun test-integration-recurring-events-setup () - "Setup for recurring events integration tests." - nil) + "Setup for recurring events integration tests. +Pins TZ to America/Chicago: the fixtures are TZID=America/Chicago and the +assertions expect that zone's local rendering (\"Sat 10:30-11:00\"), so on +any other machine zone the pipeline's correct conversion reads as a failure. +`setenv' on TZ also calls `set-time-zone-rule', which is what the time +functions actually consult." + (setq test-integration-recurring-events--saved-tz (getenv "TZ")) + (setenv "TZ" "America/Chicago")) (defun test-integration-recurring-events-teardown () - "Teardown for recurring events integration tests." - nil) + "Teardown for recurring events integration tests: restore the machine TZ." + (setenv "TZ" test-integration-recurring-events--saved-tz)) ;;; Test Data diff --git a/tests/test-keybindings--fullscreen.el b/tests/test-keybindings--fullscreen.el new file mode 100644 index 00000000..c35e398c --- /dev/null +++ b/tests/test-keybindings--fullscreen.el @@ -0,0 +1,45 @@ +;;; test-keybindings--fullscreen.el --- F11 toggles frame fullscreen -*- lexical-binding: t; -*- + +;;; Commentary: +;; Stock Emacs binds F11 to `toggle-frame-fullscreen', the same key every +;; other application on the desktop uses for it. This config never rebound +;; it; dirvish-config's :bind put dirvish-side on F11 and shadowed the stock +;; binding for as long as that entry existed. It moved to F9 on 2026-09-22 +;; (see test-dirvish-config--side-key.el, which pins the un-shadowing). +;; +;; These tests pin the foundation layer's side of that: keybindings.el must +;; leave the stock F11 binding in place. Only keybindings.el is loaded here +;; on purpose. A feature module that later claimed F11 would fail the +;; dirvish-side regression test, not this one. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'keybindings) + +;;; Normal + +(ert-deftest test-keybindings-f11-toggles-fullscreen () + "Normal: F11 runs `toggle-frame-fullscreen' once the foundation layer has +loaded. Stock Emacs provides the binding; this pins that keybindings.el does +not unset or rebind it." + (should (eq (keymap-lookup global-map "<f11>") #'toggle-frame-fullscreen))) + +;;; Boundary + +(ert-deftest test-keybindings-f11-is-the-only-fullscreen-chord () + "Boundary: the plain key carries it; the shifted chord is left free so a +grazed Shift does not toggle the frame twice." + (should-not (eq (keymap-lookup global-map "S-<f11>") + #'toggle-frame-fullscreen))) + +;;; Error + +(ert-deftest test-keybindings-f11-target-is-a-command () + "Error (positive control): the target is a real interactive command, so a +press does not fail with a `commandp' error at press time." + (should (commandp (keymap-lookup global-map "<f11>")))) + +(provide 'test-keybindings--fullscreen) +;;; test-keybindings--fullscreen.el ends here diff --git a/tests/test-org-capture-config-fkey-guard.el b/tests/test-org-capture-config-fkey-guard.el index b288ce4f..c0687bb2 100644 --- a/tests/test-org-capture-config-fkey-guard.el +++ b/tests/test-org-capture-config-fkey-guard.el @@ -2,8 +2,10 @@ ;;; Commentary: ;; While a capture is in progress, the global popup keys (F1 dashboard -;; sweep, F10 music, F11 dirvish-side, F12 terminal, M-SPC agent swap) -;; must not fire and pop UI over the capture. org-capture-mode is a +;; sweep, F9 dirvish-side, F10 music, F12 terminal, M-SPC agent swap) +;; must not fire and pop UI over the capture. F11 is deliberately not on +;; the list: it toggles frame fullscreen, which pops nothing over the +;; capture, so blocking it would only get in the way. org-capture-mode is a ;; minor mode active exactly for the capture's duration and its keymap ;; shadows the global map, so the guard binds those keys there to a ;; blocker that signals a `user-error' naming the way out. @@ -21,10 +23,17 @@ (ert-deftest test-org-capture-fkey-guard-keys-bound () "Normal: every leaking popup key is bound to the blocker in capture mode." - (dolist (key '("<f1>" "<f10>" "<f11>" "<f12>" "M-SPC")) + (dolist (key '("<f1>" "<f9>" "<f10>" "<f12>" "M-SPC")) (should (eq (keymap-lookup org-capture-mode-map key) #'cj/--org-capture-blocked-key)))) +(ert-deftest test-org-capture-fkey-guard-leaves-fullscreen-alone () + "Boundary: F11 (frame fullscreen) is not blocked. It pops no UI, and +before dirvish-side moved to F9 it was on this list only because F11 was the +sidebar key; the entry must follow the command, not the key." + (should-not (eq (keymap-lookup org-capture-mode-map "<f11>") + #'cj/--org-capture-blocked-key))) + (ert-deftest test-org-capture-fkey-guard-blocker-signals-user-error () "Error: the blocker signals a user-error rather than doing nothing." (should-error (cj/--org-capture-blocked-key) :type 'user-error)) diff --git a/tests/test-prog-general-yas-activation.el b/tests/test-prog-general-yas-activation.el index d6ea42cd..d9ae76e3 100644 --- a/tests/test-prog-general-yas-activation.el +++ b/tests/test-prog-general-yas-activation.el @@ -122,7 +122,11 @@ produces the marker block." "Boundary: <cj + expand in python-ts-mode (a tree-sitter prog-mode-derived mode) produces the marker block. Verifies the snippet reaches modern tree-sitter modes through fundamental-mode inheritance." - (skip-unless (fboundp 'python-ts-mode)) + ;; `python-ts-mode' prompts to install a missing grammar, which a batch run + ;; cannot answer, so skip on the grammar rather than on the mode's existence. + (skip-unless (and (fboundp 'python-ts-mode) + (require 'treesit nil t) + (treesit-ready-p 'python t))) (should (string= (test-prog-general--expand-cj-in-mode #'python-ts-mode) test-prog-general--cj-expected))) diff --git a/tests/test-setup-telega.bats b/tests/test-setup-telega.bats index 3282b9e1..518ecc7b 100644 --- a/tests/test-setup-telega.bats +++ b/tests/test-setup-telega.bats @@ -57,11 +57,11 @@ setup() { # --------------------------- pull_or_announce_image ----------------------- -@test "pull_or_announce_image: announces the in-Emacs build when no image is set" { +@test "pull_or_announce_image: points at make telega-image when no image is set" { TELEGA_DOCKER_IMAGE="" run pull_or_announce_image [ "$status" -eq 0 ] - [[ "$output" == *"M-x telega-server-build"* ]] + [[ "$output" == *"make telega-image"* ]] } @test "pull_or_announce_image: pulls when TELEGA_DOCKER_IMAGE is set" { diff --git a/tests/test-system-defaults--warning-display-dead-buffer.el b/tests/test-system-defaults--warning-display-dead-buffer.el new file mode 100644 index 00000000..48c7797e --- /dev/null +++ b/tests/test-system-defaults--warning-display-dead-buffer.el @@ -0,0 +1,103 @@ +;;; test-system-defaults--warning-display-dead-buffer.el --- Dead-buffer guard on deferred warnings -*- lexical-binding: t; -*- + +;;; Commentary: +;; Emacs 31.1's warnings.el defers daemon-startup warnings into a one-shot +;; `after-make-frame-functions' closure that calls `warning--display-buffer' +;; on the first client frame with the *Warnings* buffer object it captured at +;; warning time. If anything killed that buffer in between, `display-buffer' +;; signals inside `make-frame', server.el swallows the error as +;; "-window-system-unsupported", and emacsclient silently retries on $DISPLAY: +;; the session's first frame lands on XWayland. +;; +;; The root fix keeps *Warnings* alive (undead-buffers.el). This is the +;; defense in depth: `cj/warning--display-buffer-if-live' wraps +;; `warning--display-buffer' so a dead buffer is skipped rather than passed +;; on. Load happens once in the shared sandbox (testutil-system-defaults.el); +;; `warning--display-buffer' only exists from Emacs 31, so the end-to-end case +;; skips on older builds while the pure-function cases always run. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(require 'testutil-system-defaults) + +(test-system-defaults--with-load-environment + (test-system-defaults--load)) + +(defun test-system-defaults--recording-orig () + "Return (ORIG . CALLS) where ORIG records every argument into CALLS." + (let ((calls (list nil))) + (cons (lambda (buffer) + (push buffer (car calls)) + 'displayed) + calls))) + +;;; Normal Cases + +(ert-deftest test-system-defaults-warning-guard-passes-live-buffer-through () + "Normal: a live buffer reaches the original and its value is returned." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-live*"))) + (unwind-protect + (progn + (should (eq 'displayed + (cj/warning--display-buffer-if-live (car rec) buf))) + (should (equal (list buf) (car (cdr rec))))) + (kill-buffer buf)))) + +(ert-deftest test-system-defaults-warning-guard-is-installed () + "Normal: loading system-defaults installs the guard on the deferred display. +From Emacs 31 the advised symbol must actually be defined: pending advice on +an undefined symbol would still count as installed, so a rename upstream +would otherwise silently disable the backstop." + (should (advice-member-p #'cj/warning--display-buffer-if-live + 'warning--display-buffer)) + (when (>= emacs-major-version 31) + (should (fboundp 'warning--display-buffer)))) + +(ert-deftest test-system-defaults-warning-guard-resolves-live-buffer-name () + "Normal: a live buffer's name is resolved and passed through as the buffer." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-named*"))) + (unwind-protect + (progn + (should (eq 'displayed + (cj/warning--display-buffer-if-live + (car rec) (buffer-name buf)))) + (should (equal (list buf) (car (cdr rec))))) + (kill-buffer buf)))) + +;;; Boundary Cases + +(ert-deftest test-system-defaults-warning-guard-skips-killed-buffer () + "Boundary: a killed buffer never reaches the original; result is nil." + (let* ((rec (test-system-defaults--recording-orig)) + (buf (generate-new-buffer " *warning-guard-dead*"))) + (kill-buffer buf) + (should-not (cj/warning--display-buffer-if-live (car rec) buf)) + (should-not (car (cdr rec))))) + +(ert-deftest test-system-defaults-warning-guard-end-to-end-dead-buffer-does-not-signal () + "Boundary: the real deferred display survives a dead buffer. +Mirrors the live failure: a string condition in `display-buffer-alist' is +what `buffer-match-p' tripped over when the buffer name came back nil." + (skip-unless (fboundp 'warning--display-buffer)) + (let ((buf (generate-new-buffer "*Warnings*")) + (display-buffer-alist '(("^ \\*test-guard\\*" display-buffer-no-window)))) + (kill-buffer buf) + (should-not (warning--display-buffer buf)))) + +;;; Error Cases + +(ert-deftest test-system-defaults-warning-guard-rejects-non-buffer () + "Error: nil, or a name that resolves to no buffer, is skipped without a signal." + (let ((rec (test-system-defaults--recording-orig)) + (missing " *warning-guard-no-such-buffer*")) + (when (get-buffer missing) (kill-buffer missing)) + (should-not (cj/warning--display-buffer-if-live (car rec) nil)) + (should-not (cj/warning--display-buffer-if-live (car rec) missing)) + (should-not (car (cdr rec))))) + +(provide 'test-system-defaults--warning-display-dead-buffer) +;;; test-system-defaults--warning-display-dead-buffer.el ends here diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index 4b647166..09bf9f2a 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -55,6 +55,12 @@ ;; so it doesn't leak into a shared batch session. `make test-name' loads ;; every test file into one Emacs; a leaked cwd there breaks the relative ;; loads of every file that follows. +;; Declared special before the `let' below binds it: this file is lexical, +;; so without the defvar the binding is a lexical local, and use-package's +;; own `defcustom' then fails with "Defining as dynamic an already lexical +;; var" (fatal at load since 31.1 moved the defcustom to autoload time). +(defvar use-package-always-ensure) + (let ((default-directory default-directory) (use-package-always-ensure nil)) (cl-letf (((symbol-function 'server-running-p) (lambda (&rest _) t)) diff --git a/tests/test-telega-config--docker-pin.el b/tests/test-telega-config--docker-pin.el index 894dbfdd..8f5b62bd 100644 --- a/tests/test-telega-config--docker-pin.el +++ b/tests/test-telega-config--docker-pin.el @@ -5,9 +5,15 @@ ;; ;; telega infers its image from `telega-tdlib-min-version' and only pins to a ;; version tag when min and max versions are equal and the version ends in -;; ".0". This config has min "1.8.64" and max nil, so the inference always +;; ".0". This config has min "1.8.66" and max nil, so the inference always ;; falls through to "zevlg/telega-server:latest" -- a moving tag that can ;; swap the server out from under a fixed elisp version without notice. +;; +;; Since 2026-08-25 the pin names an image built locally from +;; docker/telega-server/Dockerfile (upstream's image is missing a shared +;; library, zevlg/telega.el#596). Three files have to agree on that image: +;; the defcustom default, the Makefile's build tag, and the Dockerfile's +;; digest-pinned base. The tests below hold them together. ;;; Code: @@ -17,6 +23,18 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'telega-config) +(defun test-telega-config--file-string (relative) + "Return the contents of RELATIVE under `user-emacs-directory'." + (with-temp-buffer + (insert-file-contents (expand-file-name relative user-emacs-directory)) + (buffer-string))) + +(defun test-telega-config--pin-default () + "Return the defcustom's shipped default, not the live value. +Customizing the pin (including to nil) is not a test failure; only +changing the shipped default is." + (eval (car (get 'cj/telega-docker-image 'standard-value)) t)) + ;; -- cj/--telega-docker-pinned-image ----------------------------------------- (ert-deftest test-telega-config-pin-returns-configured-reference () @@ -77,17 +95,118 @@ name, so this stays a reversible setting." "Normal: the advice is a named function so it can be removed by reference." (should (fboundp 'cj/--telega-docker-image-name))) -(ert-deftest test-telega-config-pin-default-is-a-digest-reference () - "Normal: the shipped default pins by digest, not by a floating tag. -A tag pin (:latest, or even a version tag upstream can re-push) still -moves; a digest names one immutable image. - -Reads the defcustom's standard value rather than the live variable, so -customizing the pin (including to nil, handing the choice back to telega) -is not a test failure -- only changing the shipped default is." - (let ((default (eval (car (get 'cj/telega-docker-image 'standard-value)) t))) +;; -- the shipped default and the files it depends on ------------------------- + +(ert-deftest test-telega-config-pin-default-matches-makefile-build-tag () + "Normal: the default pin is exactly the tag `make telega-image' builds. +The image is built locally, so the pin is a tag rather than a registry +digest. The Makefile owns the tag; the defcustom must name the same one +or a fresh machine builds an image telega never looks for." + (let ((makefile (test-telega-config--file-string "Makefile"))) + (should (string-match "^TELEGA_IMAGE[ \t]*[?:]?=[ \t]*\\([^ \t\n]+\\)" makefile)) + (should (equal (test-telega-config--pin-default) + (match-string 1 makefile))))) + +(ert-deftest test-telega-config-pin-default-is-a-local-tag-not-a-digest () + "Boundary: the default is a plain tag, with no registry digest suffix. +A locally built image has no RepoDigest, so a digest reference here could +never resolve." + (let ((default (test-telega-config--pin-default))) (should (stringp default)) - (should (string-match-p "@sha256:[0-9a-f]\\{64\\}\\'" default)))) + (should (string-match-p "\\`[a-z0-9./-]+:[A-Za-z0-9._-]+\\'" default)) + (should-not (string-match-p "@sha256:" default)))) + +(ert-deftest test-telega-config-dockerfile-pins-base-image-by-digest () + "Normal: the Dockerfile's base is an immutable upstream digest. +This is where the digest guarantee the old pin gave now lives. A tag in +the FROM line would let upstream swap the base under a rebuild." + (let ((dockerfile (test-telega-config--file-string "docker/telega-server/Dockerfile"))) + (should (string-match-p + "^FROM zevlg/telega-server@sha256:[0-9a-f]\\{64\\}[ \t]*$" + dockerfile)))) + +(ert-deftest test-telega-config-dockerfile-adds-the-missing-library () + "Normal: the Dockerfile installs libglycin, the whole reason it exists. +Upstream's image fails to start without it (zevlg/telega.el#596)." + (let ((dockerfile (test-telega-config--file-string "docker/telega-server/Dockerfile"))) + (should (string-match-p "^RUN apk add .*libglycin" dockerfile)))) + +;; -- cj/--telega-docker-image-present-p (the docker boundary) ---------------- +;; Exercised against a fake `docker' executable on a private exec-path rather +;; than by mocking `call-process' (a subr; see the native-comp mocking gotcha). + +(defun test-telega-config--with-fake-docker (exit-code thunk) + "Call THUNK with a fake `docker' on `exec-path' that exits EXIT-CODE." + (let* ((dir (make-temp-file "fake-docker-" t)) + (script (expand-file-name "docker" dir))) + (unwind-protect + (progn + (with-temp-file script + (insert (format "#!/bin/sh\nexit %d\n" exit-code))) + (set-file-modes script #o700) + (let ((exec-path (list dir))) + (funcall thunk))) + (delete-directory dir t)))) + +(ert-deftest test-telega-config-image-present-p-true-when-inspect-succeeds () + "Normal: `docker image inspect' exiting 0 means the image is present." + (test-telega-config--with-fake-docker 0 + (lambda () (should (cj/--telega-docker-image-present-p "cj/telega-server:x"))))) + +(ert-deftest test-telega-config-image-present-p-nil-when-inspect-fails () + "Boundary: a non-zero exit (no such image) reads as not present." + (test-telega-config--with-fake-docker 1 + (lambda () (should-not (cj/--telega-docker-image-present-p "cj/telega-server:x"))))) + +(ert-deftest test-telega-config-image-present-p-nil-without-docker () + "Error: with no docker on `exec-path', the helper returns nil instead of +signalling, so the launcher can still route the user to the make target." + (let ((exec-path nil)) + (should-not (cj/--telega-docker-image-present-p "cj/telega-server:x")))) + +;; -- cj/telega refuses to launch against a missing local image --------------- + +(ert-deftest test-telega-config-missing-image-message-names-image-and-target () + "Normal: the message names the missing image and the make target that builds it." + (let ((msg (cj/--telega-missing-image-message "cj/telega-server:x"))) + (should (string-match-p "cj/telega-server:x" msg)) + (should (string-match-p "make telega-image" msg)))) + +(ert-deftest test-telega-config-launcher-errors-when-pinned-image-is-absent () + "Error: with a pin set and no such image, `cj/telega' stops with the make hint. +Without this, docker fails to pull a local-only tag and the error names a +registry the image was never meant to come from." + (let ((cj/telega-docker-image "cj/telega-server:x") + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) (lambda (_) nil)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (let ((err (should-error (cj/telega) :type 'user-error))) + (should (string-match-p "make telega-image" (cadr err)))) + (should-not launched)))) + +(ert-deftest test-telega-config-launcher-runs-when-pinned-image-is-present () + "Normal: with the pinned image present, `cj/telega' launches telega." + (let ((cj/telega-docker-image "cj/telega-server:x") + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) (lambda (_) t)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (cj/telega) + (should launched)))) + +(ert-deftest test-telega-config-launcher-skips-image-check-without-a-pin () + "Boundary: with no pin, telega infers and pulls its own image; no check runs." + (let ((cj/telega-docker-image nil) + (checked nil) + (launched nil)) + (cl-letf (((symbol-function 'locate-library) (lambda (&rest _) "telega.el")) + ((symbol-function 'cj/--telega-docker-image-present-p) + (lambda (_) (setq checked t) nil)) + ((symbol-function 'telega) (lambda (&rest _) (setq launched t)))) + (cj/telega) + (should-not checked) + (should launched)))) (provide 'test-telega-config--docker-pin) ;;; test-telega-config--docker-pin.el ends here diff --git a/tests/test-telega-config.el b/tests/test-telega-config.el index d8aaeb4d..54a601c9 100644 --- a/tests/test-telega-config.el +++ b/tests/test-telega-config.el @@ -45,6 +45,10 @@ stub's cryptic load-file failure." (let (called) (cl-letf (((symbol-function 'featurep) (lambda (sym &optional _sub) (eq sym 'telega))) + ;; The pinned image is a local build; treat it as present so + ;; this test stays about delegation, not the image check. + ((symbol-function 'cj/--telega-docker-image-present-p) + (lambda (_) t)) ((symbol-function 'telega) (lambda (&rest _) (setq called t)))) (cj/telega)) diff --git a/tests/test-term-tmux-detach.el b/tests/test-term-tmux-detach.el new file mode 100644 index 00000000..9bd94776 --- /dev/null +++ b/tests/test-term-tmux-detach.el @@ -0,0 +1,62 @@ +;;; test-term-tmux-detach.el --- Tests for cj/term-tmux-detach -*- lexical-binding: t; -*- + +;;; Commentary: +;; A keyboard C-b inside the Claude Code pane does not reach tmux as a prefix +;; (it lands as stray text), so detaching needs the same pty string path +;; `cj/term-copy-mode-dwim' uses for C-b [. These tests pin that path and +;; the no-tmux fallback. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'package) + +;; Same shape as test-term-tmux-history.el: `make test' runs with no +;; package-initialize, so eat has to be made loadable here before eat-config. +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(setq load-prefer-newer t) +(require 'eat) +(require 'eat-config) + +(ert-deftest test-eat-config-tmux-detach-sends-prefix-and-d-when-attached () + "Normal: with tmux attached, the command writes C-b d into the pty, nothing else." + (let ((sent nil)) + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () t)) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent)))) + (cj/term-tmux-detach) + (should (equal sent '("\C-bd")))))) + +(ert-deftest test-eat-config-tmux-detach-does-nothing-without-tmux () + "Boundary: with no tmux client, nothing is written and the user is told why. +Writing C-b d into a plain shell would type a control character into it." + (let ((sent nil) + (told nil)) + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () nil)) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent))) + ((symbol-function 'message) (lambda (fmt &rest args) + (setq told (apply #'format fmt args))))) + (cj/term-tmux-detach) + (should-not sent) + (should (string-match-p "tmux" told))))) + +(ert-deftest test-eat-config-tmux-detach-survives-dead-process () + "Error: with tmux reported attached but no live pty, the command returns +without signalling. `cj/--term-send-string' already guards on +`process-live-p'; this pins that the detach path relies on it rather than +calling `process-send-string' directly." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/term--in-tmux-p) (lambda () t))) + (should-not (condition-case err + (progn (cj/term-tmux-detach) nil) + (error err)))))) + +(ert-deftest test-eat-config-tmux-detach-bound-on-term-map () + "Normal: the command sits on the terminal map next to copy-mode (\"c\")." + (should (eq (keymap-lookup cj/term-map "d") #'cj/term-tmux-detach))) + +(provide 'test-term-tmux-detach) +;;; test-term-tmux-detach.el ends here diff --git a/tests/test-transcription-config--ratio-backend.el b/tests/test-transcription-config--ratio-backend.el new file mode 100644 index 00000000..f368b859 --- /dev/null +++ b/tests/test-transcription-config--ratio-backend.el @@ -0,0 +1,102 @@ +;;; test-transcription-config--ratio-backend.el --- the ratio self-hosted backend -*- lexical-binding: t; -*- + +;;; Commentary: +;; The `ratio' backend runs whisper plus speaker diarization on my own host +;; through the scripts/ratio-transcribe client. It needs no API key, so its +;; descriptor carries nil for both :auth-host and :env-var, and the process +;; environment passes through unchanged. +;; +;; Two seams have to agree for a backend to be usable: the descriptor alist +;; that resolves the script, and the completing-read list the interactive +;; switcher offers. The switcher used to carry its own copy of that list, so +;; a descriptor added without a switcher entry was reachable only by setq. It +;; now derives its choices from the alist; the boundary test below guards +;; against a return to a hardcoded list. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(unless (fboundp 'notifications-notify) + (defun notifications-notify (&rest _args) + "Stub notification function for testing." + nil)) + +(require 'transcription-config) + +(defun test-transcription-ratio--switcher-choices () + "Return the backend names `cj/transcription-switch-backend' offers. +Captures the collection handed to `completing-read' and answers with the +current backend so the switcher is a no-op." + (let (offered) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt collection &rest _) + (setq offered (mapcar #'car collection)) + (symbol-name cj/transcribe-backend)))) + (let ((cj/transcribe-backend cj/transcribe-backend)) + (cj/transcription-switch-backend))) + offered)) + +;;; Normal + +(ert-deftest test-transcription-config-ratio-descriptor-resolves () + "Normal: the ratio backend resolves to the ratio-transcribe client with no +API-key requirement." + (let ((desc (cj/--backend-plist 'ratio))) + (should (equal (plist-get desc :script) "ratio-transcribe")) + (should (null (plist-get desc :auth-host))) + (should (null (plist-get desc :env-var))))) + +(ert-deftest test-transcription-config-ratio-script-path-and-executable () + "Normal: the script path lands on scripts/ratio-transcribe and the file is +there and executable, so a transcription can actually start." + (let ((cj/transcribe-backend 'ratio)) + (let ((path (cj/--transcription-script-path))) + (should (string-suffix-p "scripts/ratio-transcribe" path)) + (should (file-executable-p path))))) + +(ert-deftest test-transcription-config-ratio-environment-passes-through () + "Normal: no API key means the process environment is returned unchanged, +and nothing consults authinfo." + (cl-letf (((symbol-function 'cj/--auth-source-password) + (lambda (&rest _) (ert-fail "auth-source consulted for a keyless backend")))) + (should (eq (cj/--build-process-environment 'ratio) process-environment)))) + +(ert-deftest test-transcription-config-switcher-offers-ratio () + "Normal: the interactive switcher lists ratio, so the backend is reachable +without a setq." + (should (member "ratio" (test-transcription-ratio--switcher-choices)))) + +;;; Boundary + +(ert-deftest test-transcription-config-switcher-matches-descriptors () + "Boundary: the switcher offers exactly the descriptor set. It derives the +list from the alist now; this is what stops a hardcoded copy coming back." + (should (equal (sort (test-transcription-ratio--switcher-choices) #'string<) + (sort (mapcar (lambda (entry) (symbol-name (car entry))) + cj/--transcription-backends) + #'string<)))) + +(ert-deftest test-transcription-config-every-descriptor-script-exists () + "Boundary: every descriptor names a script that exists under scripts/. +A descriptor for a script that never landed (a hosted alternative referenced +from another repo, say) would fail at transcription time instead." + (dolist (entry cj/--transcription-backends) + (let ((cj/transcribe-backend (car entry))) + (should (file-exists-p (cj/--transcription-script-path)))))) + +;;; Error + +(ert-deftest test-transcription-config-unknown-backend-still-signals () + "Error: adding ratio did not loosen the descriptor lookup; an unknown +backend still signals `user-error'." + (should-error (cj/--backend-plist 'no-such-backend) :type 'user-error)) + +(provide 'test-transcription-config--ratio-backend) +;;; test-transcription-config--ratio-backend.el ends here diff --git a/tests/test-undead-buffers--native-comp-log-undead.el b/tests/test-undead-buffers--native-comp-log-undead.el new file mode 100644 index 00000000..dee9a134 --- /dev/null +++ b/tests/test-undead-buffers--native-comp-log-undead.el @@ -0,0 +1,92 @@ +;;; test-undead-buffers--native-comp-log-undead.el --- the native-comp log survives the sweep -*- lexical-binding: t; -*- + +;;; Commentary: +;; Async native compilation parks every worker process on one buffer, +;; `comp-async-buffer-name' (*Async-native-compile-log*), and the worker's +;; sentinel reads that buffer back before it starts the next job. Killing +;; the buffer sends SIGHUP to every worker under it (they are :noquery, so +;; nothing asks), each sentinel then dies in `with-current-buffer' on the +;; dead buffer, and `comp--run-async-workers' is never called again: the +;; queue is stranded for the life of the daemon and nothing is ever cached. +;; +;; `cj/dashboard-only' on `emacs-startup-hook' runs +;; `cj/kill-all-other-buffers-and-windows', which is exactly such a sweep, +;; and in a real daemon `dashboard-insert-startupify-lists' has already +;; created *dashboard* on `after-init-hook', so the sweep branch is the one +;; that runs. These tests pin the log buffer to the undead list so the +;; sweep buries it and the workers live. The fixture puts a live :noquery +;; process on the buffer, because that is the state the bug needs; a plain +;; buffer would survive a kill-and-recreate just the same. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'undead-buffers) + +(defconst test-undead--comp-log "*Async-native-compile-log*") + +(defun test-undead--make-sleeper (buffer) + "Start a quiet, long-lived process attached to BUFFER and return it." + (make-process :name "test-undead-sleeper" :buffer buffer + :command '("sleep" "30") :noquery t)) + +(defun test-undead--settle () + "Let any signal the sweep sent land before liveness is observed." + (let ((deadline (+ (float-time) 0.3))) + (while (< (float-time) deadline) + (accept-process-output nil 0.05)))) + +;;; Normal Cases + +(ert-deftest test-undead-buffers-native-comp-log-is-undead-by-default () + "Normal: the module's default list makes the async-compile log bury-only." + (should (member test-undead--comp-log cj/undead-buffer-list)) + (should (cj/--buffer-undead-p test-undead--comp-log))) + +(ert-deftest test-undead-buffers-native-comp-log-name-matches-comp-run () + "Normal: the pinned name is the one comp-run actually uses. +A rename upstream would silently reopen the bug, so pin it to the variable." + (skip-unless (require 'comp-run nil t)) + (should (equal comp-async-buffer-name test-undead--comp-log))) + +(ert-deftest test-undead-buffers-native-comp-log-workers-survive-sweep () + "Normal: a worker parked on the log buffer is still running after the sweep. +The positive control is an ordinary process buffer, which the sweep kills +out from under its process -- that is what happened to the workers without +the undead entry. The control's process is not asserted dead: killing the +buffer sends SIGHUP, and a launching shell that ignores SIGHUP (nohup) hands +that disposition down, so its death is not deterministic across harnesses." + (skip-unless (executable-find "sleep")) + (delete-other-windows) + (let* ((main (current-buffer)) + (existing (get-buffer test-undead--comp-log)) + (log (or existing (get-buffer-create test-undead--comp-log))) + (victim (generate-new-buffer "*test-sweep-victim*")) + (worker (test-undead--make-sleeper log)) + (control (test-undead--make-sleeper victim))) + (unwind-protect + (progn + (cj/kill-all-other-buffers-and-windows) + (test-undead--settle) + (should (buffer-live-p main)) + (should (buffer-live-p log)) + (should (process-live-p worker)) + (should-not (buffer-live-p victim))) + (when (process-live-p worker) (delete-process worker)) + (when (process-live-p control) (delete-process control)) + (when (buffer-live-p victim) (kill-buffer victim)) + ;; Only remove what this test created. `kill-buffer' the function is + ;; not the remapped command, so the undead list doesn't apply. + (when (and (not existing) (buffer-live-p log)) (kill-buffer log)) + (delete-other-windows)))) + +;;; Boundary Cases + +(ert-deftest test-undead-buffers-native-comp-log-match-is-exact () + "Boundary: only the exact name is undead; a uniquified copy is not." + (should-not (cj/--buffer-undead-p "*Async-native-compile-log*<2>")) + (should-not (cj/--buffer-undead-p " *Async-native-compile-log*"))) + +(provide 'test-undead-buffers--native-comp-log-undead) +;;; test-undead-buffers--native-comp-log-undead.el ends here diff --git a/tests/test-undead-buffers--warnings-undead.el b/tests/test-undead-buffers--warnings-undead.el new file mode 100644 index 00000000..858dbf76 --- /dev/null +++ b/tests/test-undead-buffers--warnings-undead.el @@ -0,0 +1,63 @@ +;;; test-undead-buffers--warnings-undead.el --- *Warnings* survives the buffer sweep -*- lexical-binding: t; -*- + +;;; Commentary: +;; Emacs 31.1's warnings.el defers daemon-startup warnings into a one-shot +;; `after-make-frame-functions' closure that holds the *Warnings* buffer +;; object and displays it on the first client frame. Killing that buffer +;; during startup leaves the closure holding a dead buffer, `display-buffer' +;; then signals inside `make-frame', server.el reports the window system as +;; unsupported, and emacsclient silently retries on $DISPLAY -- the first +;; frame of the session lands on XWayland instead of Wayland. +;; +;; `cj/dashboard-only' on `emacs-startup-hook' runs +;; `cj/kill-all-other-buffers-and-windows', which is exactly such a sweep. +;; These tests pin *Warnings* to the undead list so the sweep buries it +;; instead of killing it. Error-path coverage of the predicate itself (a nil +;; or non-string name) lives in test-undead-buffers--buffer-undead-p.el. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'undead-buffers) + +;;; Normal Cases + +(ert-deftest test-undead-buffers-warnings-is-undead-by-default () + "Normal: the module's default list makes *Warnings* bury-only." + (should (member "*Warnings*" cj/undead-buffer-list)) + (should (cj/--buffer-undead-p "*Warnings*"))) + +(ert-deftest test-undead-buffers-warnings-survives-kill-all-other-buffers () + "Normal: the startup sweep buries *Warnings* rather than killing it. +This is the sweep `cj/dashboard-only' runs from `emacs-startup-hook'." + (delete-other-windows) + (unwind-protect + (let* ((main (current-buffer)) + (existing (get-buffer "*Warnings*")) + (warnings (or existing (get-buffer-create "*Warnings*"))) + (victim (generate-new-buffer "*test-sweep-victim*"))) + (unwind-protect + (progn + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should (buffer-live-p warnings)) + (should-not (buffer-live-p victim))) + (when (buffer-live-p victim) (kill-buffer victim)) + ;; Only remove what this test created. `kill-buffer' the function + ;; is not the remapped command, so the undead list doesn't apply. + (when (and (not existing) (buffer-live-p warnings)) + (kill-buffer warnings)))) + (delete-other-windows))) + +;;; Boundary Cases + +(ert-deftest test-undead-buffers-warnings-match-is-exact () + "Boundary: only the exact name is undead; a uniquified *Warnings*<2> is not. +The list matches exact names, so a second warnings buffer made by +`generate-new-buffer' is an ordinary buffer to the sweep." + (should-not (cj/--buffer-undead-p "*Warnings*<2>")) + (should-not (cj/--buffer-undead-p " *Warnings*"))) + +(provide 'test-undead-buffers--warnings-undead) +;;; test-undead-buffers--warnings-undead.el ends here diff --git a/tests/test-video-audio-recording--keybindings.el b/tests/test-video-audio-recording--keybindings.el index cdb6493a..9ddce661 100644 --- a/tests/test-video-audio-recording--keybindings.el +++ b/tests/test-video-audio-recording--keybindings.el @@ -1,25 +1,21 @@ ;;; test-video-audio-recording--keybindings.el --- recording toggle keybinding placement -*- lexical-binding: t; -*- ;;; Commentary: -;; The two recording toggles get a fast chord alongside the C-; r prefix: F9 -;; starts/stops video, S-F9 starts/stops audio. +;; The two recording toggles live only under the C-; r prefix. They used to +;; have a fast chord too: F9 for video, S-F9 for audio, claimed globally and in +;; every EAT map so char mode's :function category could not swallow them. ;; -;; Reaching them from inside an EAT buffer turns on which key categories each -;; input mode claims. Semi-char mode -- the default, and where agent buffers -;; sit -- is built from (:ascii :arrow :navigation) and never claims function -;; keys, so F9 already fell through to the global map there. Char mode adds -;; :function, binding f1 through f63 to `eat-self-input', and it is a minor -;; mode, so its map outranks `eat-mode-map'. The char-mode entries are the -;; load-bearing ones; the semi-char entry is belt-and-braces. +;; That chord went away on 2026-09-22. With Fn Lock on the Framework 13, the +;; F-key row sends plain function keys, so a bare F9 press started a screen +;; recording. The pair is removed as a unit: a lone S-F9 audio chord on a live +;; F-key row is one fat-finger from an unwanted recording, and the module +;; treated the two as one feature. ;; -;; :function claims only the unmodified keys, which is why getting this wrong -;; split the pair rather than breaking it outright: S-F9 toggled audio in a -;; char-mode buffer while F9 went to the program under the cursor. -;; -;; These tests require eat first so the module's `with-eval-after-load' fires. -;; The char-mode cases resolve through `key-binding' in a fixture that -;; reproduces minor-mode precedence, because reading a binding back out of the -;; map the module just wrote proves nothing about which map wins on a keypress. +;; These tests pin the removal. The char-mode case resolves through +;; `key-binding' in a fixture that reproduces minor-mode precedence, because +;; reading a map the module no longer writes proves nothing about which map wins +;; on a keypress. They require eat first so any `with-eval-after-load' the +;; module still carries would have fired. ;;; Code: @@ -32,56 +28,41 @@ (require 'eat) (require 'video-audio-recording) +(defconst test-video-audio-recording--toggles + '(cj/video-recording-toggle cj/audio-recording-toggle) + "The two commands the retired F9 chords used to reach.") + +(defun test-video-audio-recording--bound-to-toggle-p (binding) + "Return non-nil when BINDING is one of the recording toggles." + (memq binding test-video-audio-recording--toggles)) + ;;; Normal -(ert-deftest test-video-audio-recording-f9-bound-globally () - "Normal: F9 toggles video recording, S-F9 toggles audio recording." - (should (eq (lookup-key (current-global-map) (kbd "<f9>")) - #'cj/video-recording-toggle)) - (should (eq (lookup-key (current-global-map) (kbd "S-<f9>")) - #'cj/audio-recording-toggle))) - -(ert-deftest test-video-audio-recording-f9-bound-in-eat-semi-char-mode-map () - "Normal: both chords are bound in `eat-semi-char-mode-map'. -Redundant rather than load-bearing: semi-char is built without :function, so a -function key already falls through to the global map. Asserted anyway so the -entry cannot be dropped silently while the comment explaining it stays." - (should (eq (keymap-lookup eat-semi-char-mode-map "<f9>") - #'cj/video-recording-toggle)) - (should (eq (keymap-lookup eat-semi-char-mode-map "S-<f9>") - #'cj/audio-recording-toggle))) - -(ert-deftest test-video-audio-recording-f9-bound-in-eat-mode-map () - "Normal: both chords are bound in `eat-mode-map', the major-mode map every -EAT buffer carries regardless of input mode." - (should (eq (keymap-lookup eat-mode-map "<f9>") - #'cj/video-recording-toggle)) - (should (eq (keymap-lookup eat-mode-map "S-<f9>") - #'cj/audio-recording-toggle))) - -(ert-deftest test-video-audio-recording-f9-bound-in-eat-char-mode-maps () - "Normal: both chords are bound in the two char-mode maps. -Char mode is built with EAT's :function category, which binds f1 through f63 -to `eat-self-input'. These entries are what override that." - (dolist (map (list eat-char-mode-map eat-eshell-char-mode-map)) - (should (eq (keymap-lookup map "<f9>") #'cj/video-recording-toggle)) - (should (eq (keymap-lookup map "S-<f9>") #'cj/audio-recording-toggle)))) +(ert-deftest test-video-audio-recording-f9-not-bound-globally () + "Normal/regression: neither F9 nor S-F9 reaches a recording toggle globally." + (should-not (test-video-audio-recording--bound-to-toggle-p + (lookup-key (current-global-map) (kbd "<f9>")))) + (should-not (test-video-audio-recording--bound-to-toggle-p + (lookup-key (current-global-map) (kbd "S-<f9>"))))) + +(ert-deftest test-video-audio-recording-f9-not-bound-in-eat-maps () + "Normal/regression: none of the four EAT maps carries a recording toggle on +F9 or S-F9. The module used to write all four so the chord survived char +mode; the removal has to reach every one of them." + (dolist (map (list eat-semi-char-mode-map eat-mode-map + eat-char-mode-map eat-eshell-char-mode-map)) + (should-not (test-video-audio-recording--bound-to-toggle-p + (keymap-lookup map "<f9>"))) + (should-not (test-video-audio-recording--bound-to-toggle-p + (keymap-lookup map "S-<f9>"))))) ;;; Boundary -(ert-deftest test-video-audio-recording-f9-chords-are-distinct () - "Boundary: the shifted and unshifted chords resolve to different commands. -A copy-paste binding both to the same toggle would satisfy every -binding-is-present assertion above, so assert the difference directly." - (should-not (eq (lookup-key (current-global-map) (kbd "<f9>")) - (lookup-key (current-global-map) (kbd "S-<f9>"))))) - (defun test-video-audio-recording--in-char-mode (body) "Run BODY in a buffer wired the way a live EAT char-mode buffer is. `eat--char-mode' is a minor mode, so its map is consulted ahead of the -major-mode map. Reproducing that ordering is the point: reading a binding -back out of the map the module just wrote proves nothing about which map wins -when a key is actually pressed." +major-mode map. Reproducing that ordering is the point: the assertion is +about which map wins when a key is actually pressed." (with-temp-buffer (use-local-map eat-mode-map) (let ((minor-mode-overriding-map-alist @@ -89,42 +70,34 @@ when a key is actually pressed." (eat--char-mode t)) (funcall body)))) -(ert-deftest test-video-audio-recording-f9-resolves-in-char-mode () - "Boundary: both chords resolve to the toggles through the real precedence -chain in a char-mode buffer. Before this override F9 resolved to -`eat-self-input' and went to the program under the cursor, while S-F9 reached -Emacs — so the pair silently split, audio recording and video not." +(ert-deftest test-video-audio-recording-f9-reaches-program-in-char-mode () + "Boundary: in a char-mode buffer F9 goes to the program under the cursor +again. EAT's :function category binds f1 through f63 to `eat-self-input'; +the module's override used to sit in front of it, and now nothing does." (test-video-audio-recording--in-char-mode (lambda () - (should (eq (key-binding (kbd "<f9>")) #'cj/video-recording-toggle)) - (should (eq (key-binding (kbd "S-<f9>")) #'cj/audio-recording-toggle))))) + (should (eq (key-binding (kbd "<f9>")) #'eat-self-input))))) ;;; Error (ert-deftest test-video-audio-recording-char-mode-fixture-really-is-char-mode () "Error (positive control): the char-mode fixture genuinely puts EAT's map in front. F8 sits in the same :function category as F9 and this module never -touches it, so it must still reach `eat-self-input'. If it resolves anywhere -else the fixture is inert, and the resolution test above would pass without -ever consulting `eat-char-mode-map' — which is precisely how the first cut of -this file missed that F9 was being swallowed there." +touched it, so it must reach `eat-self-input'. If it resolves anywhere else +the fixture is inert and the F9 assertion above passes for the wrong reason." (test-video-audio-recording--in-char-mode (lambda () (should (eq (key-binding (kbd "<f8>")) #'eat-self-input))))) -(ert-deftest test-video-audio-recording-f9-targets-are-commands () - "Error: a key bound to a non-interactive function fails at press time with a -`commandp' error rather than at load, so assert both targets are real commands." - (should (commandp (lookup-key (current-global-map) (kbd "<f9>")))) - (should (commandp (lookup-key (current-global-map) (kbd "S-<f9>"))))) - (ert-deftest test-video-audio-recording-prefix-bindings-still-reachable () - "Error/regression (positive control): the fast chords must not disturb the -C-; r prefix path. Without this, deleting the prefix map outright would leave -every assertion above green." + "Error/regression (positive control): removing the fast chords must leave +the C-; r prefix path intact. Without this, deleting the toggles outright +would leave every not-bound assertion above green." (should (eq (keymap-lookup cj/record-map "v") #'cj/video-recording-toggle)) (should (eq (keymap-lookup cj/record-map "a") #'cj/audio-recording-toggle)) - (should (eq (keymap-lookup cj/custom-keymap "r") cj/record-map))) + (should (eq (keymap-lookup cj/custom-keymap "r") cj/record-map)) + (should (commandp #'cj/video-recording-toggle)) + (should (commandp #'cj/audio-recording-toggle))) (provide 'test-video-audio-recording--keybindings) ;;; test-video-audio-recording--keybindings.el ends here |