blob: 6d0042ed08702e5b064ee7d1798f18acf8f1a539 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
;;; test-system-defaults-functions.el --- Tests for the helper functions in system-defaults -*- lexical-binding: t; -*-
;;; Commentary:
;; system-defaults.el is mostly `setq' configuration but ships a handful
;; of small interactive / hook helpers:
;;
;; cj/disabled -- no-op stub used by `defalias' for
;; commands we don't want surfaced
;; cj/minibuffer-setup-hook -- inflate gc-cons-threshold while
;; typing in the minibuffer
;; cj/minibuffer-exit-hook -- restore gc-cons-threshold on exit
;; unpropertize-kill-ring -- strip text properties from
;; kill-ring at shutdown
;; cj/log-comp-warning -- route native-comp warnings to a
;; 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.
;;; Code:
(require 'cl-lib)
(require 'autorevert)
(require 'bookmark)
(require 'ert)
(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)))
;;; 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))))
;;; 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)))))
(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)))))
;;; 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))))))
(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)))))
;;; 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)))))
(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)))))
(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)))))
(provide 'test-system-defaults-functions)
;;; test-system-defaults-functions.el ends here
|
