blob: a5210be01b0aec9b3449d2834789a5aff832c882 (
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
;;; 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
;;
;; 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:
(require 'cl-lib)
(require 'autorevert)
(require 'bookmark)
(require 'ert)
(require 'server)
(require 'vc-hooks)
;; user-constants supplies `user-home-dir' and `org-dir', and
;; host-environment supplies `env-bsd-p', both of which system-defaults
;; reads at load. Required first so the symbols are defined before the
;; require fires the side effects we don't stub away. (system-defaults
;; itself declares these only via `eval-when-compile', so the compiled
;; module cannot resolve them standalone — tracked as a Phase 2 fix.)
(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)
(require 'host-environment)
;; 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.
;; Contain system-defaults' load-time `(setq default-directory user-home-dir)'
;; 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.
(let ((default-directory default-directory)
(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."
(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."
(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."
(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."
(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."
(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."
(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."
(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."
(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
|
