1 ;;; files-tests.el --- tests for files.el.
3 ;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; Set to t if the local variable was set, `query' if the query was
26 (defvar files-test-result nil
)
28 (defvar files-test-safe-result nil
)
29 (put 'files-test-safe-result
'safe-local-variable
'booleanp
)
31 (defun files-test-fun1 ()
32 (setq files-test-result t
))
35 ;; `enable-local-variables' t, nil, :safe, :all, or something else.
36 ;; `enable-local-eval' t, nil, or something else.
38 (defvar files-test-local-variable-data
40 '((("eval: (files-test-fun1)")
41 (t t
(eq files-test-result t
))
42 (t nil
(eq files-test-result nil
))
43 (t maybe
(eq files-test-result
'query
))
44 (nil t
(eq files-test-result nil
))
45 (nil nil
(eq files-test-result nil
))
46 (nil maybe
(eq files-test-result nil
))
47 (:safe t
(eq files-test-result nil
))
48 (:safe nil
(eq files-test-result nil
))
49 (:safe maybe
(eq files-test-result nil
))
50 (:all t
(eq files-test-result t
))
51 (:all nil
(eq files-test-result nil
))
52 (:all maybe
(eq files-test-result t
)) ; This combination is ambiguous.
53 (maybe t
(eq files-test-result
'query
))
54 (maybe nil
(eq files-test-result nil
))
55 (maybe maybe
(eq files-test-result
'query
)))
56 ;; Unsafe local variable value
57 (("files-test-result: t")
58 (t t
(eq files-test-result
'query
))
59 (t nil
(eq files-test-result
'query
))
60 (t maybe
(eq files-test-result
'query
))
61 (nil t
(eq files-test-result nil
))
62 (nil nil
(eq files-test-result nil
))
63 (nil maybe
(eq files-test-result nil
))
64 (:safe t
(eq files-test-result nil
))
65 (:safe nil
(eq files-test-result nil
))
66 (:safe maybe
(eq files-test-result nil
))
67 (:all t
(eq files-test-result t
))
68 (:all nil
(eq files-test-result t
))
69 (:all maybe
(eq files-test-result t
))
70 (maybe t
(eq files-test-result
'query
))
71 (maybe nil
(eq files-test-result
'query
))
72 (maybe maybe
(eq files-test-result
'query
)))
73 ;; Safe local variable
74 (("files-test-safe-result: t")
75 (t t
(eq files-test-safe-result t
))
76 (t nil
(eq files-test-safe-result t
))
77 (t maybe
(eq files-test-safe-result t
))
78 (nil t
(eq files-test-safe-result nil
))
79 (nil nil
(eq files-test-safe-result nil
))
80 (nil maybe
(eq files-test-safe-result nil
))
81 (:safe t
(eq files-test-safe-result t
))
82 (:safe nil
(eq files-test-safe-result t
))
83 (:safe maybe
(eq files-test-safe-result t
))
84 (:all t
(eq files-test-safe-result t
))
85 (:all nil
(eq files-test-safe-result t
))
86 (:all maybe
(eq files-test-safe-result t
))
87 (maybe t
(eq files-test-result
'query
))
88 (maybe nil
(eq files-test-result
'query
))
89 (maybe maybe
(eq files-test-result
'query
)))
90 ;; Safe local variable with unsafe value
91 (("files-test-safe-result: 1")
92 (t t
(eq files-test-result
'query
))
93 (t nil
(eq files-test-result
'query
))
94 (t maybe
(eq files-test-result
'query
))
95 (nil t
(eq files-test-safe-result nil
))
96 (nil nil
(eq files-test-safe-result nil
))
97 (nil maybe
(eq files-test-safe-result nil
))
98 (:safe t
(eq files-test-safe-result nil
))
99 (:safe nil
(eq files-test-safe-result nil
))
100 (:safe maybe
(eq files-test-safe-result nil
))
101 (:all t
(eq files-test-safe-result
1))
102 (:all nil
(eq files-test-safe-result
1))
103 (:all maybe
(eq files-test-safe-result
1))
104 (maybe t
(eq files-test-result
'query
))
105 (maybe nil
(eq files-test-result
'query
))
106 (maybe maybe
(eq files-test-result
'query
))))
107 "List of file-local variable tests.
108 Each list element should have the form
110 (LOCAL-VARS-LIST . TEST-LIST)
112 where LOCAL-VARS-LISTS should be a list of local variable
113 definitions (strings) and TEST-LIST is a list of tests to
114 perform. Each entry of TEST-LIST should have the form
116 (ENABLE-LOCAL-VARIABLES ENABLE-LOCAL-EVAL FORM)
118 where ENABLE-LOCAL-VARIABLES is the value to assign to
119 `enable-local-variables', ENABLE-LOCAL-EVAL is the value to
120 assign to `enable-local-eval', and FORM is a desired `should'
123 (defun file-test--do-local-variables-test (str test-settings
)
126 (setq files-test-result nil
127 files-test-safe-result nil
)
128 (let ((enable-local-variables (nth 0 test-settings
))
129 (enable-local-eval (nth 1 test-settings
))
130 ;; Prevent any dir-locals file interfering with the tests.
131 (enable-dir-local-variables nil
)
132 (files-test-queried nil
))
133 (hack-local-variables)
134 (eval (nth 2 test-settings
)))))
136 (ert-deftest files-test-local-variables
()
137 "Test the file-local variables implementation."
140 (defadvice hack-local-variables-confirm
(around files-test activate
)
141 (setq files-test-result
'query
)
143 (dolist (test files-test-local-variable-data
)
144 (let ((str (concat "text\n\n;; Local Variables:\n;; "
145 (mapconcat 'identity
(car test
) "\n;; ")
147 (dolist (subtest (cdr test
))
148 (should (file-test--do-local-variables-test str subtest
))))))
149 (ad-disable-advice 'hack-local-variables-confirm
'around
'files-test
)))
151 (defvar files-test-bug-18141-file
152 (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY"))
153 "Test file for bug#18141.")
155 (ert-deftest files-test-bug-18141
()
156 "Test for http://debbugs.gnu.org/18141 ."
157 (skip-unless (executable-find "gzip"))
158 (let ((tempfile (make-temp-file "files-test-bug-18141" nil
".gz")))
161 (copy-file files-test-bug-18141-file tempfile t
)
162 (with-current-buffer (find-file-noselect tempfile
)
163 (set-buffer-modified-p t
)
165 (should (eq buffer-file-coding-system
'iso-2022-7bit-unix
))))
166 (delete-file tempfile
))))
169 ;; Stop the above "Local Var..." confusing Emacs.
172 (ert-deftest files-test-bug-21454
()
173 "Test for http://debbugs.gnu.org/21454 ."
174 :expected-result
:failed
176 '(("/foo/bar//baz/:/bar/foo/baz//" nil
("/foo/bar/baz/" "/bar/foo/baz/"))
177 ("/foo/bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
178 ("//foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
179 ("/foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
180 ("/foo//bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
181 ("/foo//bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
182 ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
183 ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))
184 (foo-env (getenv "FOO"))
185 (bar-env (getenv "BAR")))
187 (dolist (test input-result
)
188 (let ((foo (nth 0 test
))
195 (should (equal res
(parse-colon-path (getenv "BAR")))))
196 (should (equal res
(parse-colon-path "$FOO"))))))
197 (setenv "FOO" foo-env
)
198 (setenv "BAR" bar-env
))))
200 (ert-deftest files-test--save-buffers-kill-emacs--confirm-kill-processes
()
201 "Test that `save-buffers-kill-emacs' honors
202 `confirm-kill-processes'."
203 (cl-letf* ((yes-or-no-p-prompts nil
)
204 ((symbol-function #'yes-or-no-p
)
206 (push prompt yes-or-no-p-prompts
)
208 (kill-emacs-args nil
)
209 ((symbol-function #'kill-emacs
)
210 (lambda (&optional arg
) (push arg kill-emacs-args
)))
215 (expand-file-name invocation-name invocation-directory
)
216 "-batch" "-Q" "-eval" "(sleep-for 1000)")))
217 (confirm-kill-processes nil
))
218 (save-buffers-kill-emacs)
219 (kill-process process
)
220 (should-not yes-or-no-p-prompts
)
221 (should (equal kill-emacs-args
'(nil)))))
223 (ert-deftest files-test-read-file-in-~
()
224 "Test file prompting in directory named '~'.
225 If we are in a directory named '~', the default value should not
227 (cl-letf (((symbol-function 'completing-read
)
228 (lambda (_prompt _coll
&optional _pred _req init _hist def _
)
230 (dir (make-temp-file "read-file-name-test" t
)))
232 (let ((subdir (expand-file-name "./~/" dir
)))
233 (make-directory subdir t
)
235 (setq default-directory subdir
)
237 (expand-file-name (read-file-name "File: "))
238 (expand-file-name "~/")))
239 ;; Don't overquote either!
240 (setq default-directory
(concat "/:" subdir
))
242 (expand-file-name (read-file-name "File: "))
243 (concat "/:/:" subdir
)))))
244 (delete-directory dir
'recursive
))))
246 (provide 'files-tests
)
247 ;;; files-tests.el ends here