diff options
Diffstat (limited to 'test/lisp/files-tests.el')
| -rw-r--r-- | test/lisp/files-tests.el | 388 |
1 files changed, 197 insertions, 191 deletions
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index be9339a8f5b..42b09201de8 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -136,7 +136,7 @@ form.") ;; Prevent any dir-locals file interfering with the tests. (enable-dir-local-variables nil)) (hack-local-variables) - (eval (nth 2 test-settings))))) + (eval (nth 2 test-settings) t)))) (ert-deftest files-tests-local-variables () "Test the file-local variables implementation." @@ -176,15 +176,14 @@ form.") ;; If called interactively, environment variable ;; $EMACS_TEST_DIRECTORY does not exist. (skip-unless (file-exists-p files-test-bug-18141-file)) - (let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz"))) - (unwind-protect - (progn - (copy-file files-test-bug-18141-file tempfile t) - (with-current-buffer (find-file-noselect tempfile) - (set-buffer-modified-p t) - (save-buffer) - (should (eq buffer-file-coding-system 'iso-2022-7bit-unix)))) - (delete-file tempfile)))) + (ert-with-temp-file tempfile + :prefix "emacs-test-files-bug-18141" + :suffix ".gz" + (copy-file files-test-bug-18141-file tempfile t) + (with-current-buffer (find-file-noselect tempfile) + (set-buffer-modified-p t) + (save-buffer) + (should (eq buffer-file-coding-system 'iso-2022-7bit-unix))))) (ert-deftest files-tests-make-temp-file-empty-prefix () "Test make-temp-file with an empty prefix." @@ -283,22 +282,20 @@ If we are in a directory named `~', the default value should not be $HOME." (cl-letf (((symbol-function 'completing-read) (lambda (_prompt _coll &optional _pred _req init _hist def _) - (or def init))) - (dir (make-temp-file "read-file-name-test" t))) - (unwind-protect - (let ((subdir (expand-file-name "./~/" dir))) - (make-directory subdir t) - (with-temp-buffer - (setq default-directory subdir) - (should-not (equal - (expand-file-name (read-file-name "File: ")) - (expand-file-name "~/"))) - ;; Don't overquote either! - (setq default-directory (concat "/:" subdir)) - (should-not (equal - (expand-file-name (read-file-name "File: ")) - (concat "/:/:" subdir))))) - (delete-directory dir 'recursive)))) + (or def init)))) + (ert-with-temp-directory dir + (let ((subdir (expand-file-name "./~/" dir))) + (make-directory subdir t) + (with-temp-buffer + (setq default-directory subdir) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (expand-file-name "~/"))) + ;; Don't overquote either! + (setq default-directory (concat "/:" subdir)) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (concat "/:/:" subdir)))))))) (ert-deftest files-tests-file-name-non-special-quote-unquote () (let (;; Just in case it is quoted, who knows. @@ -341,14 +338,6 @@ be $HOME." (progn ,@body) (advice-remove #',symbol ,function))))) -(defmacro files-tests--with-temp-file (name &rest body) - (declare (indent 1) (debug (symbolp body))) - (cl-check-type name symbol) - `(let ((,name (make-temp-file "emacs"))) - (unwind-protect - (progn ,@body) - (delete-file ,name)))) - (ert-deftest files-tests-file-name-non-special--buffers () "Check that Bug#25951 is fixed. We call `verify-visited-file-modtime' on a buffer visiting a file @@ -357,7 +346,7 @@ the buffer current and a nil argument, second passing the buffer object explicitly. In both cases no error should be raised and the `file-name-non-special' handler for quoted file names should be invoked with the right arguments." - (files-tests--with-temp-file temp-file-name + (ert-with-temp-file temp-file-name (with-temp-buffer (let* ((buffer-visiting-file (current-buffer)) (actual-args ()) @@ -476,6 +465,15 @@ unquoted file names." (let (file-name-handler-alist) (concat (file-name-sans-extension name) part (file-name-extension name t)))) +(ert-deftest files-tests-file-name-non-special-abbreviate-file-name () + (let* ((homedir temporary-file-directory) + (process-environment (cons (format "HOME=%s" homedir) + process-environment)) + (abbreviated-home-dir nil)) + ;; Check that abbreviation doesn't occur for quoted file names. + (should (equal (concat "/:" homedir "foo/bar") + (abbreviate-file-name (concat "/:" homedir "foo/bar")))))) + (ert-deftest files-tests-file-name-non-special-access-file () (files-tests--with-temp-non-special (tmpfile nospecial) ;; Both versions of the file name work. @@ -1239,26 +1237,26 @@ works as expected if the default directory is quoted." (insert-directory-wildcard-in-dir-p (car path-res))))))) (ert-deftest files-tests-make-directory () - (let* ((dir (make-temp-file "files-mkdir-test" t)) - (dirname (file-name-as-directory dir)) - (file (concat dirname "file")) - (subdir1 (concat dirname "subdir1")) - (subdir2 (concat dirname "subdir2")) - (a/b (concat dirname "a/b"))) - (write-region "" nil file) - (should-error (make-directory "/")) - (should-not (make-directory "/" t)) - (should-error (make-directory dir)) - (should-not (make-directory dir t)) - (should-error (make-directory dirname)) - (should-not (make-directory dirname t)) - (should-error (make-directory file)) - (should-error (make-directory file t)) - (should-not (make-directory subdir1)) - (should-not (make-directory subdir2 t)) - (should-error (make-directory a/b)) - (should-not (make-directory a/b t)) - (delete-directory dir 'recursive))) + (ert-with-temp-directory dir + (let* ((dirname (file-name-as-directory dir)) + (file (concat dirname "file")) + (subdir1 (concat dirname "subdir1")) + (subdir2 (concat dirname "subdir2")) + (a/b (concat dirname "a/b"))) + (write-region "" nil file) + (should-error (make-directory "/")) + (should-not (make-directory "/" t)) + (should-error (make-directory dir)) + (should-not (make-directory dir t)) + (should-error (make-directory dirname)) + (should-not (make-directory dirname t)) + (should-error (make-directory file)) + (should-error (make-directory file t)) + (should-not (make-directory subdir1)) + (should-not (make-directory subdir2 t)) + (should-error (make-directory a/b)) + (should-not (make-directory a/b t)) + (delete-directory dir 'recursive)))) (ert-deftest files-tests-file-modes-symbolic-to-number () (let ((alist (list (cons "a=rwx" #o777) @@ -1318,7 +1316,7 @@ name (Bug#28412)." (set-buffer-modified-p t) (should-error (save-buffer) :type 'error)) ;; Then a buffer visiting a file: should save normally. - (files-tests--with-temp-file temp-file-name + (ert-with-temp-file temp-file-name (with-current-buffer (find-file-noselect temp-file-name) (setq write-contents-functions nil) (insert "p") @@ -1326,21 +1324,21 @@ name (Bug#28412)." (should (eq (buffer-size) 1)))))) (ert-deftest files-tests-copy-directory () - (let* ((dir (make-temp-file "files-mkdir-test" t)) - (dirname (file-name-as-directory dir)) - (source (concat dirname "source")) - (dest (concat dirname "dest/new/directory/")) - (file (concat (file-name-as-directory source) "file")) - (source2 (concat dirname "source2")) - (dest2 (concat dirname "dest/new2"))) - (make-directory source) - (write-region "" nil file) - (copy-directory source dest t t t) - (should (file-exists-p (concat dest "file"))) - (make-directory (concat (file-name-as-directory source2) "a") t) - (copy-directory source2 dest2) - (should (file-directory-p (concat (file-name-as-directory dest2) "a"))) - (delete-directory dir 'recursive))) + (ert-with-temp-directory dir + (let* ((dirname (file-name-as-directory dir)) + (source (concat dirname "source")) + (dest (concat dirname "dest/new/directory/")) + (file (concat (file-name-as-directory source) "file")) + (source2 (concat dirname "source2")) + (dest2 (concat dirname "dest/new2"))) + (make-directory source) + (write-region "" nil file) + (copy-directory source dest t t t) + (should (file-exists-p (concat dest "file"))) + (make-directory (concat (file-name-as-directory source2) "a") t) + (copy-directory source2 dest2) + (should (file-directory-p (concat (file-name-as-directory dest2) "a"))) + (delete-directory dir 'recursive)))) (ert-deftest files-tests-abbreviate-file-name-homedir () ;; Check homedir abbreviation. @@ -1392,43 +1390,43 @@ See <https://debbugs.gnu.org/19657#20>." (ert-deftest files-tests-executable-find () "Test that `executable-find' works also with a relative or remote PATH. See <https://debbugs.gnu.org/35241>." - (let ((tmpfile (make-temp-file "files-test" nil (car exec-suffixes)))) - (unwind-protect - (progn - (set-file-modes tmpfile #o777) - (let ((exec-path `(,temporary-file-directory))) - (should - (equal tmpfile - (executable-find (file-name-nondirectory tmpfile))))) - ;; An empty element of `exec-path' means `default-directory'. - (let ((default-directory temporary-file-directory) - (exec-path nil)) - (should - (equal tmpfile - (executable-find (file-name-nondirectory tmpfile))))) - ;; The remote file name shall be quoted, and handled like a - ;; non-existing directory. - (let ((default-directory "/ssh::") - (exec-path (append exec-path `("." ,temporary-file-directory)))) - (should - (equal tmpfile - (executable-find (file-name-nondirectory tmpfile)))))) - (delete-file tmpfile)))) - -(ert-deftest files-tests-dont-rewrite-precious-files () + (ert-with-temp-file tmpfile + :suffix (car exec-suffixes) + (set-file-modes tmpfile #o755) + (let ((exec-path `(,temporary-file-directory))) + (should + (equal tmpfile + (executable-find (file-name-nondirectory tmpfile))))) + ;; An empty element of `exec-path' means `default-directory'. + (let ((default-directory temporary-file-directory) + (exec-path nil)) + (should + (equal tmpfile + (executable-find (file-name-nondirectory tmpfile))))) + ;; The remote file name shall be quoted, and handled like a + ;; non-existing directory. + (let ((default-directory "/ssh::") + (exec-path (append exec-path `("." ,temporary-file-directory)))) + (should + (equal tmpfile + (executable-find (file-name-nondirectory tmpfile))))))) + +;; Note: we call this test "...-zzdont..." so that it runs near the +;; end, because otherwise the advice it adds to write-region doesn't +;; get removed(??) and breaks the revert-file tests on MS-Windows. +(ert-deftest files-tests-zzdont-rewrite-precious-files () "Test that `file-precious-flag' forces files to be saved by renaming only, rather than modified in-place." - (let* ((temp-file-name (make-temp-file "files-tests")) - (advice (lambda (_start _end filename &rest _r) - (should-not (string= filename temp-file-name))))) - (unwind-protect - (with-current-buffer (find-file-noselect temp-file-name) - (advice-add #'write-region :before advice) - (setq-local file-precious-flag t) - (insert "foobar") - (should (null (save-buffer)))) - (ignore-errors (advice-remove #'write-region advice)) - (ignore-errors (delete-file temp-file-name))))) + (ert-with-temp-file temp-file-name + (let* ((advice (lambda (_start _end filename &rest _r) + (should-not (string= filename temp-file-name))))) + (unwind-protect + (with-current-buffer (find-file-noselect temp-file-name) + (advice-add #'write-region :before advice) + (setq-local file-precious-flag t) + (insert "foobar") + (should (null (save-buffer)))) + (ignore-errors (advice-remove #'write-region advice)))))) (ert-deftest files-test-file-size-human-readable () (should (equal (file-size-human-readable 13) "13")) @@ -1462,7 +1460,7 @@ renaming only, rather than modified in-place." (should (equal (file-size-human-readable-iec 0) "0 B")) (should (equal (file-size-human-readable-iec 1) "1 B")) (should (equal (file-size-human-readable-iec 9621) "9.4 KiB")) - (should (equal (file-size-human-readable-iec 72528034765) "67.5 GiB"))) + (should (equal (file-size-human-readable-iec 72528034765) "68 GiB"))) (ert-deftest files-test-magic-mode-alist-re-baseline () "Test magic-mode-alist with RE, expected behavior for match." @@ -1542,7 +1540,7 @@ The door of all subtleties! (ert-deftest files-tests-revert-buffer () "Test that revert-buffer is successful." - (files-tests--with-temp-file temp-file-name + (ert-with-temp-file temp-file-name (with-temp-buffer (insert files-tests-lao) (write-file temp-file-name) @@ -1555,7 +1553,7 @@ The door of all subtleties! (ert-deftest files-tests-revert-buffer-with-fine-grain () "Test that revert-buffer-with-fine-grain is successful." - (files-tests--with-temp-file temp-file-name + (ert-with-temp-file temp-file-name (with-temp-buffer (insert files-tests-lao) (write-file temp-file-name) @@ -1584,6 +1582,14 @@ The door of all subtleties! (should-error (file-name-with-extension "Jack" ".")) (should-error (file-name-with-extension "/is/a/directory/" "css"))) +(ert-deftest files-tests-file-name-base () + (should (equal (file-name-base "") "")) + (should (equal (file-name-base "/foo/") "")) + (should (equal (file-name-base "/foo") "foo")) + (should (equal (file-name-base "/foo/bar") "bar")) + (should (equal (file-name-base "foo") "foo")) + (should (equal (file-name-base "foo/bar") "bar"))) + (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" (find-file (ert-resource-file "whatever.quux")) @@ -1611,40 +1617,39 @@ on BUF-1 and BUF-2 after the `save-some-buffers' call. The test is repeated with `save-some-buffers-default-predicate' let-bound to PRED and passing nil as second arg of `save-some-buffers'." - (let* ((dir (make-temp-file "testdir" 'dir)) - (file-1 (expand-file-name "subdir-1/file.foo" dir)) - (file-2 (expand-file-name "subdir-2/file.bar" dir)) - (inhibit-message t) - buf-1 buf-2) - (unwind-protect - (progn - (make-empty-file file-1 'parens) - (make-empty-file file-2 'parens) - (setq buf-1 (find-file file-1) - buf-2 (find-file file-2)) - (dolist (buf (list buf-1 buf-2)) - (with-current-buffer buf (insert "foobar\n"))) - ;; Run the test. - (with-current-buffer buf-1 - (let ((save-some-buffers-default-predicate def-pred-bind)) - (save-some-buffers t pred)) - (should (eq exp-1 (buffer-modified-p buf-1))) - (should (eq exp-2 (buffer-modified-p buf-2)))) - ;; Set both buffers as modified to run another test. - (dolist (buf (list buf-1 buf-2)) - (with-current-buffer buf (set-buffer-modified-p t))) - ;; The result of this test must be identical as the previous one. - (with-current-buffer buf-1 - (let ((save-some-buffers-default-predicate (or pred def-pred-bind))) - (save-some-buffers t nil)) - (should (eq exp-1 (buffer-modified-p buf-1))) - (should (eq exp-2 (buffer-modified-p buf-2))))) - ;; Clean up. - (dolist (buf (list buf-1 buf-2)) - (with-current-buffer buf - (set-buffer-modified-p nil) - (kill-buffer buf))) - (delete-directory dir 'recursive)))) + (ert-with-temp-directory dir + (let* ((file-1 (expand-file-name "subdir-1/file.foo" dir)) + (file-2 (expand-file-name "subdir-2/file.bar" dir)) + (inhibit-message t) + buf-1 buf-2) + (unwind-protect + (progn + (make-empty-file file-1 'parens) + (make-empty-file file-2 'parens) + (setq buf-1 (find-file file-1) + buf-2 (find-file file-2)) + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (insert "foobar\n"))) + ;; Run the test. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate def-pred-bind)) + (save-some-buffers t pred)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2)))) + ;; Set both buffers as modified to run another test. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (set-buffer-modified-p t))) + ;; The result of this test must be identical as the previous one. + (with-current-buffer buf-1 + (let ((save-some-buffers-default-predicate (or pred def-pred-bind))) + (save-some-buffers t nil)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2))))) + ;; Clean up. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))))) (ert-deftest files-tests-save-some-buffers () "Test `save-some-buffers'. @@ -1671,7 +1676,7 @@ PRED is nil." (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results) (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2)))) -(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) +(defun files-tests--with-buffer-offer-save (buffers-offer fn-test args-results) "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. This macro creates several non-file-visiting buffers in different @@ -1685,52 +1690,52 @@ FN-TEST is the function to test: either `save-some-buffers' or `save-some-buffers-default-predicate' let-bound to a value specified inside ARGS-RESULTS. -FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION -is a function symbol that this macro temporary binds to BINDING during -the FN-TEST call. +During the call to FN-TEST,`read-event' is overridden with a function that +just returns `n' and `kill-emacs' is overriden to do nothing. ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where FN-ARGS are the arguments for FN-TEST; CALLERS-DIR specifies the value to let-bind \`save-some-buffers-default-predicate'; EXPECTED is the expected result of the test." - (declare (debug (form symbol form form))) - (let ((dir (gensym "dir")) - (buffers (gensym "buffers"))) - `(let* ((,dir (make-temp-file "testdir" 'dir)) - (inhibit-message t) - (use-dialog-box nil) - ,buffers) - (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer) - (let* ((buf (generate-new-buffer (symbol-name bufsym))) - (subdir (expand-file-name - (format "subdir-%s" (buffer-name buf)) - ,dir))) - (make-directory subdir 'parens) - (push buf ,buffers) - (with-current-buffer buf - (cd subdir) - (setq buffer-offer-save offer-save) - (insert "foobar\n")))) - (setq ,buffers (nreverse ,buffers)) - (let ((nb-saved-buffers 0)) - (unwind-protect - (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) - ,args-results) - (setq nb-saved-buffers 0) - (with-current-buffer (car ,buffers) - (cl-letf - (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair))) - fn-binders) - (save-some-buffers-default-predicate callers-dir)) - (apply #',fn-test fn-test-args) - (should (equal nb-saved-buffers expected))))) - ;; Clean up. - (dolist (buf ,buffers) - (with-current-buffer buf - (set-buffer-modified-p nil) - (kill-buffer buf))) - (delete-directory ,dir 'recursive)))))) + (let* ((dir (make-temp-file "testdir" 'dir)) + (inhibit-message t) + (use-dialog-box nil) + buffers) + (pcase-dolist (`(,bufsym ,offer-save) buffers-offer) + (let* ((buf (generate-new-buffer (symbol-name bufsym))) + (subdir (expand-file-name + (format "subdir-%s" (buffer-name buf)) + dir))) + (make-directory subdir 'parens) + (push buf buffers) + (with-current-buffer buf + (cd subdir) + (setq buffer-offer-save offer-save) + (insert "foobar\n")))) + (setq buffers (nreverse buffers)) + (let ((nb-saved-buffers 0)) + (unwind-protect + (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) + args-results) + (setq nb-saved-buffers 0) + (with-current-buffer (car buffers) + (cl-letf + (((symbol-function 'read-event) + ;; Increase counter and answer 'n' when prompted + ;; to save a buffer. + (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)) + ;; Do not kill Emacs. + ((symbol-function 'kill-emacs) #'ignore) + (save-some-buffers-default-predicate callers-dir)) + (apply fn-test fn-test-args) + (should (equal nb-saved-buffers expected))))) + ;; Clean up. + (dolist (buf buffers) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory dir 'recursive))))) (defmacro files-tests-with-all-permutations (permutation list &rest body) "Execute BODY forms for all permutations of LIST. @@ -1782,9 +1787,7 @@ PRED is nil." (args-res `(((nil ,pred) ,callers-dir ,res)))) (files-tests--with-buffer-offer-save buffers-offer - save-some-buffers - ;; Increase counter and answer 'n' when prompted to save a buffer. - (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))) + #'save-some-buffers args-res))))))) (ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers () @@ -1799,14 +1802,17 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." buffers-offer-init (files-tests--with-buffer-offer-save buffers-offer - save-buffers-kill-emacs - ;; Increase counter and answer 'n' when prompted to save a buffer. - (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)) - ('kill-emacs . #'ignore)) ; Do not kill Emacs. + #'save-buffers-kill-emacs `((nil nil ,nb-might-save) ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored. (nil save-some-buffers-root ,nb-might-save)))))) +(ert-deftest test-file-name-split () + (should (equal (file-name-split "foo/bar") '("foo" "bar"))) + (should (equal (file-name-split "/foo/bar") '("" "foo" "bar"))) + (should (equal (file-name-split "/foo/bar/zot") '("" "foo" "bar" "zot"))) + (should (equal (file-name-split "/foo/bar/") '("" "foo" "bar" ""))) + (should (equal (file-name-split "foo/bar/") '("foo" "bar" "")))) (provide 'files-tests) ;;; files-tests.el ends here |