1 ;;; files-tests.el --- tests for files.el. -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2012-2018 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 <https://www.gnu.org/licenses/>.
24 (eval-when-compile (require 'cl-lib
))
25 (require 'bytecomp
) ; `byte-compiler-base-file-name'.
26 (require 'dired
) ; `dired-uncache'.
27 (require 'filenotify
) ; `file-notify-add-watch'.
29 ;; Set to t if the local variable was set, `query' if the query was
31 (defvar files-test-result nil
)
33 (defvar files-test-safe-result nil
)
34 (put 'files-test-safe-result
'safe-local-variable
'booleanp
)
36 (defun files-test-fun1 ()
37 (setq files-test-result t
))
40 ;; `enable-local-variables' t, nil, :safe, :all, or something else.
41 ;; `enable-local-eval' t, nil, or something else.
43 (defvar files-test-local-variable-data
45 '((("eval: (files-test-fun1)")
46 (t t
(eq files-test-result t
))
47 (t nil
(eq files-test-result nil
))
48 (t maybe
(eq files-test-result
'query
))
49 (nil t
(eq files-test-result nil
))
50 (nil nil
(eq files-test-result nil
))
51 (nil maybe
(eq files-test-result nil
))
52 (:safe t
(eq files-test-result nil
))
53 (:safe nil
(eq files-test-result nil
))
54 (:safe maybe
(eq files-test-result nil
))
55 (:all t
(eq files-test-result t
))
56 (:all nil
(eq files-test-result nil
))
57 (:all maybe
(eq files-test-result t
)) ; This combination is ambiguous.
58 (maybe t
(eq files-test-result
'query
))
59 (maybe nil
(eq files-test-result nil
))
60 (maybe maybe
(eq files-test-result
'query
)))
61 ;; Unsafe local variable value
62 (("files-test-result: t")
63 (t t
(eq files-test-result
'query
))
64 (t nil
(eq files-test-result
'query
))
65 (t maybe
(eq files-test-result
'query
))
66 (nil t
(eq files-test-result nil
))
67 (nil nil
(eq files-test-result nil
))
68 (nil maybe
(eq files-test-result nil
))
69 (:safe t
(eq files-test-result nil
))
70 (:safe nil
(eq files-test-result nil
))
71 (:safe maybe
(eq files-test-result nil
))
72 (:all t
(eq files-test-result t
))
73 (:all nil
(eq files-test-result t
))
74 (:all maybe
(eq files-test-result t
))
75 (maybe t
(eq files-test-result
'query
))
76 (maybe nil
(eq files-test-result
'query
))
77 (maybe maybe
(eq files-test-result
'query
)))
78 ;; Safe local variable
79 (("files-test-safe-result: t")
80 (t t
(eq files-test-safe-result t
))
81 (t nil
(eq files-test-safe-result t
))
82 (t maybe
(eq files-test-safe-result t
))
83 (nil t
(eq files-test-safe-result nil
))
84 (nil nil
(eq files-test-safe-result nil
))
85 (nil maybe
(eq files-test-safe-result nil
))
86 (:safe t
(eq files-test-safe-result t
))
87 (:safe nil
(eq files-test-safe-result t
))
88 (:safe maybe
(eq files-test-safe-result t
))
89 (:all t
(eq files-test-safe-result t
))
90 (:all nil
(eq files-test-safe-result t
))
91 (:all maybe
(eq files-test-safe-result t
))
92 (maybe t
(eq files-test-result
'query
))
93 (maybe nil
(eq files-test-result
'query
))
94 (maybe maybe
(eq files-test-result
'query
)))
95 ;; Safe local variable with unsafe value
96 (("files-test-safe-result: 1")
97 (t t
(eq files-test-result
'query
))
98 (t nil
(eq files-test-result
'query
))
99 (t maybe
(eq files-test-result
'query
))
100 (nil t
(eq files-test-safe-result nil
))
101 (nil nil
(eq files-test-safe-result nil
))
102 (nil maybe
(eq files-test-safe-result nil
))
103 (:safe t
(eq files-test-safe-result nil
))
104 (:safe nil
(eq files-test-safe-result nil
))
105 (:safe maybe
(eq files-test-safe-result nil
))
106 (:all t
(eq files-test-safe-result
1))
107 (:all nil
(eq files-test-safe-result
1))
108 (:all maybe
(eq files-test-safe-result
1))
109 (maybe t
(eq files-test-result
'query
))
110 (maybe nil
(eq files-test-result
'query
))
111 (maybe maybe
(eq files-test-result
'query
))))
112 "List of file-local variable tests.
113 Each list element should have the form
115 (LOCAL-VARS-LIST . TEST-LIST)
117 where LOCAL-VARS-LISTS should be a list of local variable
118 definitions (strings) and TEST-LIST is a list of tests to
119 perform. Each entry of TEST-LIST should have the form
121 (ENABLE-LOCAL-VARIABLES ENABLE-LOCAL-EVAL FORM)
123 where ENABLE-LOCAL-VARIABLES is the value to assign to
124 `enable-local-variables', ENABLE-LOCAL-EVAL is the value to
125 assign to `enable-local-eval', and FORM is a desired `should'
128 (defun file-test--do-local-variables-test (str test-settings
)
131 (setq files-test-result nil
132 files-test-safe-result nil
)
133 (let ((enable-local-variables (nth 0 test-settings
))
134 (enable-local-eval (nth 1 test-settings
))
135 ;; Prevent any dir-locals file interfering with the tests.
136 (enable-dir-local-variables nil
))
137 (hack-local-variables)
138 (eval (nth 2 test-settings
)))))
140 (ert-deftest files-test-local-variables
()
141 "Test the file-local variables implementation."
142 (cl-letf (((symbol-function 'hack-local-variables-confirm
)
144 (setq files-test-result
'query
)
146 (dolist (test files-test-local-variable-data
)
147 (let ((str (concat "text\n\n;; Local Variables:\n;; "
148 (mapconcat 'identity
(car test
) "\n;; ")
150 (dolist (subtest (cdr test
))
151 (should (file-test--do-local-variables-test str subtest
)))))))
153 (defvar files-test-bug-18141-file
154 (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY"))
155 "Test file for bug#18141.")
157 (ert-deftest files-test-bug-18141
()
158 "Test for https://debbugs.gnu.org/18141 ."
159 (skip-unless (executable-find "gzip"))
160 (let ((tempfile (make-temp-file "files-test-bug-18141" nil
".gz")))
163 (copy-file files-test-bug-18141-file tempfile t
)
164 (with-current-buffer (find-file-noselect tempfile
)
165 (set-buffer-modified-p t
)
167 (should (eq buffer-file-coding-system
'iso-2022-7bit-unix
))))
168 (delete-file tempfile
))))
170 (ert-deftest files-test-make-temp-file-empty-prefix
()
171 "Test make-temp-file with an empty prefix."
172 (let ((tempfile (make-temp-file ""))
173 (tempdir (make-temp-file "" t
))
174 (tempfile-.
(make-temp-file "."))
175 (tempdir-.
(make-temp-file "." t
))
176 (tempfile-..
(make-temp-file ".."))
177 (tempdir-..
(make-temp-file ".." t
)))
178 (dolist (file (list tempfile tempfile-. tempfile-..
))
181 (dolist (dir (list tempdir tempdir-. tempdir-..
))
183 (delete-directory dir
))))
185 ;; Stop the above "Local Var..." confusing Emacs.
188 (ert-deftest files-test-bug-21454
()
189 "Test for https://debbugs.gnu.org/21454 ."
190 :expected-result
:failed
192 '(("/foo/bar//baz/:/bar/foo/baz//" nil
("/foo/bar/baz/" "/bar/foo/baz/"))
193 ("/foo/bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
194 ("//foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
195 ("/foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
196 ("/foo//bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
197 ("/foo//bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
198 ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
199 ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))
200 (foo-env (getenv "FOO"))
201 (bar-env (getenv "BAR")))
203 (dolist (test input-result
)
204 (let ((foo (nth 0 test
))
211 (should (equal res
(parse-colon-path (getenv "BAR")))))
212 (should (equal res
(parse-colon-path "$FOO"))))))
213 (setenv "FOO" foo-env
)
214 (setenv "BAR" bar-env
))))
216 (ert-deftest files-test--save-buffers-kill-emacs--confirm-kill-processes
()
217 "Test that `save-buffers-kill-emacs' honors
218 `confirm-kill-processes'."
219 (cl-letf* ((yes-or-no-p-prompts nil
)
220 ((symbol-function #'yes-or-no-p
)
222 (push prompt yes-or-no-p-prompts
)
224 (kill-emacs-args nil
)
225 ((symbol-function #'kill-emacs
)
226 (lambda (&optional arg
) (push arg kill-emacs-args
)))
231 (expand-file-name invocation-name invocation-directory
)
232 "-batch" "-Q" "-eval" "(sleep-for 1000)")))
233 (confirm-kill-processes nil
))
234 (save-buffers-kill-emacs)
235 (kill-process process
)
236 (should-not yes-or-no-p-prompts
)
237 (should (equal kill-emacs-args
'(nil)))))
239 (ert-deftest files-test-read-file-in-~
()
240 "Test file prompting in directory named '~'.
241 If we are in a directory named '~', the default value should not
243 (cl-letf (((symbol-function 'completing-read
)
244 (lambda (_prompt _coll
&optional _pred _req init _hist def _
)
246 (dir (make-temp-file "read-file-name-test" t
)))
248 (let ((subdir (expand-file-name "./~/" dir
)))
249 (make-directory subdir t
)
251 (setq default-directory subdir
)
253 (expand-file-name (read-file-name "File: "))
254 (expand-file-name "~/")))
255 ;; Don't overquote either!
256 (setq default-directory
(concat "/:" subdir
))
258 (expand-file-name (read-file-name "File: "))
259 (concat "/:/:" subdir
)))))
260 (delete-directory dir
'recursive
))))
262 (ert-deftest files-tests-file-name-non-special-quote-unquote
()
263 (let (;; Just in case it is quoted, who knows.
264 (temporary-file-directory (file-name-unquote temporary-file-directory
)))
265 (should-not (file-name-quoted-p temporary-file-directory
))
266 (should (file-name-quoted-p (file-name-quote temporary-file-directory
)))
267 (should (equal temporary-file-directory
269 (file-name-quote temporary-file-directory
))))
270 ;; It does not hurt to quote/unquote a file several times.
271 (should (equal (file-name-quote temporary-file-directory
)
273 (file-name-quote temporary-file-directory
))))
274 (should (equal (file-name-unquote temporary-file-directory
)
276 (file-name-unquote temporary-file-directory
))))))
278 (ert-deftest files-tests--file-name-non-special--subprocess
()
279 "Check that Bug#25949 is fixed."
280 (skip-unless (executable-find "true"))
281 (let ((default-directory (file-name-quote temporary-file-directory
)))
282 (should (zerop (process-file "true")))
283 (should (processp (start-file-process "foo" nil
"true")))
284 (should (zerop (shell-command "true")))))
286 (defmacro files-tests--with-advice
(symbol where function
&rest body
)
288 (cl-check-type symbol symbol
)
289 (cl-check-type where keyword
)
290 (cl-check-type function function
)
291 (macroexp-let2 nil function function
293 (advice-add #',symbol
,where
,function
)
296 (advice-remove #',symbol
,function
)))))
298 (defmacro files-tests--with-temp-file
(name &rest body
)
299 (declare (indent 1) (debug (symbolp body
)))
300 (cl-check-type name symbol
)
301 `(let ((,name
(make-temp-file "emacs")))
304 (delete-file ,name
))))
306 (ert-deftest files-tests--file-name-non-special--buffers
()
307 "Check that Bug#25951 is fixed.
308 We call `verify-visited-file-modtime' on a buffer visiting a file
309 with a quoted name. We use two different variants: first with
310 the buffer current and a nil argument, second passing the buffer
311 object explicitly. In both cases no error should be raised and
312 the `file-name-non-special' handler for quoted file names should
313 be invoked with the right arguments."
314 (files-tests--with-temp-file temp-file-name
316 (let* ((buffer-visiting-file (current-buffer))
318 (log (lambda (&rest args
) (push args actual-args
))))
319 (insert-file-contents (file-name-quote temp-file-name
) :visit
)
320 (should (stringp buffer-file-name
))
321 (should (file-name-quoted-p buffer-file-name
))
322 ;; The following is not true for remote files.
323 (should (string-prefix-p "/:" buffer-file-name
))
324 (should (consp (visited-file-modtime)))
325 (should (equal (find-file-name-handler buffer-file-name
326 #'verify-visited-file-modtime
)
327 #'file-name-non-special
))
328 (files-tests--with-advice file-name-non-special
:before log
329 ;; This should call the file name handler with the right
330 ;; buffer and not signal an error. The file hasn't been
331 ;; modified, so `verify-visited-file-modtime' should return
333 (should (equal (verify-visited-file-modtime) t
))
335 (should (stringp (buffer-file-name buffer-visiting-file
)))
336 ;; This should call the file name handler with the right
337 ;; buffer and not signal an error. The file hasn't been
338 ;; modified, so `verify-visited-file-modtime' should return
340 (should (equal (verify-visited-file-modtime buffer-visiting-file
)
342 ;; Verify that the handler was actually called. We called
343 ;; `verify-visited-file-modtime' twice, so both calls should be
344 ;; recorded in reverse order.
345 (should (equal actual-args
346 `((verify-visited-file-modtime ,buffer-visiting-file
)
347 (verify-visited-file-modtime nil
))))))))
349 (cl-defmacro files-tests--with-temp-non-special
350 ((name non-special-name
&optional dir-flag
) &rest body
)
351 (declare (indent 1) (debug ((symbolp symbolp
&optional form
) body
)))
352 (cl-check-type name symbol
)
353 (cl-check-type non-special-name symbol
)
354 `(let* ((temporary-file-directory (file-truename temporary-file-directory
))
355 (,name
(make-temp-file "files-tests" ,dir-flag
))
356 (,non-special-name
(file-name-quote ,name
)))
359 (when (file-exists-p ,name
)
360 (if ,dir-flag
(delete-directory ,name t
)
361 (delete-file ,name
))))))
363 (ert-deftest files-tests-file-name-non-special-access-file
()
364 (files-tests--with-temp-non-special (tmpfile nospecial
)
365 (should (null (access-file nospecial
"test")))))
367 (ert-deftest files-tests-file-name-non-special-add-name-to-file
()
368 (files-tests--with-temp-non-special (tmpfile nospecial
)
369 (let ((newname (concat nospecial
"add-name")))
370 (add-name-to-file nospecial newname
)
371 (should (file-exists-p newname
))
372 (delete-file newname
))))
374 (ert-deftest files-tests-file-name-non-special-byte-compiler-base-file-name
()
375 (files-tests--with-temp-non-special (tmpfile nospecial
)
376 (should (equal (byte-compiler-base-file-name nospecial
)
377 (byte-compiler-base-file-name tmpfile
)))))
379 (ert-deftest files-tests-file-name-non-special-copy-directory
()
380 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
381 (let ((newname (concat (directory-file-name nospecial-dir
)
383 (copy-directory nospecial-dir newname
)
384 (should (file-directory-p newname
))
385 (delete-directory newname
)
386 (should-not (file-directory-p newname
)))))
388 (ert-deftest files-tests-file-name-non-special-copy-file
()
389 (files-tests--with-temp-non-special (tmpfile nospecial
)
390 (let ((newname (concat (directory-file-name nospecial
)
392 (copy-file nospecial newname
)
393 (should (file-exists-p newname
))
394 (delete-file newname
)
395 (should-not (file-exists-p newname
)))))
397 (ert-deftest files-tests-file-name-non-special-delete-directory
()
398 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
399 (delete-directory nospecial-dir
)))
401 (ert-deftest files-tests-file-name-non-special-delete-file
()
402 (files-tests--with-temp-non-special (tmpfile nospecial
)
403 (delete-file nospecial
)))
405 (ert-deftest files-tests-file-name-non-special-diff-latest-backup-file
()
406 (files-tests--with-temp-non-special (tmpfile nospecial
)
407 (should (equal (diff-latest-backup-file nospecial
)
408 (diff-latest-backup-file tmpfile
)))))
410 (ert-deftest files-tests-file-name-non-special-directory-file-name
()
411 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
412 (should (equal (directory-file-name nospecial-dir
)
413 (file-name-quote (directory-file-name tmpdir
))))))
415 (ert-deftest files-tests-file-name-non-special-directory-files
()
416 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
417 (should (equal (directory-files nospecial-dir
)
418 (directory-files tmpdir
)))))
420 (defun files-tests-file-attributes-equal (attr1 attr2
)
421 ;; Element 4 is access time, which may be changed by the act of
422 ;; checking the attributes.
423 (setf (nth 4 attr1
) nil
)
424 (setf (nth 4 attr2
) nil
)
425 ;; Element 9 is unspecified.
426 (setf (nth 9 attr1
) nil
)
427 (setf (nth 9 attr2
) nil
)
430 (ert-deftest files-tests-file-name-non-special-directory-files-and-attributes
()
431 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
432 (cl-loop for
(file1 . attr1
) in
(directory-files-and-attributes nospecial-dir
)
433 for
(file2 . attr2
) in
(directory-files-and-attributes tmpdir
)
435 (should (equal file1 file2
))
436 (should (files-tests-file-attributes-equal attr1 attr2
)))))
438 (ert-deftest files-tests-file-name-non-special-dired-compress-handler
()
439 ;; `dired-compress-file' can get confused by filenames with ":" in
440 ;; them, which causes this to fail on `windows-nt' systems.
441 (when (string-match-p ":" (expand-file-name temporary-file-directory
))
442 (ert-skip "FIXME: `dired-compress-file' unreliable when filenames contain `:'."))
443 (files-tests--with-temp-non-special (tmpfile nospecial
)
444 (let ((compressed (dired-compress-file nospecial
)))
446 ;; FIXME: Should it return a still-quoted name?
447 (should (file-equal-p nospecial
(dired-compress-file compressed
)))))))
449 (ert-deftest files-tests-file-name-non-special-dired-uncache
()
450 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
451 (dired-uncache nospecial-dir
)))
453 (ert-deftest files-tests-file-name-non-special-expand-file-name
()
454 (files-tests--with-temp-non-special (tmpfile nospecial
)
455 (should (equal (expand-file-name nospecial
) nospecial
))))
457 (ert-deftest files-tests-file-name-non-special-file-accessible-directory-p
()
458 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
459 (should (file-accessible-directory-p nospecial-dir
))))
461 (ert-deftest files-tests-file-name-non-special-file-acl
()
462 (files-tests--with-temp-non-special (tmpfile nospecial
)
463 (should (equal (file-acl nospecial
) (file-acl tmpfile
)))))
465 (ert-deftest files-tests-file-name-non-special-file-attributes
()
466 (files-tests--with-temp-non-special (tmpfile nospecial
)
467 (should (files-tests-file-attributes-equal
468 (file-attributes nospecial
) (file-attributes tmpfile
)))))
470 (ert-deftest files-tests-file-name-non-special-file-directory-p
()
471 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
472 (should (file-directory-p nospecial-dir
))))
474 (ert-deftest files-tests-file-name-non-special-file-equal-p
()
475 (files-tests--with-temp-non-special (tmpfile nospecial
)
476 (should (file-equal-p nospecial tmpfile
))
477 (should (file-equal-p tmpfile nospecial
))
478 (should (file-equal-p nospecial nospecial
))))
480 (ert-deftest files-tests-file-name-non-special-file-executable-p
()
481 (files-tests--with-temp-non-special (tmpfile nospecial
)
482 (should-not (file-executable-p nospecial
))))
484 (ert-deftest files-tests-file-name-non-special-file-exists-p
()
485 (files-tests--with-temp-non-special (tmpfile nospecial
)
486 (should (file-exists-p nospecial
))))
488 (ert-deftest files-tests-file-name-non-special-file-in-directory-p
()
489 (files-tests--with-temp-non-special (tmpfile nospecial
)
490 (let ((nospecial-tempdir (file-name-quote temporary-file-directory
)))
491 (should (file-in-directory-p nospecial temporary-file-directory
))
492 (should (file-in-directory-p tmpfile nospecial-tempdir
))
493 (should (file-in-directory-p nospecial nospecial-tempdir
)))))
495 (ert-deftest files-tests-file-name-non-special-file-local-copy
()
496 (files-tests--with-temp-non-special (tmpfile nospecial
)
497 (should-not (file-local-copy nospecial
)))) ; Already local.
499 (ert-deftest files-tests-file-name-non-special-file-modes
()
500 (files-tests--with-temp-non-special (tmpfile nospecial
)
501 (should (equal (file-modes nospecial
) (file-modes tmpfile
)))))
503 (ert-deftest files-tests-file-name-non-special-file-name-all-completions
()
504 (files-tests--with-temp-non-special (tmpfile nospecial
)
505 (let ((nospecial-tempdir (file-name-quote temporary-file-directory
))
506 (tmpdir temporary-file-directory
))
507 (should (equal (file-name-all-completions nospecial nospecial-tempdir
)
508 (file-name-all-completions tmpfile tmpdir
)))
509 (should (equal (file-name-all-completions tmpfile nospecial-tempdir
)
510 (file-name-all-completions tmpfile tmpdir
)))
511 (should (equal (file-name-all-completions nospecial tmpdir
)
512 (file-name-all-completions tmpfile tmpdir
))))))
514 (ert-deftest files-tests-file-name-non-special-file-name-as-directory
()
515 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
516 (should (equal (file-name-as-directory nospecial-dir
)
517 (file-name-quote (file-name-as-directory tmpdir
))))))
519 (ert-deftest files-tests-file-name-non-special-file-name-case-insensitive-p
()
520 (files-tests--with-temp-non-special (tmpfile nospecial
)
521 (should (equal (file-name-case-insensitive-p nospecial
)
522 (file-name-case-insensitive-p tmpfile
)))))
524 (ert-deftest files-tests-file-name-non-special-file-name-completion
()
525 (files-tests--with-temp-non-special (tmpfile nospecial
)
526 (let ((nospecial-tempdir (file-name-quote temporary-file-directory
))
527 (tmpdir temporary-file-directory
))
528 (should (equal (file-name-completion nospecial nospecial-tempdir
)
529 (file-name-completion tmpfile tmpdir
)))
530 (should (equal (file-name-completion tmpfile nospecial-tempdir
)
531 (file-name-completion tmpfile tmpdir
)))
532 (should (equal (file-name-completion nospecial tmpdir
)
533 (file-name-completion tmpfile tmpdir
))))))
535 (ert-deftest files-tests-file-name-non-special-file-name-directory
()
536 (files-tests--with-temp-non-special (tmpfile nospecial
)
537 (should (equal (file-name-directory nospecial
)
538 (file-name-quote temporary-file-directory
)))))
540 (ert-deftest files-tests-file-name-non-special-file-name-nondirectory
()
541 (files-tests--with-temp-non-special (tmpfile nospecial
)
542 (should (equal (file-name-nondirectory nospecial
)
543 (file-name-nondirectory tmpfile
)))))
545 (ert-deftest files-tests-file-name-non-special-file-name-sans-versions
()
546 (files-tests--with-temp-non-special (tmpfile nospecial
)
547 (should (equal (file-name-sans-versions nospecial
) nospecial
))))
549 (ert-deftest files-tests-file-name-non-special-file-newer-than-file-p
()
550 (files-tests--with-temp-non-special (tmpfile nospecial
)
551 (should-not (file-newer-than-file-p nospecial tmpfile
))
552 (should-not (file-newer-than-file-p tmpfile nospecial
))
553 (should-not (file-newer-than-file-p nospecial nospecial
))))
555 (ert-deftest files-file-name-non-special-notify-handlers
()
556 (skip-unless file-notify--library
)
557 (files-tests--with-temp-non-special (tmpfile nospecial
)
558 (let ((watch (file-notify-add-watch nospecial
'(change) #'ignore
)))
559 (should (file-notify-valid-p watch
))
560 (file-notify-rm-watch watch
)
561 (should-not (file-notify-valid-p watch
)))))
563 (ert-deftest files-tests-file-name-non-special-file-ownership-preserved-p
()
564 (files-tests--with-temp-non-special (tmpfile nospecial
)
565 (should (equal (file-ownership-preserved-p nospecial
)
566 (file-ownership-preserved-p tmpfile
)))))
568 (ert-deftest files-tests-file-name-non-special-file-readable-p
()
569 (files-tests--with-temp-non-special (tmpfile nospecial
)
570 (should (file-readable-p nospecial
))))
572 (ert-deftest files-tests-file-name-non-special-file-regular-p
()
573 (files-tests--with-temp-non-special (tmpfile nospecial
)
574 (should (file-regular-p nospecial
))))
576 (ert-deftest files-tests-file-name-non-special-file-remote-p
()
577 (files-tests--with-temp-non-special (tmpfile nospecial
)
578 (should-not (file-remote-p nospecial
))))
580 (ert-deftest files-tests-file-name-non-special-file-selinux-context
()
581 (files-tests--with-temp-non-special (tmpfile nospecial
)
582 (should (equal (file-selinux-context nospecial
)
583 (file-selinux-context tmpfile
)))))
585 (ert-deftest files-tests-file-name-non-special-file-symlink-p
()
586 (files-tests--with-temp-non-special (tmpfile nospecial
)
587 (should-not (file-symlink-p nospecial
))))
589 (ert-deftest files-tests-file-name-non-special-file-truename
()
590 (files-tests--with-temp-non-special (tmpfile nospecial
)
591 (should (equal nospecial
(file-truename nospecial
)))))
593 (ert-deftest files-tests-file-name-non-special-file-writable-p
()
594 (files-tests--with-temp-non-special (tmpfile nospecial
)
595 (should (file-writable-p nospecial
))))
597 (ert-deftest files-tests-file-name-non-special-find-backup-file-name
()
598 (files-tests--with-temp-non-special (tmpfile nospecial
)
599 (should (equal (find-backup-file-name nospecial
)
600 (mapcar #'file-name-quote
601 (find-backup-file-name tmpfile
))))))
603 (ert-deftest files-tests-file-name-non-special-get-file-buffer
()
604 (files-tests--with-temp-non-special (tmpfile nospecial
)
605 (should-not (get-file-buffer nospecial
))))
607 (ert-deftest files-tests-file-name-non-special-insert-directory
()
608 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
609 (should (equal (with-temp-buffer
610 (insert-directory nospecial-dir
"")
613 (insert-directory tmpdir
"")
616 (ert-deftest files-tests-file-name-non-special-insert-file-contents
()
617 (files-tests--with-temp-non-special (tmpfile nospecial
)
619 (insert-file-contents nospecial
)
620 (should (zerop (buffer-size))))))
622 (ert-deftest files-tests-file-name-non-special-load
()
623 (files-tests--with-temp-non-special (tmpfile nospecial
)
624 (should (load nospecial nil t
))))
626 (ert-deftest files-tests-file-name-non-special-make-auto-save-file-name
()
627 (files-tests--with-temp-non-special (tmpfile nospecial
)
629 (should (equal (prog2 (set-buffer (find-file-noselect nospecial
))
630 (make-auto-save-file-name)
632 (prog2 (set-buffer (find-file-noselect tmpfile
))
633 (make-auto-save-file-name)
636 (ert-deftest files-tests-file-name-non-special-make-directory
()
637 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
638 (let ((default-directory nospecial-dir
))
639 (make-directory "dir")
640 (should (file-directory-p "dir"))
641 (delete-directory "dir"))))
643 (ert-deftest files-tests-file-name-non-special-make-directory-internal
()
644 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
645 (let ((default-directory nospecial-dir
))
646 (make-directory-internal "dir")
647 (should (file-directory-p "dir"))
648 (delete-directory "dir"))))
650 (ert-deftest files-tests-file-name-non-special-make-nearby-temp-file
()
651 (let* ((default-directory (file-name-quote temporary-file-directory
))
652 (near-tmpfile (make-nearby-temp-file "file")))
653 (should (file-exists-p near-tmpfile
))
654 (delete-file near-tmpfile
)))
656 (ert-deftest files-tests-file-name-non-special-make-symbolic-link
()
657 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
658 (files-tests--with-temp-non-special (tmpfile _nospecial
)
659 (let* ((linkname (expand-file-name "link" tmpdir
))
660 (may-symlink (ignore-errors (make-symbolic-link tmpfile linkname
)
663 (should (file-symlink-p linkname
))
664 (delete-file linkname
)
665 (let ((linkname (expand-file-name "link" nospecial-dir
)))
666 (make-symbolic-link tmpfile linkname
)
667 (should (file-symlink-p linkname
))
668 (delete-file linkname
)))))))
670 ;; See `files-tests--file-name-non-special--subprocess'.
671 ;; (ert-deftest files-tests-file-name-non-special-process-file ())
673 (ert-deftest files-tests-file-name-non-special-rename-file
()
674 (files-tests--with-temp-non-special (tmpfile nospecial
)
675 (rename-file nospecial
(concat nospecial
"x"))
676 (rename-file (concat nospecial
"x") nospecial
)
677 (rename-file tmpfile
(concat nospecial
"x"))
678 (rename-file (concat nospecial
"x") nospecial
)
679 (rename-file nospecial
(concat tmpfile
"x"))
680 (rename-file (concat nospecial
"x") nospecial
)))
682 (ert-deftest files-tests-file-name-non-special-set-file-acl
()
683 (files-tests--with-temp-non-special (tmpfile nospecial
)
684 (set-file-acl nospecial
(file-acl nospecial
))))
686 (ert-deftest files-tests-file-name-non-special-set-file-modes
()
687 (files-tests--with-temp-non-special (tmpfile nospecial
)
688 (set-file-modes nospecial
(file-modes nospecial
))))
690 (ert-deftest files-tests-file-name-non-special-set-file-selinux-context
()
691 (files-tests--with-temp-non-special (tmpfile nospecial
)
692 (set-file-selinux-context nospecial
(file-selinux-context nospecial
))))
694 (ert-deftest files-tests-file-name-non-special-set-file-times
()
695 (files-tests--with-temp-non-special (tmpfile nospecial
)
696 (set-file-times nospecial
)))
698 (ert-deftest files-tests-file-name-non-special-set-visited-file-modtime
()
699 (files-tests--with-temp-non-special (tmpfile nospecial
)
701 (set-buffer (find-file-noselect nospecial
))
702 (set-visited-file-modtime)
705 (ert-deftest files-tests-file-name-non-special-shell-command
()
706 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
708 (let ((default-directory nospecial-dir
))
709 (shell-command (concat (shell-quote-argument
710 (concat invocation-directory invocation-name
))
713 (goto-char (point-min))
714 (should (search-forward emacs-version nil t
))))))
716 (ert-deftest files-tests-file-name-non-special-start-file-process
()
717 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
719 (let ((default-directory nospecial-dir
))
720 (let ((proc (start-file-process
721 "emacs" (current-buffer)
722 (concat invocation-directory invocation-name
)
724 (accept-process-output proc
)
725 (goto-char (point-min))
726 (should (search-forward emacs-version nil t
))
727 ;; Don't stop the test run with a query, as the subprocess
728 ;; may or may not be dead by the time we reach here.
729 (set-process-query-on-exit-flag proc nil
))))))
731 (ert-deftest files-tests-file-name-non-special-substitute-in-file-name
()
732 (files-tests--with-temp-non-special (tmpfile nospecial
)
733 (let ((process-environment (cons "FOO=foo" process-environment
))
734 (nospecial-foo (concat nospecial
"$FOO")))
735 ;; The "/:" prevents substitution.
736 (equal (substitute-in-file-name nospecial-foo
) nospecial-foo
))))
737 (ert-deftest files-tests-file-name-non-special-temporary-file-directory
()
738 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
739 (let ((default-directory nospecial-dir
))
740 (equal (temporary-file-directory) temporary-file-directory
))))
742 (ert-deftest files-tests-file-name-non-special-unhandled-file-name-directory
()
743 (files-tests--with-temp-non-special (tmpdir nospecial-dir t
)
744 (equal (unhandled-file-name-directory nospecial-dir
)
745 (file-name-as-directory tmpdir
))))
747 (ert-deftest files-tests-file-name-non-special-vc-registered
()
748 (files-tests--with-temp-non-special (tmpfile nospecial
)
749 (should (equal (vc-registered nospecial
) (vc-registered tmpfile
)))))
751 ;; See test `files-tests--file-name-non-special--buffers'.
752 ;; (ert-deftest files-tests-file-name-non-special-verify-visited-file-modtime ())
754 (ert-deftest files-tests-file-name-non-special-write-region
()
755 (files-tests--with-temp-non-special (tmpfile nospecial
)
757 (write-region nil nil nospecial nil
:visit
))))
759 (ert-deftest files-tests--insert-directory-wildcard-in-dir-p
()
760 (let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
761 (cons "/home/user/.txt" nil
)
762 (cons "/home/*/.txt" (cons "/home/" "*/.txt"))
763 (cons "/home/*/" (cons "/home/" "*/"))
764 (cons "/*/.txt" (cons "/" "*/.txt"))
766 (cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt"))
767 (cons "c:/tmp/*.txt" nil
)
768 (cons "c:/tmp/*/" (cons "c:/tmp/" "*/"))
769 (cons "c:/*/*.txt" (cons "c:/" "*/*.txt")))))
770 (dolist (path-res alist
)
774 (insert-directory-wildcard-in-dir-p (car path-res
)))))))
776 (ert-deftest files-tests--make-directory
()
777 (let* ((dir (make-temp-file "files-mkdir-test" t
))
778 (dirname (file-name-as-directory dir
))
779 (file (concat dirname
"file"))
780 (subdir1 (concat dirname
"subdir1"))
781 (subdir2 (concat dirname
"subdir2"))
782 (a/b
(concat dirname
"a/b")))
783 (write-region "" nil file
)
784 (should-error (make-directory "/"))
785 (should-not (make-directory "/" t
))
786 (should-error (make-directory dir
))
787 (should-not (make-directory dir t
))
788 (should-error (make-directory dirname
))
789 (should-not (make-directory dirname t
))
790 (should-error (make-directory file
))
791 (should-error (make-directory file t
))
792 (should-not (make-directory subdir1
))
793 (should-not (make-directory subdir2 t
))
794 (should-error (make-directory a
/b
))
795 (should-not (make-directory a
/b t
))
796 (delete-directory dir
'recursive
)))
798 (ert-deftest files-test-no-file-write-contents
()
799 "Test that `write-contents-functions' permits saving a file.
800 Usually `basic-save-buffer' will prompt for a file name if the
801 current buffer has none. It should first call the functions in
802 `write-contents-functions', and if one of them returns non-nil,
803 consider the buffer saved, without prompting for a file
805 (let ((read-file-name-function
806 (lambda (&rest _ignore
)
807 (error "Prompting for file name"))))
808 ;; With contents function, and no file.
810 (setq write-contents-functions
(lambda () t
))
811 (set-buffer-modified-p t
)
812 (should (null (save-buffer))))
813 ;; With no contents function and no file. This should reach the
814 ;; `read-file-name' prompt.
816 (set-buffer-modified-p t
)
817 (should-error (save-buffer) :type
'error
))
818 ;; Then a buffer visiting a file: should save normally.
819 (files-tests--with-temp-file temp-file-name
820 (with-current-buffer (find-file-noselect temp-file-name
)
821 (setq write-contents-functions nil
)
823 (should (null (save-buffer)))
824 (should (eq (buffer-size) 1))))))
826 (ert-deftest files-tests--copy-directory
()
827 (let* ((dir (make-temp-file "files-mkdir-test" t
))
828 (dirname (file-name-as-directory dir
))
829 (source (concat dirname
"source"))
830 (dest (concat dirname
"dest/new/directory/"))
831 (file (concat (file-name-as-directory source
) "file"))
832 (source2 (concat dirname
"source2"))
833 (dest2 (concat dirname
"dest/new2")))
834 (make-directory source
)
835 (write-region "" nil file
)
836 (copy-directory source dest t t t
)
837 (should (file-exists-p (concat dest
"file")))
838 (make-directory (concat (file-name-as-directory source2
) "a") t
)
839 (copy-directory source2 dest2
)
840 (should (file-directory-p (concat (file-name-as-directory dest2
) "a")))
841 (delete-directory dir
'recursive
)))
843 (ert-deftest files-test-abbreviated-home-dir
()
844 "Test that changing HOME does not confuse `abbreviate-file-name'.
845 See <https://debbugs.gnu.org/19657#20>."
846 (let* ((homedir temporary-file-directory
)
847 (process-environment (cons (format "HOME=%s" homedir
)
848 process-environment
))
849 (abbreviated-home-dir nil
)
850 (testfile (expand-file-name "foo" homedir
))
851 (old (file-truename (abbreviate-file-name testfile
)))
852 (process-environment (cons (format "HOME=%s"
853 (expand-file-name "bar" homedir
))
854 process-environment
)))
855 (should (equal old
(file-truename (abbreviate-file-name testfile
))))))
857 (provide 'files-tests
)
858 ;;; files-tests.el ends here