test/lisp/files-tests.el

   1 ;;; files-tests.el --- tests for files.el.  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2012-2018 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   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.
  11
  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.
  16
  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/>.
  19
  20 ;;; Code:
  21
  22 (require 'ert)
  23 (require 'nadvice)
  24
  25 ;; Set to t if the local variable was set, `query' if the query was
  26 ;; triggered.
  27 (defvar files-test-result nil)
  28
  29 (defvar files-test-safe-result nil)
  30 (put 'files-test-safe-result 'safe-local-variable 'booleanp)
  31
  32 (defun files-test-fun1 ()
  33   (setq files-test-result t))
  34
  35 ;; Test combinations:
  36 ;; `enable-local-variables' t, nil, :safe, :all, or something else.
  37 ;; `enable-local-eval' t, nil, or something else.
  38
  39 (defvar files-test-local-variable-data
  40   ;; Unsafe eval form
  41   '((("eval: (files-test-fun1)")
  42      (t t         (eq files-test-result t))
  43      (t nil       (eq files-test-result nil))
  44      (t maybe     (eq files-test-result 'query))
  45      (nil t       (eq files-test-result nil))
  46      (nil nil     (eq files-test-result nil))
  47      (nil maybe   (eq files-test-result nil))
  48      (:safe t     (eq files-test-result nil))
  49      (:safe nil   (eq files-test-result nil))
  50      (:safe maybe (eq files-test-result nil))
  51      (:all t      (eq files-test-result t))
  52      (:all nil    (eq files-test-result nil))
  53      (:all maybe  (eq files-test-result t)) ; This combination is ambiguous.
  54      (maybe t     (eq files-test-result 'query))
  55      (maybe nil   (eq files-test-result nil))
  56      (maybe maybe (eq files-test-result 'query)))
  57     ;; Unsafe local variable value
  58     (("files-test-result: t")
  59      (t t         (eq files-test-result 'query))
  60      (t nil       (eq files-test-result 'query))
  61      (t maybe     (eq files-test-result 'query))
  62      (nil t       (eq files-test-result nil))
  63      (nil nil     (eq files-test-result nil))
  64      (nil maybe   (eq files-test-result nil))
  65      (:safe t     (eq files-test-result nil))
  66      (:safe nil   (eq files-test-result nil))
  67      (:safe maybe (eq files-test-result nil))
  68      (:all t      (eq files-test-result t))
  69      (:all nil    (eq files-test-result t))
  70      (:all maybe  (eq files-test-result t))
  71      (maybe t     (eq files-test-result 'query))
  72      (maybe nil   (eq files-test-result 'query))
  73      (maybe maybe (eq files-test-result 'query)))
  74     ;; Safe local variable
  75     (("files-test-safe-result: t")
  76      (t t         (eq files-test-safe-result t))
  77      (t nil       (eq files-test-safe-result t))
  78      (t maybe     (eq files-test-safe-result t))
  79      (nil t       (eq files-test-safe-result nil))
  80      (nil nil     (eq files-test-safe-result nil))
  81      (nil maybe   (eq files-test-safe-result nil))
  82      (:safe t     (eq files-test-safe-result t))
  83      (:safe nil   (eq files-test-safe-result t))
  84      (:safe maybe (eq files-test-safe-result t))
  85      (:all t      (eq files-test-safe-result t))
  86      (:all nil    (eq files-test-safe-result t))
  87      (:all maybe  (eq files-test-safe-result t))
  88      (maybe t     (eq files-test-result 'query))
  89      (maybe nil   (eq files-test-result 'query))
  90      (maybe maybe (eq files-test-result 'query)))
  91     ;; Safe local variable with unsafe value
  92     (("files-test-safe-result: 1")
  93      (t t         (eq files-test-result 'query))
  94      (t nil       (eq files-test-result 'query))
  95      (t maybe     (eq files-test-result 'query))
  96      (nil t       (eq files-test-safe-result nil))
  97      (nil nil     (eq files-test-safe-result nil))
  98      (nil maybe   (eq files-test-safe-result nil))
  99      (:safe t     (eq files-test-safe-result nil))
 100      (:safe nil   (eq files-test-safe-result nil))
 101      (:safe maybe (eq files-test-safe-result nil))
 102      (:all t      (eq files-test-safe-result 1))
 103      (:all nil    (eq files-test-safe-result 1))
 104      (:all maybe  (eq files-test-safe-result 1))
 105      (maybe t     (eq files-test-result 'query))
 106      (maybe nil   (eq files-test-result 'query))
 107      (maybe maybe (eq files-test-result 'query))))
 108   "List of file-local variable tests.
 109 Each list element should have the form
 110
 111   (LOCAL-VARS-LIST . TEST-LIST)
 112
 113 where LOCAL-VARS-LISTS should be a list of local variable
 114 definitions (strings) and TEST-LIST is a list of tests to
 115 perform.  Each entry of TEST-LIST should have the form
 116
 117  (ENABLE-LOCAL-VARIABLES ENABLE-LOCAL-EVAL FORM)
 118
 119 where ENABLE-LOCAL-VARIABLES is the value to assign to
 120 `enable-local-variables', ENABLE-LOCAL-EVAL is the value to
 121 assign to `enable-local-eval', and FORM is a desired `should'
 122 form.")
 123
 124 (defun file-test--do-local-variables-test (str test-settings)
 125   (with-temp-buffer
 126     (insert str)
 127     (setq files-test-result nil
 128           files-test-safe-result nil)
 129     (let ((enable-local-variables (nth 0 test-settings))
 130           (enable-local-eval      (nth 1 test-settings))
 131           ;; Prevent any dir-locals file interfering with the tests.
 132           (enable-dir-local-variables nil))
 133       (hack-local-variables)
 134       (eval (nth 2 test-settings)))))
 135
 136 (ert-deftest files-test-local-variables ()
 137   "Test the file-local variables implementation."
 138   (cl-letf (((symbol-function 'hack-local-variables-confirm)
 139              (lambda (&rest _)
 140                (setq files-test-result 'query)
 141                nil)))
 142     (dolist (test files-test-local-variable-data)
 143       (let ((str (concat "text\n\n;; Local Variables:\n;; "
 144                          (mapconcat 'identity (car test) "\n;; ")
 145                          "\n;; End:\n")))
 146         (dolist (subtest (cdr test))
 147           (should (file-test--do-local-variables-test str subtest)))))))
 148
 149 (defvar files-test-bug-18141-file
 150   (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY"))
 151   "Test file for bug#18141.")
 152
 153 (ert-deftest files-test-bug-18141 ()
 154   "Test for https://debbugs.gnu.org/18141 ."
 155   (skip-unless (executable-find "gzip"))
 156   (let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz")))
 157     (unwind-protect
 158         (progn
 159           (copy-file files-test-bug-18141-file tempfile t)
 160           (with-current-buffer (find-file-noselect tempfile)
 161             (set-buffer-modified-p t)
 162             (save-buffer)
 163             (should (eq buffer-file-coding-system 'iso-2022-7bit-unix))))
 164       (delete-file tempfile))))
 165
 166 (ert-deftest files-test-make-temp-file-empty-prefix ()
 167   "Test make-temp-file with an empty prefix."
 168   (let ((tempfile (make-temp-file ""))
 169         (tempdir (make-temp-file "" t))
 170         (tempfile-. (make-temp-file "."))
 171         (tempdir-. (make-temp-file "." t))
 172         (tempfile-.. (make-temp-file ".."))
 173         (tempdir-.. (make-temp-file ".." t)))
 174     (dolist (file (list tempfile tempfile-. tempfile-..))
 175       (should file)
 176       (delete-file file))
 177     (dolist (dir (list tempdir tempdir-. tempdir-..))
 178       (should dir)
 179       (delete-directory dir))))
 180
 181 ;; Stop the above "Local Var..." confusing Emacs.
 182 \f
 183
 184 (ert-deftest files-test-bug-21454 ()
 185   "Test for https://debbugs.gnu.org/21454 ."
 186   :expected-result :failed
 187   (let ((input-result
 188          '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/"))
 189            ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
 190            ("//foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
 191            ("/foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
 192            ("/foo//bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
 193            ("/foo//bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
 194            ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
 195            ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))
 196         (foo-env (getenv "FOO"))
 197         (bar-env (getenv "BAR")))
 198     (unwind-protect
 199         (dolist (test input-result)
 200           (let ((foo (nth 0 test))
 201                 (bar (nth 1 test))
 202                 (res (nth 2 test)))
 203             (setenv "FOO" foo)
 204             (if bar
 205                 (progn
 206                   (setenv "BAR" bar)
 207                   (should (equal res (parse-colon-path (getenv "BAR")))))
 208               (should (equal res (parse-colon-path "$FOO"))))))
 209       (setenv "FOO" foo-env)
 210       (setenv "BAR" bar-env))))
 211
 212 (ert-deftest files-test--save-buffers-kill-emacs--confirm-kill-processes ()
 213   "Test that `save-buffers-kill-emacs' honors
 214 `confirm-kill-processes'."
 215   (cl-letf* ((yes-or-no-p-prompts nil)
 216              ((symbol-function #'yes-or-no-p)
 217               (lambda (prompt)
 218                 (push prompt yes-or-no-p-prompts)
 219                 nil))
 220              (kill-emacs-args nil)
 221              ((symbol-function #'kill-emacs)
 222               (lambda (&optional arg) (push arg kill-emacs-args)))
 223              (process
 224               (make-process
 225                :name "sleep"
 226                :command (list
 227                          (expand-file-name invocation-name invocation-directory)
 228                          "-batch" "-Q" "-eval" "(sleep-for 1000)")))
 229              (confirm-kill-processes nil))
 230     (save-buffers-kill-emacs)
 231     (kill-process process)
 232     (should-not yes-or-no-p-prompts)
 233     (should (equal kill-emacs-args '(nil)))))
 234
 235 (ert-deftest files-test-read-file-in-~ ()
 236   "Test file prompting in directory named '~'.
 237 If we are in a directory named '~', the default value should not
 238 be $HOME."
 239   (cl-letf (((symbol-function 'completing-read)
 240              (lambda (_prompt _coll &optional _pred _req init _hist def _)
 241                (or def init)))
 242             (dir (make-temp-file "read-file-name-test" t)))
 243     (unwind-protect
 244         (let ((subdir (expand-file-name "./~/" dir)))
 245           (make-directory subdir t)
 246           (with-temp-buffer
 247             (setq default-directory subdir)
 248             (should-not (equal
 249                          (expand-file-name (read-file-name "File: "))
 250                          (expand-file-name "~/")))
 251             ;; Don't overquote either!
 252             (setq default-directory (concat "/:" subdir))
 253             (should-not (equal
 254                          (expand-file-name (read-file-name "File: "))
 255                          (concat "/:/:" subdir)))))
 256       (delete-directory dir 'recursive))))
 257
 258 (ert-deftest files-tests--file-name-non-special--subprocess ()
 259   "Check that Bug#25949 is fixed."
 260   (skip-unless (executable-find "true"))
 261   (let ((defdir (if (memq system-type '(ms-dos windows-nt)) "/:c:/" "/:/")))
 262     (should (eq (let ((default-directory defdir)) (process-file "true")) 0))
 263     (should (processp (let ((default-directory defdir))
 264                         (start-file-process "foo" nil "true"))))
 265     (should (eq (let ((default-directory defdir)) (shell-command "true")) 0))))
 266
 267 (defmacro files-tests--with-advice (symbol where function &rest body)
 268   (declare (indent 3))
 269   (cl-check-type symbol symbol)
 270   (cl-check-type where keyword)
 271   (cl-check-type function function)
 272   (macroexp-let2 nil function function
 273     `(progn
 274        (advice-add #',symbol ,where ,function)
 275        (unwind-protect
 276            (progn ,@body)
 277          (advice-remove #',symbol ,function)))))
 278
 279 (defmacro files-tests--with-temp-file (name &rest body)
 280   (declare (indent 1))
 281   (cl-check-type name symbol)
 282   `(let ((,name (make-temp-file "emacs")))
 283      (unwind-protect
 284          (progn ,@body)
 285        (delete-file ,name))))
 286
 287 (ert-deftest files-tests--file-name-non-special--buffers ()
 288   "Check that Bug#25951 is fixed.
 289 We call `verify-visited-file-modtime' on a buffer visiting a file
 290 with a quoted name.  We use two different variants: first with
 291 the buffer current and a nil argument, second passing the buffer
 292 object explicitly.  In both cases no error should be raised and
 293 the `file-name-non-special' handler for quoted file names should
 294 be invoked with the right arguments."
 295   (files-tests--with-temp-file temp-file-name
 296     (with-temp-buffer
 297      (let* ((buffer-visiting-file (current-buffer))
 298             (actual-args ())
 299             (log (lambda (&rest args) (push args actual-args))))
 300        (insert-file-contents (concat "/:" temp-file-name) :visit)
 301        (should (stringp buffer-file-name))
 302        (should (string-prefix-p "/:" buffer-file-name))
 303        (should (consp (visited-file-modtime)))
 304        (should (equal (find-file-name-handler buffer-file-name
 305                                               #'verify-visited-file-modtime)
 306                       #'file-name-non-special))
 307        (files-tests--with-advice file-name-non-special :before log
 308          ;; This should call the file name handler with the right
 309          ;; buffer and not signal an error.  The file hasn't been
 310          ;; modified, so `verify-visited-file-modtime' should return
 311          ;; t.
 312          (should (equal (verify-visited-file-modtime) t))
 313          (with-temp-buffer
 314            (should (stringp (buffer-file-name buffer-visiting-file)))
 315            ;; This should call the file name handler with the right
 316            ;; buffer and not signal an error.  The file hasn't been
 317            ;; modified, so `verify-visited-file-modtime' should return
 318            ;; t.
 319            (should (equal (verify-visited-file-modtime buffer-visiting-file)
 320                           t))))
 321        ;; Verify that the handler was actually called.  We called
 322        ;; `verify-visited-file-modtime' twice, so both calls should be
 323        ;; recorded in reverse order.
 324        (should (equal actual-args
 325                       `((verify-visited-file-modtime ,buffer-visiting-file)
 326                         (verify-visited-file-modtime nil))))))))
 327
 328 (ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
 329   (let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
 330                      (cons "/home/user/.txt" nil)
 331                      (cons "/home/*/.txt" (cons "/home/" "*/.txt"))
 332                      (cons "/home/*/" (cons "/home/" "*/"))
 333                      (cons "/*/.txt" (cons "/" "*/.txt"))
 334                      ;;
 335                      (cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt"))
 336                      (cons "c:/tmp/*.txt" nil)
 337                      (cons "c:/tmp/*/" (cons "c:/tmp/" "*/"))
 338                      (cons "c:/*/*.txt" (cons "c:/" "*/*.txt")))))
 339     (dolist (path-res alist)
 340       (should
 341        (equal
 342         (cdr path-res)
 343         (insert-directory-wildcard-in-dir-p (car path-res)))))))
 344
 345 (ert-deftest files-tests--make-directory ()
 346   (let* ((dir (make-temp-file "files-mkdir-test" t))
 347          (dirname (file-name-as-directory dir))
 348          (file (concat dirname "file"))
 349          (subdir1 (concat dirname "subdir1"))
 350          (subdir2 (concat dirname "subdir2"))
 351          (a/b (concat dirname "a/b")))
 352     (write-region "" nil file)
 353     (should-error (make-directory "/"))
 354     (should-not (make-directory "/" t))
 355     (should-error (make-directory dir))
 356     (should-not (make-directory dir t))
 357     (should-error (make-directory dirname))
 358     (should-not (make-directory dirname t))
 359     (should-error (make-directory file))
 360     (should-error (make-directory file t))
 361     (should-not (make-directory subdir1))
 362     (should-not (make-directory subdir2 t))
 363     (should-error (make-directory a/b))
 364     (should-not (make-directory a/b t))
 365     (delete-directory dir 'recursive)))
 366
 367 (ert-deftest files-test-no-file-write-contents ()
 368   "Test that `write-contents-functions' permits saving a file.
 369 Usually `basic-save-buffer' will prompt for a file name if the
 370 current buffer has none.  It should first call the functions in
 371 `write-contents-functions', and if one of them returns non-nil,
 372 consider the buffer saved, without prompting for a file
 373 name (Bug#28412)."
 374   (let ((read-file-name-function
 375          (lambda (&rest _ignore)
 376            (error "Prompting for file name"))))
 377     ;; With contents function, and no file.
 378     (with-temp-buffer
 379       (setq write-contents-functions (lambda () t))
 380       (set-buffer-modified-p t)
 381       (should (null (save-buffer))))
 382     ;; With no contents function and no file.  This should reach the
 383     ;; `read-file-name' prompt.
 384     (with-temp-buffer
 385       (set-buffer-modified-p t)
 386       (should-error (save-buffer) :type 'error))
 387     ;; Then a buffer visiting a file: should save normally.
 388     (files-tests--with-temp-file temp-file-name
 389       (with-current-buffer (find-file-noselect temp-file-name)
 390         (setq write-contents-functions nil)
 391         (insert "p")
 392         (should (null (save-buffer)))
 393         (should (eq (buffer-size) 1))))))
 394
 395 (ert-deftest files-tests--copy-directory ()
 396   (let* ((dir (make-temp-file "files-mkdir-test" t))
 397          (dirname (file-name-as-directory dir))
 398          (source (concat dirname "source"))
 399          (dest (concat dirname "dest/new/directory/"))
 400          (file (concat (file-name-as-directory source) "file"))
 401          (source2 (concat dirname "source2"))
 402          (dest2 (concat dirname "dest/new2")))
 403     (make-directory source)
 404     (write-region "" nil file)
 405     (copy-directory source dest t t t)
 406     (should (file-exists-p (concat dest "file")))
 407     (make-directory (concat (file-name-as-directory source2) "a") t)
 408     (copy-directory source2 dest2)
 409     (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
 410     (delete-directory dir 'recursive)))
 411
 412 (ert-deftest files-test-abbreviated-home-dir ()
 413   "Test that changing HOME does not confuse `abbreviate-file-name'.
 414 See <https://debbugs.gnu.org/19657#20>."
 415   (let* ((homedir temporary-file-directory)
 416          (process-environment (cons (format "HOME=%s" homedir)
 417                                     process-environment))
 418          (abbreviated-home-dir nil)
 419          (testfile (expand-file-name "foo" homedir))
 420          (old (file-truename (abbreviate-file-name testfile)))
 421          (process-environment (cons (format "HOME=%s"
 422                                             (expand-file-name "bar" homedir))
 423                                     process-environment)))
 424     (should (equal old (file-truename (abbreviate-file-name testfile))))))
 425
 426 (provide 'files-tests)
 427 ;;; files-tests.el ends here