diff options
Diffstat (limited to 'test/lisp/files-tests.el')
| -rw-r--r-- | test/lisp/files-tests.el | 202 |
1 files changed, 177 insertions, 25 deletions
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 1fc80073529..dc96dff6398 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'nadvice) (eval-when-compile (require 'cl-lib)) (require 'bytecomp) ; `byte-compiler-base-file-name'. @@ -150,8 +151,21 @@ form.") (dolist (subtest (cdr test)) (should (file-test--do-local-variables-test str subtest))))))) +(ert-deftest files-tests-permanent-local-variables () + (let ((enable-local-variables nil)) + (with-temp-buffer + (insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n") + (hack-local-variables) + (should (eq lexical-binding t)))) + (let ((enable-local-variables nil) + (permanently-enabled-local-variables nil)) + (with-temp-buffer + (insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n") + (hack-local-variables) + (should (eq lexical-binding nil))))) + (defvar files-test-bug-18141-file - (expand-file-name "data/files-bug18141.el.gz" (getenv "EMACS_TEST_DIRECTORY")) + (ert-resource-file "files-bug18141.el.gz") "Test file for bug#18141.") (ert-deftest files-tests-bug-18141 () @@ -190,16 +204,38 @@ form.") (ert-deftest files-tests-bug-21454 () "Test for https://debbugs.gnu.org/21454 ." - :expected-result :failed (let ((input-result - '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/")) - ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("//foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo//bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo//bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")) - ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")))) + (if (memq system-type '(windows-nt ms-dos)) + '(("x:/foo/bar//baz/;y:/bar/foo/baz//" nil + ("x:/foo/bar/baz/" "y:/bar/foo/baz/")) + ("x:/foo/bar/;y:/bar/qux/;z:/qux/foo" nil + ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/")) + ("x://foo/bar/;y:/bar/qux/;z:/qux/foo/" nil + ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/")) + ("x:/foo/bar/;y:/bar/qux/;z:/qux/foo/" nil + ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/")) + ("x:/foo//bar/;y:/bar/qux/;z:/qux/foo/" nil + ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/")) + ("x:/foo//bar/;y:/bar/qux/;z:/qux/foo" nil + ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/")) + ("x:/foo/bar" "$FOO/baz/;z:/qux/foo/" + ("x:/foo/bar/baz/" "z:/qux/foo/")) + ("x://foo/bar/" "$FOO/baz/;z:/qux/foo/" + ("x:/foo/bar/baz/" "z:/qux/foo/"))) + '(("/foo/bar//baz/:/bar/foo/baz//" nil + ("/foo/bar/baz/" "/bar/foo/baz/")) + ("/foo/bar/:/bar/qux/:/qux/foo" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("//foo/bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")) + ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))) (foo-env (getenv "FOO")) (bar-env (getenv "BAR"))) (unwind-protect @@ -279,12 +315,15 @@ be $HOME." (file-name-unquote temporary-file-directory)))))) (ert-deftest files-tests-file-name-non-special--subprocess () - "Check that Bug#25949 is fixed." - (skip-unless (executable-find "true")) - (let ((default-directory (file-name-quote temporary-file-directory))) - (should (zerop (process-file "true"))) - (should (processp (start-file-process "foo" nil "true"))) - (should (zerop (shell-command "true"))))) + "Check that Bug#25949 and Bug#48177 are fixed." + (skip-unless (and (executable-find "true") (file-exists-p null-device))) + (let ((default-directory (file-name-quote temporary-file-directory)) + (true (file-name-quote (executable-find "true"))) + (null (file-name-quote null-device))) + (should (zerop (process-file true null `((:file ,null) ,null)))) + (should (processp (start-file-process "foo" nil true))) + (should (zerop (shell-command true))) + (should (processp (make-process :name "foo" :command `(,true)))))) (defmacro files-tests--with-advice (symbol where function &rest body) (declare (indent 3)) @@ -692,9 +731,8 @@ unquoted file names." (file (file-name-nondirectory tmpfile)) (nospecial-file (file-name-nondirectory nospecial))) (should-not (string-equal file nospecial-file)) - (should-not (equal (file-name-all-completions - nospecial-file nospecial-tempdir) - (file-name-all-completions file tmpdir))) + (should (equal (file-name-all-completions nospecial-file nospecial-tempdir) + (file-name-all-completions file tmpdir))) (should (equal (file-name-all-completions file nospecial-tempdir) (file-name-all-completions file tmpdir))) (should (equal (file-name-all-completions nospecial-file tmpdir) @@ -736,8 +774,8 @@ unquoted file names." (file (file-name-nondirectory tmpfile)) (nospecial-file (file-name-nondirectory nospecial))) (should-not (string-equal file nospecial-file)) - (should-not (equal (file-name-completion nospecial-file nospecial-tempdir) - (file-name-completion file tmpdir))) + (should (equal (file-name-completion nospecial-file nospecial-tempdir) + (file-name-completion file tmpdir))) (should (equal (file-name-completion file nospecial-tempdir) (file-name-completion file tmpdir))) (should (equal (file-name-completion nospecial-file tmpdir) @@ -857,10 +895,15 @@ unquoted file names." (find-backup-file-name tmpfile))))))) (ert-deftest files-tests-file-name-non-special-get-file-buffer () + ;; Make sure these buffers don't exist. (files-tests--with-temp-non-special (tmpfile nospecial) - (should-not (get-file-buffer nospecial))) + (let ((fbuf (get-file-buffer nospecial))) + (if fbuf (kill-buffer fbuf)) + (should-not (get-file-buffer nospecial)))) (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) - (should-not (get-file-buffer nospecial)))) + (let ((fbuf (get-file-buffer nospecial))) + (if fbuf (kill-buffer fbuf)) + (should-not (get-file-buffer nospecial))))) (ert-deftest files-tests-file-name-non-special-insert-directory () (files-tests--with-temp-non-special (tmpdir nospecial-dir t) @@ -1003,9 +1046,9 @@ unquoted file names." (ert-deftest files-tests-file-name-non-special-set-file-times () (files-tests--with-temp-non-special (tmpfile nospecial) - (set-file-times nospecial)) + (set-file-times nospecial nil 'nofollow)) (files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial) - (should-error (set-file-times nospecial)))) + (should-error (set-file-times nospecial nil 'nofollow)))) (ert-deftest files-tests-file-name-non-special-set-visited-file-modtime () (files-tests--with-temp-non-special (tmpfile nospecial) @@ -1164,6 +1207,42 @@ works as expected if the default directory is quoted." (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) + (cons "o=t" #o1000) + (cons "o=xt" #o1001) + (cons "o=tx" #o1001) ; Order doesn't matter. + (cons "u=rwx,g=rx,o=rx" #o755) + (cons "u=rwx,g=,o=" #o700) + (cons "u=rwx" #o700) ; Empty permissions can be ignored. + (cons "u=rw,g=r,o=r" #o644) + (cons "u=rw,g=r,o=t" #o1640) + (cons "u=rw,g=r,o=xt" #o1641) + (cons "u=rwxs,g=rs,o=xt" #o7741) + (cons "u=rws,g=rs,o=t" #o7640) + (cons "u=rws,g=rs,o=r" #o6644) + (cons "a=r" #o444) + (cons "u=S" nil) + (cons "u=T" nil) + (cons "u=Z" nil)))) + (dolist (x alist) + (if (cdr-safe x) + (should (equal (cdr x) (file-modes-symbolic-to-number (car x)))) + (should-error (file-modes-symbolic-to-number (car x))))))) + +(ert-deftest files-tests-file-modes-number-to-symbolic () + (let ((alist (list (cons #o755 "-rwxr-xr-x") + (cons #o700 "-rwx------") + (cons #o644 "-rw-r--r--") + (cons #o1640 "-rw-r----T") + (cons #o1641 "-rw-r----t") + (cons #o7741 "-rwsr-S--t") + (cons #o7640 "-rwSr-S--T") + (cons #o6644 "-rwSr-Sr--") + (cons #o444 "-r--r--r--")))) + (dolist (x alist) + (should (equal (cdr x) (file-modes-number-to-symbolic (car x))))))) + (ert-deftest files-tests-no-file-write-contents () "Test that `write-contents-functions' permits saving a file. Usually `basic-save-buffer' will prompt for a file name if the @@ -1326,5 +1405,78 @@ See <https://debbugs.gnu.org/36401>." (normal-mode) (should (not (eq major-mode 'text-mode)))))) +(ert-deftest files-colon-path () + (if (memq system-type '(windows-nt ms-dos)) + (should (equal (parse-colon-path "x:/foo//bar/baz") + '("x:/foo/bar/baz/"))) + (should (equal (parse-colon-path "/foo//bar/baz") + '("/foo/bar/baz/"))))) + +(ert-deftest files-test-magic-mode-alist-doctype () + "Test that DOCTYPE and variants put files in mhtml-mode." + (with-temp-buffer + (goto-char (point-min)) + (insert "<!DOCTYPE html>") + (normal-mode) + (should (eq major-mode 'mhtml-mode)) + (erase-buffer) + (insert "<!doctype html>") + (normal-mode) + (should (eq major-mode 'mhtml-mode)))) + +(defvar files-tests-lao "The Way that can be told of is not the eternal Way; +The name that can be named is not the eternal name. +The Nameless is the origin of Heaven and Earth; +The Named is the mother of all things. +Therefore let there always be non-being, + so we may see their subtlety, +And let there always be being, + so we may see their outcome. +The two are the same, +But after they are produced, + they have different names. +") + +(defvar files-tests-tzu "The Nameless is the origin of Heaven and Earth; +The named is the mother of all things. + +Therefore let there always be non-being, + so we may see their subtlety, +And let there always be being, + so we may see their outcome. +The two are the same, +But after they are produced, + they have different names. +They both may be called deep and profound. +Deeper and more profound, +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 + (with-temp-buffer + (insert files-tests-lao) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (revert-buffer t t t) + (should (compare-strings files-tests-lao nil nil + (buffer-substring (point-min) (point-max)) + nil nil))))) + +(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 + (with-temp-buffer + (insert files-tests-lao) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (should (revert-buffer-with-fine-grain t t)) + (should (compare-strings files-tests-lao nil nil + (buffer-substring (point-min) (point-max)) + nil nil))))) + (provide 'files-tests) ;;; files-tests.el ends here |