aboutsummaryrefslogtreecommitdiff
path: root/tests/test-architecture-startup-contracts.el
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-15 02:13:37 -0500
committerCraig Jennings <c@cjennings.net>2026-05-15 02:13:37 -0500
commitc3420106b57b999db6526c62c1ce0e33c28ef121 (patch)
treedd5886f3f690680a7b7fd4420181f875abb283c0 /tests/test-architecture-startup-contracts.el
parent4d8f979948d5349404a36fe335eb77955d068a8d (diff)
downloaddotemacs-c3420106b57b999db6526c62c1ce0e33c28ef121.tar.gz
dotemacs-c3420106b57b999db6526c62c1ce0e33c28ef121.zip
test(architecture): guard top-level timers + add startup-contract smoke test
Add a tiny source-level architecture suite at tests/test-architecture-startup-contracts.el with two checks: - Only keybindings.el may globally own the exact C-; prefix. Catches accidental cross-module rebinding before it ships. - Top-level timer scheduling (run-with-timer / run-at-time / run-with-idle-timer) must be guarded by (unless noninteractive ...) so requiring a module in batch / test mode does not schedule startup timers. Timer calls inside defuns are exempt -- the test only rejects forms that execute their body when the module loads. Four modules had unguarded top-level timer scheduling and would have tripped the new test. Wrap their startup hooks/timers in (unless noninteractive ...): - modules/org-agenda-config.el: 10s idle cache build - modules/org-refile-config.el: 5s idle cache build - modules/quick-video-capture.el: after-init-hook + 2s fallback - modules/wrap-up.el: emacs-startup-hook bury-buffers delay The contract being protected is "requiring a module in batch should not start a clock running." Test failures will now point straight at the offending file/form.
Diffstat (limited to 'tests/test-architecture-startup-contracts.el')
-rw-r--r--tests/test-architecture-startup-contracts.el104
1 files changed, 104 insertions, 0 deletions
diff --git a/tests/test-architecture-startup-contracts.el b/tests/test-architecture-startup-contracts.el
new file mode 100644
index 00000000..a3a0e09b
--- /dev/null
+++ b/tests/test-architecture-startup-contracts.el
@@ -0,0 +1,104 @@
+;;; test-architecture-startup-contracts.el --- Startup architecture smoke tests -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Lightweight source-level checks for cross-module startup contracts. These
+;; deliberately avoid requiring package-heavy modules; the goal is to catch
+;; accidental load-order and batch-startup regressions early without building a
+;; full static analyzer.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+(defconst test-architecture--repo-root
+ (file-name-directory
+ (directory-file-name
+ (file-name-directory (or load-file-name buffer-file-name))))
+ "Repository root for architecture contract tests.")
+
+(defun test-architecture--module-files ()
+ "Return all direct module source files."
+ (directory-files (expand-file-name "modules" test-architecture--repo-root)
+ t "\\.el\\'"))
+
+(defun test-architecture--file-string (file)
+ "Return FILE contents as a string."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (buffer-string)))
+
+(defun test-architecture--read-top-level-forms (file)
+ "Read top-level forms from FILE."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (let (forms)
+ (condition-case nil
+ (while t
+ (push (read (current-buffer)) forms))
+ (end-of-file (nreverse forms))))))
+
+(defun test-architecture--contains-timer-form-p (form)
+ "Return non-nil when FORM contains a timer scheduling call."
+ (cond
+ ((atom form) nil)
+ ((memq (car form) '(run-with-timer run-at-time run-with-idle-timer)) t)
+ (t (or (test-architecture--contains-timer-form-p (car form))
+ (test-architecture--contains-timer-form-p (cdr form))))))
+
+(defun test-architecture--noninteractive-guard-p (form)
+ "Return non-nil when FORM is guarded against batch/noninteractive startup."
+ (and (consp form)
+ (or (and (eq (car form) 'unless)
+ (eq (cadr form) 'noninteractive))
+ (and (eq (car form) 'when)
+ (equal (cadr form) '(not noninteractive))))))
+
+(defun test-architecture--definition-form-p (form)
+ "Return non-nil when FORM defines code but does not execute its body now."
+ (and (consp form)
+ (memq (car form) '(defun defmacro defsubst cl-defun cl-defmacro))))
+
+(defun test-architecture--unguarded-top-level-timer-forms (file)
+ "Return top-level timer scheduling forms in FILE that are not batch-guarded."
+ (let (violations)
+ (dolist (form (test-architecture--read-top-level-forms file))
+ (when (and (test-architecture--contains-timer-form-p form)
+ (not (test-architecture--definition-form-p form))
+ (not (test-architecture--noninteractive-guard-p form)))
+ (push (prin1-to-string form) violations)))
+ (nreverse violations)))
+
+(ert-deftest test-architecture-custom-prefix-owned-by-keybindings ()
+ "Only keybindings.el may globally own the exact C-; prefix."
+ (let ((owner (expand-file-name "modules/keybindings.el"
+ test-architecture--repo-root))
+ offenders)
+ (dolist (file (test-architecture--module-files))
+ (let ((contents (test-architecture--file-string file)))
+ (when (and (not (string= file owner))
+ (or (string-match-p "(keymap-global-set[[:space:]\n]+\"C-;\"" contents)
+ (string-match-p "(global-set-key[[:space:]\n]+(kbd[[:space:]\n]+\"C-;\"" contents)))
+ (push (file-relative-name file test-architecture--repo-root) offenders))))
+ (should (string-match-p "(keymap-global-set[[:space:]\n]+\"C-;\""
+ (test-architecture--file-string owner)))
+ (should-not offenders)))
+
+(ert-deftest test-architecture-top-level-timers-are-batch-guarded ()
+ "Top-level timer scheduling must be guarded by noninteractive.
+
+Function definitions may contain timer calls; this test only rejects timer
+scheduling that can run while a module is being required in batch/test mode."
+ (let (offenders)
+ (dolist (file (test-architecture--module-files))
+ (let ((violations (test-architecture--unguarded-top-level-timer-forms file)))
+ (when violations
+ (push (format "%s: %s"
+ (file-relative-name file test-architecture--repo-root)
+ (string-join violations " "))
+ offenders))))
+ (should-not offenders)))
+
+(provide 'test-architecture-startup-contracts)
+;;; test-architecture-startup-contracts.el ends here