diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-system-defaults-functions.el | 196 |
1 files changed, 106 insertions, 90 deletions
diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index 6d0042ed..580e7a7c 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -15,8 +15,12 @@ ;; file rather than the *Warnings* ;; buffer ;; -;; Loaded via the sandbox in test-system-defaults-vc-follow-symlinks.el -;; -- the module has startup side effects that we stub there. +;; The module has startup side effects, so we wrap a single +;; top-level `require' in `cl-letf' stubs for the side-effecting +;; primitives. Per-test reload via `(load ...)' would technically +;; work but undercover.el's instrumentation only sees the first +;; load, so the function bodies show up as uncovered even though +;; the tests run them. Loading once at top level fixes that. ;;; Code: @@ -27,129 +31,141 @@ (require 'server) (require 'vc-hooks) -(defvar org-dir nil) -(defvar user-home-dir nil) -(defvar use-package-always-ensure nil) - -(defconst test-system-defaults-functions--repo-root - (file-name-directory - (directory-file-name - (file-name-directory (or load-file-name buffer-file-name)))) - "Repository root for system-defaults function tests.") - -(defmacro test-system-defaults-functions--with-load-environment (&rest body) - "Load system-defaults.el under a sandbox, then evaluate BODY." - `(let ((user-emacs-directory (file-name-as-directory - (make-temp-file "system-defaults-fn-emacs-" t))) - (user-home-dir (file-name-as-directory - (make-temp-file "system-defaults-fn-home-" t))) - (org-dir (file-name-as-directory - (make-temp-file "system-defaults-fn-org-" t))) - (use-package-always-ensure nil)) - (cl-letf (((symbol-function 'server-running-p) (lambda (&rest _) t)) - ((symbol-function 'server-start) #'ignore) - ((symbol-function 'set-locale-environment) #'ignore) - ((symbol-function 'prefer-coding-system) #'ignore) - ((symbol-function 'set-default-coding-systems) #'ignore) - ((symbol-function 'set-terminal-coding-system) #'ignore) - ((symbol-function 'set-keyboard-coding-system) #'ignore) - ((symbol-function 'set-selection-coding-system) #'ignore) - ((symbol-function 'set-charset-priority) #'ignore) - ((symbol-function 'global-auto-revert-mode) #'ignore) - ((symbol-function 'recentf-mode) #'ignore)) - (unless (fboundp 'use-package) - (defmacro use-package (&rest _args) nil)) - (load (expand-file-name "modules/system-defaults.el" - test-system-defaults-functions--repo-root) - nil t) - ,@body))) +;; user-constants supplies `user-home-dir' and `org-dir' that +;; system-defaults reads. Required first so they hold real paths +;; before the require fires the side effects we don't stub away. +(add-to-list 'load-path + (file-name-concat + (file-name-directory + (directory-file-name + (file-name-directory (or load-file-name buffer-file-name)))) + "modules")) +(require 'user-constants) + +;; Load system-defaults ONCE with side-effecting primitives stubbed. +;; This pattern lets undercover see and instrument the function +;; bodies. Stubs deliberately scope only to the require so the +;; real primitives remain available for unrelated tests in the +;; same Emacs. +(let ((use-package-always-ensure nil)) + (cl-letf (((symbol-function 'server-running-p) (lambda (&rest _) t)) + ((symbol-function 'server-start) #'ignore) + ((symbol-function 'set-locale-environment) #'ignore) + ((symbol-function 'prefer-coding-system) #'ignore) + ((symbol-function 'set-default-coding-systems) #'ignore) + ((symbol-function 'set-terminal-coding-system) #'ignore) + ((symbol-function 'set-keyboard-coding-system) #'ignore) + ((symbol-function 'set-selection-coding-system) #'ignore) + ((symbol-function 'set-charset-priority) #'ignore) + ((symbol-function 'global-auto-revert-mode) #'ignore) + ((symbol-function 'recentf-mode) #'ignore)) + (unless (fboundp 'use-package) + (defmacro use-package (&rest _args) nil)) + (require 'system-defaults))) ;;; cj/disabled (ert-deftest test-system-defaults-disabled-normal-returns-nil () "Normal: `cj/disabled' is a silent interactive no-op." - (test-system-defaults-functions--with-load-environment - (should (eq (cj/disabled) nil)) - (should (commandp #'cj/disabled)))) + (should (eq (cj/disabled) nil)) + (should (commandp #'cj/disabled))) ;;; cj/minibuffer-setup-hook / cj/minibuffer-exit-hook (ert-deftest test-system-defaults-minibuffer-setup-inflates-gc-threshold () "Normal: entering the minibuffer raises `gc-cons-threshold' to most-positive-fixnum." - (test-system-defaults-functions--with-load-environment - (let ((gc-cons-threshold 800000)) - (cj/minibuffer-setup-hook) - (should (= gc-cons-threshold most-positive-fixnum))))) + (let ((gc-cons-threshold 800000)) + (cj/minibuffer-setup-hook) + (should (= gc-cons-threshold most-positive-fixnum)))) (ert-deftest test-system-defaults-minibuffer-exit-restores-gc-threshold () "Normal: leaving the minibuffer restores `gc-cons-threshold' to 800000." - (test-system-defaults-functions--with-load-environment - (let ((gc-cons-threshold most-positive-fixnum)) - (cj/minibuffer-exit-hook) - (should (= gc-cons-threshold 800000))))) + (let ((gc-cons-threshold most-positive-fixnum)) + (cj/minibuffer-exit-hook) + (should (= gc-cons-threshold 800000)))) ;;; unpropertize-kill-ring (ert-deftest test-system-defaults-unpropertize-kill-ring-strips-properties () "Normal: every kill-ring entry comes back with no text properties." - (test-system-defaults-functions--with-load-environment - (let ((kill-ring (list (propertize "alpha" 'face 'bold) - (propertize "beta" 'face 'underline)))) - (unpropertize-kill-ring) - (should (equal kill-ring '("alpha" "beta"))) - (should-not (text-properties-at 0 (nth 0 kill-ring))) - (should-not (text-properties-at 0 (nth 1 kill-ring)))))) + (let ((kill-ring (list (propertize "alpha" 'face 'bold) + (propertize "beta" 'face 'underline)))) + (unpropertize-kill-ring) + (should (equal kill-ring '("alpha" "beta"))) + (should-not (text-properties-at 0 (nth 0 kill-ring))) + (should-not (text-properties-at 0 (nth 1 kill-ring))))) (ert-deftest test-system-defaults-unpropertize-kill-ring-boundary-empty-ring () "Boundary: an empty `kill-ring' stays empty after the strip pass." - (test-system-defaults-functions--with-load-environment - (let ((kill-ring nil)) - (unpropertize-kill-ring) - (should (null kill-ring))))) + (let ((kill-ring nil)) + (unpropertize-kill-ring) + (should (null kill-ring)))) ;;; cj/log-comp-warning (ert-deftest test-system-defaults-log-comp-warning-writes-log-line () "Normal: a TYPE containing `comp' writes a timestamped line to the log." - (test-system-defaults-functions--with-load-environment - (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) - (unwind-protect - (progn - (cj/log-comp-warning 'comp "hello %s" "world") - (with-temp-buffer - (insert-file-contents comp-warnings-log) - (let ((contents (buffer-string))) - (should (string-match-p "hello world" contents)) - ;; Bracketed timestamp prefix. - (should (string-match-p "^\\[" contents))))) - (delete-file comp-warnings-log))))) + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + (cj/log-comp-warning 'comp "hello %s" "world") + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (let ((contents (buffer-string))) + (should (string-match-p "hello world" contents)) + (should (string-match-p "^\\[" contents))))) + (delete-file comp-warnings-log)))) (ert-deftest test-system-defaults-log-comp-warning-list-type-includes-comp () "Boundary: a list TYPE matches when `comp' is one of its elements." - (test-system-defaults-functions--with-load-environment - (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) - (unwind-protect - (progn - (cj/log-comp-warning '(comp warning) "alpha") - (with-temp-buffer - (insert-file-contents comp-warnings-log) - (should (string-match-p "alpha" (buffer-string))))) - (delete-file comp-warnings-log))))) + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + (cj/log-comp-warning '(comp warning) "alpha") + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (should (string-match-p "alpha" (buffer-string))))) + (delete-file comp-warnings-log)))) (ert-deftest test-system-defaults-log-comp-warning-non-comp-type-is-noop () "Boundary: a TYPE that doesn't include `comp' returns nil and writes nothing. `display-warning' interprets nil as \"I didn't handle it\" -- so the default *Warnings* buffer path keeps working for unrelated warnings." - (test-system-defaults-functions--with-load-environment - (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) - (unwind-protect - (progn - (should (null (cj/log-comp-warning 'unrelated "ignored"))) - (with-temp-buffer - (insert-file-contents comp-warnings-log) - (should (string-empty-p (buffer-string))))) - (delete-file comp-warnings-log))))) + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + (should (null (cj/log-comp-warning 'unrelated "ignored"))) + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (should (string-empty-p (buffer-string))))) + (delete-file comp-warnings-log)))) + +(ert-deftest test-system-defaults-log-comp-warning-list-type-without-comp () + "Boundary: a list TYPE that doesn't contain `comp' returns nil and +exercises the `(when (memq ...))' guard with a non-matching list." + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + (should (null (cj/log-comp-warning '(unrelated warning) "ignored"))) + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (should (string-empty-p (buffer-string))))) + (delete-file comp-warnings-log)))) + +(ert-deftest test-system-defaults-log-comp-warning-non-string-message () + "Boundary: a non-string MESSAGE falls into the `format \"%S %S\"' branch +and the rendered S-expression lands in the log." + (let ((comp-warnings-log (make-temp-file "comp-warnings-" nil ".log"))) + (unwind-protect + (progn + (cj/log-comp-warning 'comp '(some-symbol :slot 42)) + (with-temp-buffer + (insert-file-contents comp-warnings-log) + (let ((contents (buffer-string))) + (should (string-match-p "some-symbol" contents)) + (should (string-match-p ":slot" contents))))) + (delete-file comp-warnings-log)))) (provide 'test-system-defaults-functions) ;;; test-system-defaults-functions.el ends here |