procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Prefer ert-with-temp-(directory|file) in most remaining tests

Browse source 
* test/lisp/auth-source-tests.el (auth-source-test-searches):
* test/lisp/autorevert-tests.el (auto-revert-test00-auto-revert-mode)
(auto-revert-test01-auto-revert-several-files)
(auto-revert-test02-auto-revert-deleted-file)
(auto-revert-test03-auto-revert-tail-mode)
(auto-revert-test04-auto-revert-mode-dired)
(auto-revert-test05-global-notify)
(auto-revert-test06-write-file)
(auto-revert-test07-auto-revert-several-buffers):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-cycle):
* test/lisp/custom-tests.el (custom-theme--load-path):
* test/lisp/dired-aux-tests.el (dired-test-bug27496)
(with-dired-bug28834-test):
* test/lisp/emacs-lisp/bytecomp-tests.el (test-byte-comp-compile-and-load)
(bytecomp-tests--dest-mountpoint)
(bytecomp-tests--target-file-no-directory):
* test/lisp/emacs-lisp/gv-tests.el (gv-tests--in-temp-dir):
* test/lisp/eshell/eshell-tests.el (with-temp-eshell)
(eshell-test-command-result):
* test/lisp/info-xref-tests.el (info-xref-test-makeinfo):
* test/lisp/vc/vc-tests.el (vc-test--create-repo)
(vc-test--register, vc-test--state, vc-test--working-revision)
(vc-test--checkout-model, vc-test--rename-file)
(vc-test--version-diff):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-delete):
* test/src/comp-tests.el (comp-tests-bootstrap):
* test/src/process-tests.el (process-test-quoted-batfile): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
This commit is contained in:
Stefan Kangas 2021-11-08 01:21:06 +01:00
parent 6fa5f0cbbc
commit cdd7589330
14 changed files with 1060 additions and 1114 deletions
Download patch file Download diff file Expand all files Collapse all files

45
test/lisp/auth-source-tests.el
View file

@ -278,34 +278,33 @@
"((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\") (:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\") (:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
:host t :max 4)
("host b1, default max is 1"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
:host "b1")
("host b1, port b2, user b3, default max is 1"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
:host "b1" :port "b2" :user "b3")
))
)))
(ert-with-temp-file netrc-file
:text (mapconcat 'identity entries "\n")
(let ((auth-sources (list netrc-file))
(auth-source-do-cache nil)
found found-as-string)
(netrc-file (make-temp-file "auth-source-test" nil nil
(mapconcat 'identity entries "\n")))
(auth-sources (list netrc-file))
(auth-source-do-cache nil)
found found-as-string)
(dolist (test tests)
(cl-destructuring-bind (testname needed &rest parameters) test
(setq found (apply #'auth-source-search parameters))
(when (listp found)
(dolist (f found)
(setf f (plist-put f :secret
(let ((secret (plist-get f :secret)))
(if (functionp secret)
(funcall secret)
secret))))))
(dolist (test tests)
(cl-destructuring-bind (testname needed &rest parameters) test
(setq found (apply #'auth-source-search parameters))
(when (listp found)
(dolist (f found)
(setf f (plist-put f :secret
(let ((secret (plist-get f :secret)))
(if (functionp secret)
(funcall secret)
secret))))))
(setq found-as-string (format "%s: %S" testname found))
;; (message "With parameters %S found: [%s] needed: [%s]" parameters found-as-string needed)
(should (equal found-as-string (concat testname ": " needed)))))
(delete-file netrc-file)))
(setq found-as-string (format "%s: %S" testname found))
;; (message "With parameters %S found: [%s] needed: [%s]"
;; parameters found-as-string needed)
(should (equal found-as-string (concat testname ": " needed)))))))))
(ert-deftest auth-source-test-secrets-create-secret ()
(skip-unless secrets-enabled)

761
test/lisp/autorevert-tests.el
View file

@ -174,42 +174,41 @@ This expects `auto-revert--messages' to be bound by
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(with-auto-revert-test
(let ((tmpfile (make-temp-file "auto-revert-test"))
(times '(60 30 15))
buf)
(unwind-protect
(progn
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
(ert-with-message-capture auto-revert--messages
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(ert-with-temp-file tmpfile
(let ((times '(60 30 15))
buf)
(unwind-protect
(progn
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
(ert-with-message-capture auto-revert--messages
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf))
(should (string-match "another text" (buffer-string)))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf))
(should (string-match "another text" (buffer-string)))
;; When the buffer is modified, it shall not be reverted.
(ert-with-message-capture auto-revert--messages
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
;; When the buffer is modified, it shall not be reverted.
(ert-with-message-capture auto-revert--messages
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
;; Check, that the buffer hasn't been reverted.
(auto-revert--wait-for-revert buf))
(should-not (string-match "any text" (buffer-string)))))
;; Check, that the buffer hasn't been reverted.
(auto-revert--wait-for-revert buf))
(should-not (string-match "any text" (buffer-string)))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))
(ignore-errors (delete-file tmpfile))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))))
(auto-revert--deftest-remote auto-revert-test00-auto-revert-mode
"Check autorevert for a remote file.")
@ -219,63 +218,61 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for several files at once."
(skip-unless (executable-find "cp" (file-remote-p temporary-file-directory)))
(with-auto-revert-test
(let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory)))
(tmpdir1 (make-temp-file "auto-revert-test" 'dir))
(tmpdir2 (make-temp-file "auto-revert-test" 'dir))
(tmpfile1
(make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
(tmpfile2
(make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
(times '(120 60 30 15))
buf1 buf2)
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile1 (pop times))
(setq buf1 (find-file-noselect tmpfile1))
(auto-revert-tests--write-file "any text" tmpfile2 (pop times))
(setq buf2 (find-file-noselect tmpfile2))
(ert-with-temp-directory tmpdir1
(ert-with-temp-directory tmpdir2
(ert-with-temp-file tmpfile1
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(ert-with-temp-file tmpfile2
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(with-auto-revert-test
(let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory)))
(times '(120 60 30 15))
buf1 buf2)
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile1 (pop times))
(setq buf1 (find-file-noselect tmpfile1))
(auto-revert-tests--write-file "any text" tmpfile2 (pop times))
(setq buf2 (find-file-noselect tmpfile2))
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)))
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)))
;; Modify files. We wait for a second, in order to have
;; another timestamp.
(auto-revert-tests--write-file
"another text"
(expand-file-name (file-name-nondirectory tmpfile1) tmpdir2)
(pop times))
(auto-revert-tests--write-file
"another text"
(expand-file-name (file-name-nondirectory tmpfile2) tmpdir2)
(pop times))
;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents)
;; Strange, that `copy-directory' does not work as expected.
;; The following shell command is not portable on all
;; platforms, unfortunately.
(shell-command
(format "%s -f %s/* %s"
cp (file-local-name tmpdir2) (file-local-name tmpdir1)))
;; Modify files. We wait for a second, in order to have
;; another timestamp.
(auto-revert-tests--write-file
"another text"
(expand-file-name (file-name-nondirectory tmpfile1) tmpdir2)
(pop times))
(auto-revert-tests--write-file
"another text"
(expand-file-name (file-name-nondirectory tmpfile2) tmpdir2)
(pop times))
;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents)
;; Strange, that `copy-directory' does not work as expected.
;; The following shell command is not portable on all
;; platforms, unfortunately.
(shell-command
(format "%s -f %s/* %s"
cp (file-local-name tmpdir2) (file-local-name tmpdir1)))
;; Check, that the buffers have been reverted.
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(auto-revert--wait-for-revert buf)
(should (string-match "another text" (buffer-string))))))
;; Check, that the buffers have been reverted.
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(auto-revert--wait-for-revert buf)
(should (string-match "another text" (buffer-string))))))
;; Exit.
(ignore-errors
(dolist (buf (list buf1 buf2))
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))
(ignore-errors (delete-directory tmpdir1 'recursive))
(ignore-errors (delete-directory tmpdir2 'recursive))))))
;; Exit.
(ignore-errors
(dolist (buf (list buf1 buf2))
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))))))))
(auto-revert--deftest-remote auto-revert-test01-auto-revert-several-files
"Check autorevert for several remote files at once.")
@ -285,79 +282,78 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for a deleted file."
;; Repeated unpredictable failures, bug#32645.
;; Unlikely to be hydra-specific?
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
:tags '(:unstable)
(with-auto-revert-test
(let ((tmpfile (make-temp-file "auto-revert-test"))
;; Try to catch bug#32645.
(auto-revert-debug (getenv "EMACS_HYDRA_CI"))
(file-notify-debug (getenv "EMACS_HYDRA_CI"))
(times '(120 60 30 15))
buf desc)
(unwind-protect
(progn
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
(should-not
(file-notify-valid-p auto-revert-notify-watch-descriptor))
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(setq desc auto-revert-notify-watch-descriptor)
(ert-with-temp-file tmpfile
(let (;; Try to catch bug#32645.
(auto-revert-debug (getenv "EMACS_HYDRA_CI"))
(file-notify-debug (getenv "EMACS_HYDRA_CI"))
(times '(120 60 30 15))
buf desc)
(unwind-protect
(progn
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
(should-not
(file-notify-valid-p auto-revert-notify-watch-descriptor))
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(setq desc auto-revert-notify-watch-descriptor)
;; Remove file while reverting. We simulate this by
;; modifying `before-revert-hook'.
(add-hook
'before-revert-hook
(lambda ()
(when auto-revert-debug
(message "%s deleted" buffer-file-name))
(delete-file buffer-file-name))
nil t)
;; Remove file while reverting. We simulate this by
;; modifying `before-revert-hook'.
(add-hook
'before-revert-hook
(lambda ()
(when auto-revert-debug
(message "%s deleted" buffer-file-name))
(delete-file buffer-file-name))
nil t)
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer hasn't been reverted. File
;; notification should be disabled, falling back to
;; polling.
(should (string-match "any text" (buffer-string)))
;; With w32notify, and on emba, the `stopped' events are not sent.
(or (eq file-notify--library 'w32notify)
(getenv "EMACS_EMBA_CI")
(should-not
(file-notify-valid-p auto-revert-notify-watch-descriptor)))
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer hasn't been reverted. File
;; notification should be disabled, falling back to
;; polling.
(should (string-match "any text" (buffer-string)))
;; With w32notify, and on emba, the `stopped' events are not sent.
(or (eq file-notify--library 'w32notify)
(getenv "EMACS_EMBA_CI")
(should-not
(file-notify-valid-p auto-revert-notify-watch-descriptor)))
;; Once the file has been recreated, the buffer shall be
;; reverted.
(kill-local-variable 'before-revert-hook)
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-match "another text" (buffer-string)))
;; When file notification is used, it must be reenabled
;; after recreation of the file. We cannot expect that
;; the descriptor is the same, so we just check the
;; existence.
(should (eq (null desc) (null auto-revert-notify-watch-descriptor)))
;; Once the file has been recreated, the buffer shall be
;; reverted.
(kill-local-variable 'before-revert-hook)
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-match "another text" (buffer-string)))
;; When file notification is used, it must be reenabled
;; after recreation of the file. We cannot expect that
;; the descriptor is the same, so we just check the
;; existence.
(should (eq (null desc) (null auto-revert-notify-watch-descriptor)))
;; An empty file shall still be reverted.
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-equal "" (buffer-string)))))
;; An empty file shall still be reverted.
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-equal "" (buffer-string)))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))
(ignore-errors (delete-file tmpfile))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))))
(auto-revert--deftest-remote auto-revert-test02-auto-revert-deleted-file
"Check autorevert for a deleted remote file.")
@ -366,34 +362,33 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert tail mode."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(let ((tmpfile (make-temp-file "auto-revert-test"))
(times '(30 15))
buf)
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-tail-mode 1)
(should auto-revert-tail-mode)
(erase-buffer)
(insert "modified text\n")
(set-buffer-modified-p nil)
(ert-with-temp-file tmpfile
(let ((times '(30 15))
buf)
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-tail-mode 1)
(should auto-revert-tail-mode)
(erase-buffer)
(insert "modified text\n")
(set-buffer-modified-p nil)
;; Modify file.
(auto-revert-tests--write-file "another text" tmpfile (pop times) 'append)
;; Modify file.
(auto-revert-tests--write-file "another text" tmpfile (pop times) 'append)
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf)
(should
(string-match "modified text\nanother text" (buffer-string)))))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf)
(should
(string-match "modified text\nanother text" (buffer-string)))))
;; Exit.
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
;; Exit.
(ignore-errors (kill-buffer buf))))))
(auto-revert--deftest-remote auto-revert-test03-auto-revert-tail-mode
"Check remote autorevert tail mode.")
@ -403,46 +398,45 @@ This expects `auto-revert--messages' to be bound by
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(with-auto-revert-test
(let* ((tmpfile (make-temp-file "auto-revert-test"))
(name (file-name-nondirectory tmpfile))
(times '(30))
buf)
(unwind-protect
(progn
(setq buf (dired-noselect temporary-file-directory))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(should
(string-match name (substring-no-properties (buffer-string))))
(ert-with-temp-file tmpfile
(let* ((name (file-name-nondirectory tmpfile))
(times '(30))
buf)
(unwind-protect
(progn
(setq buf (dired-noselect temporary-file-directory))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(should
(string-match name (substring-no-properties (buffer-string))))
(ert-with-message-capture auto-revert--messages
;; Delete file.
(delete-file tmpfile)
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should-not
(string-match name (substring-no-properties (buffer-string))))
(ert-with-message-capture auto-revert--messages
;; Delete file.
(delete-file tmpfile)
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should-not
(string-match name (substring-no-properties (buffer-string))))
(ert-with-message-capture auto-revert--messages
;; Make dired buffer modified. Check, that the buffer has
;; been still reverted.
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(ert-with-message-capture auto-revert--messages
;; Make dired buffer modified. Check, that the buffer has
;; been still reverted.
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should
(string-match name (substring-no-properties (buffer-string))))))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should
(string-match name (substring-no-properties (buffer-string))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))
(ignore-errors (delete-file tmpfile))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))))
(auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired
"Check remote autorevert for dired.")
@ -485,99 +479,98 @@ This expects `auto-revert--messages' to be bound by
(skip-unless (or file-notify--library
(file-remote-p temporary-file-directory)))
(with-auto-revert-test
(let* ((auto-revert-use-notify t)
(auto-revert-avoid-polling t)
(auto-revert-debug (getenv "EMACS_EMBA_CI"))
(file-notify-debug (getenv "EMACS_EMBA_CI"))
(was-in-global-auto-revert-mode global-auto-revert-mode)
(file-1 (make-temp-file "global-auto-revert-test-1"))
(file-2 (make-temp-file "global-auto-revert-test-2"))
(file-3 (make-temp-file "global-auto-revert-test-3"))
(file-2b (concat file-2 "-b"))
require-final-newline buf-1 buf-2 buf-3)
(unwind-protect
(progn
(setq buf-1 (find-file-noselect file-1))
(auto-revert-test--instrument-kill-buffer-hook buf-1)
(setq buf-2 (find-file-noselect file-2))
(auto-revert-test--instrument-kill-buffer-hook buf-2)
(auto-revert-test--write-file "1-a" file-1)
(should (equal (auto-revert-test--buffer-string buf-1) ""))
(ert-with-temp-file file-1
(ert-with-temp-file file-2
(ert-with-temp-file file-3
(let* ((auto-revert-use-notify t)
(auto-revert-avoid-polling t)
(auto-revert-debug (getenv "EMACS_EMBA_CI"))
(file-notify-debug (getenv "EMACS_EMBA_CI"))
(was-in-global-auto-revert-mode global-auto-revert-mode)
(file-2b (concat file-2 "-b"))
require-final-newline buf-1 buf-2 buf-3)
(unwind-protect
(progn
(setq buf-1 (find-file-noselect file-1))
(auto-revert-test--instrument-kill-buffer-hook buf-1)
(setq buf-2 (find-file-noselect file-2))
(auto-revert-test--instrument-kill-buffer-hook buf-2)
(auto-revert-test--write-file "1-a" file-1)
(should (equal (auto-revert-test--buffer-string buf-1) ""))
(global-auto-revert-mode 1) ; Turn it on.
(global-auto-revert-mode 1) ; Turn it on.
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-1))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-2))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-1))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-2))
;; buf-1 should have been reverted immediately when the mode
;; was enabled.
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
;; buf-1 should have been reverted immediately when the mode
;; was enabled.
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
;; Alter a file.
(auto-revert-test--write-file "2-a" file-2)
;; Allow for some time to handle notification events.
(auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1)
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
;; Alter a file.
(auto-revert-test--write-file "2-a" file-2)
;; Allow for some time to handle notification events.
(auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1)
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
;; Visit a file, and modify it on disk.
(setq buf-3 (find-file-noselect file-3))
(auto-revert-test--instrument-kill-buffer-hook buf-3)
;; Newly opened buffers won't be use notification until the
;; first poll cycle; wait for it.
(auto-revert-test--wait-for
(lambda () (buffer-local-value
'auto-revert-notify-watch-descriptor buf-3))
(auto-revert--timeout))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-3))
(auto-revert-test--write-file "3-a" file-3)
(auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1)
(should (equal (auto-revert-test--buffer-string buf-3) "3-a"))
;; Visit a file, and modify it on disk.
(setq buf-3 (find-file-noselect file-3))
(auto-revert-test--instrument-kill-buffer-hook buf-3)
;; Newly opened buffers won't be use notification until the
;; first poll cycle; wait for it.
(auto-revert-test--wait-for
(lambda () (buffer-local-value
'auto-revert-notify-watch-descriptor buf-3))
(auto-revert--timeout))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-3))
(auto-revert-test--write-file "3-a" file-3)
(auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1)
(should (equal (auto-revert-test--buffer-string buf-3) "3-a"))
;; Delete a visited file, and re-create it with new contents.
(when auto-revert-debug (message "Hallo0"))
(delete-file file-1)
(when auto-revert-debug (message "Hallo1"))
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(when auto-revert-debug (message "Hallo2"))
(auto-revert-test--write-file "1-b" file-1)
(when auto-revert-debug (message "Hallo3"))
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (auto-revert--timeout))
;; On emba, `buf-1' is a killed buffer.
(when auto-revert-debug
(message
"Hallo4 %s %s %s %s %s %s %s"
buf-1 (buffer-name buf-1) (buffer-live-p buf-1)
file-1 (get-file-buffer file-1)
(buffer-name (get-file-buffer file-1))
(buffer-live-p (get-file-buffer file-1)))
(with-current-buffer buf-1
(message "Hallo5\n%s" (buffer-local-variables))))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-1))
(when auto-revert-debug (message "Hallo6"))
;; Delete a visited file, and re-create it with new contents.
(when auto-revert-debug (message "Hallo0"))
(delete-file file-1)
(when auto-revert-debug (message "Hallo1"))
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(when auto-revert-debug (message "Hallo2"))
(auto-revert-test--write-file "1-b" file-1)
(when auto-revert-debug (message "Hallo3"))
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (auto-revert--timeout))
;; On emba, `buf-1' is a killed buffer.
(when auto-revert-debug
(message
"Hallo4 %s %s %s %s %s %s %s"
buf-1 (buffer-name buf-1) (buffer-live-p buf-1)
file-1 (get-file-buffer file-1)
(buffer-name (get-file-buffer file-1))
(buffer-live-p (get-file-buffer file-1)))
(with-current-buffer buf-1
(message "Hallo5\n%s" (buffer-local-variables))))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-1))
(when auto-revert-debug (message "Hallo6"))
;; Write a buffer to a new file, then modify the new file on disk.
(with-current-buffer buf-2
(write-file file-2b))
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
(auto-revert-test--write-file "2-b" file-2b)
(auto-revert-test--wait-for-buffer-text
buf-2 "2-b" (auto-revert--timeout))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-2)))
;; Write a buffer to a new file, then modify the new file on disk.
(with-current-buffer buf-2
(write-file file-2b))
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
(auto-revert-test--write-file "2-b" file-2b)
(auto-revert-test--wait-for-buffer-text
buf-2 "2-b" (auto-revert--timeout))
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-2)))
;; Clean up.
(unless was-in-global-auto-revert-mode
(global-auto-revert-mode 0)) ; Turn it off.
(dolist (buf (list buf-1 buf-2 buf-3))
(with-current-buffer buf (setq-local kill-buffer-hook nil))
(ignore-errors (kill-buffer buf)))
(dolist (file (list file-1 file-2 file-2b file-3))
(ignore-errors (delete-file file)))))))
;; Clean up.
(unless was-in-global-auto-revert-mode
(global-auto-revert-mode 0)) ; Turn it off.
(dolist (buf (list buf-1 buf-2 buf-3))
(with-current-buffer buf (setq-local kill-buffer-hook nil))
(ignore-errors (kill-buffer buf)))
(ignore-errors (delete-file file-2b)))))))))
(auto-revert--deftest-remote auto-revert-test05-global-notify
"Test `global-auto-revert-mode' without polling for remote buffers.")
@ -587,31 +580,30 @@ This expects `auto-revert--messages' to be bound by
(skip-unless (or file-notify--library
(file-remote-p temporary-file-directory)))
(with-auto-revert-test
(let* ((auto-revert-use-notify t)
(file-1 (make-temp-file "auto-revert-test"))
(file-2 (concat file-1 "-2"))
require-final-newline buf)
(unwind-protect
(progn
(setq buf (find-file-noselect file-1))
(with-current-buffer buf
(insert "A")
(save-buffer)
(ert-with-temp-file file-1
(let* ((auto-revert-use-notify t)
(file-2 (concat file-1 "-2"))
require-final-newline buf)
(unwind-protect
(progn
(setq buf (find-file-noselect file-1))
(with-current-buffer buf
(insert "A")
(save-buffer)
(auto-revert-mode 1)
(auto-revert-mode 1)
(insert "B")
(write-file file-2)
(insert "B")
(write-file file-2)
(auto-revert-test--write-file "C" file-2)
(auto-revert-test--wait-for-buffer-text
buf "C" (auto-revert--timeout))
(should (equal (buffer-string) "C"))))
(auto-revert-test--write-file "C" file-2)
(auto-revert-test--wait-for-buffer-text
buf "C" (auto-revert--timeout))
(should (equal (buffer-string) "C"))))
;; Clean up.
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file file-1))
(ignore-errors (delete-file file-2))))))
;; Clean up.
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file file-2)))))))
(auto-revert--deftest-remote auto-revert-test06-write-file
"Test `write-file' in `auto-revert-mode' for remote buffers.")
@ -620,82 +612,81 @@ This expects `auto-revert--messages' to be bound by
(ert-deftest auto-revert-test07-auto-revert-several-buffers ()
"Check autorevert for several buffers visiting the same file."
;; (with-auto-revert-test
(let ((auto-revert-use-notify t)
(tmpfile (make-temp-file "auto-revert-test"))
(times '(120 60 30 15))
(num-buffers 10)
require-final-newline buffers)
(ert-with-temp-file tmpfile
(let ((auto-revert-use-notify t)
(times '(120 60 30 15))
(num-buffers 10)
require-final-newline buffers)
(unwind-protect
;; Check indirect buffers.
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(push (find-file-noselect tmpfile) buffers)
(with-current-buffer (car buffers)
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode))
(unwind-protect
;; Check indirect buffers.
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(push (find-file-noselect tmpfile) buffers)
(with-current-buffer (car buffers)
(should (string-equal (buffer-string) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode))
(dotimes (i num-buffers)
(push (make-indirect-buffer
(car buffers)
(format "%s-%d" (buffer-file-name (car buffers)) i)
'clone)
buffers))
(setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
(should auto-revert-mode)))
(dotimes (i num-buffers)
(push (make-indirect-buffer
(car buffers)
(format "%s-%d" (buffer-file-name (car buffers)) i)
'clone)
buffers))
(setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
(should auto-revert-mode)))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert (car buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text")))))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert (car buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text")))))
;; Exit.
(ignore-errors
(dolist (buf buffers)
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))
(setq buffers nil)
(ignore-errors (delete-file tmpfile)))
;; Exit.
(ignore-errors
(dolist (buf buffers)
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))
(setq buffers nil)
(ignore-errors (delete-file tmpfile)))
;; Check direct buffers.
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
;; Check direct buffers.
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(dotimes (i num-buffers)
(push (generate-new-buffer
(format "%s-%d" (file-name-nondirectory tmpfile) i))
buffers))
(setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(insert-file-contents tmpfile 'visit)
(should (string-equal (buffer-string) "any text"))
(auto-revert-mode 1)
(should auto-revert-mode)))
(dotimes (i num-buffers)
(push (generate-new-buffer
(format "%s-%d" (file-name-nondirectory tmpfile) i))
buffers))
(setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(insert-file-contents tmpfile 'visit)
(should (string-equal (buffer-string) "any text"))
(auto-revert-mode 1)
(should auto-revert-mode)))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
;; Check, that the buffers have been reverted.
(dolist (buf buffers)
(auto-revert--wait-for-revert buf)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text")))))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
;; Check, that the buffers have been reverted.
(dolist (buf buffers)
(auto-revert--wait-for-revert buf)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text")))))
;; Exit.
(ignore-errors
(dolist (buf buffers)
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))
(ignore-errors (delete-file tmpfile)))));)
;; Exit.
(ignore-errors
(dolist (buf buffers)
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))));)
(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
"Check autorevert for several buffers visiting the same remote file.")

50
test/lisp/calendar/icalendar-tests.el
View file

@ -1240,35 +1240,33 @@ Argument INPUT icalendar event string."
(defun icalendar-tests--do-test-cycle ()
"Actually perform import/export cycle test."
(let ((temp-diary (make-temp-file "icalendar-test-diary"))
(temp-ics (make-temp-file "icalendar-test-ics"))
(org-input (buffer-substring-no-properties (point-min) (point-max))))
(ert-with-temp-file temp-diary
(ert-with-temp-file temp-ics
(let ((org-input (buffer-substring-no-properties (point-min) (point-max))))
(unwind-protect
(progn
;; step 1: import
(icalendar-import-buffer temp-diary t t)
(unwind-protect
(progn
;; step 1: import
(icalendar-import-buffer temp-diary t t)
;; step 2: export what was just imported
(save-excursion
(find-file temp-diary)
(icalendar-export-region (point-min) (point-max) temp-ics))
;; step 2: export what was just imported
(save-excursion
(find-file temp-diary)
(icalendar-export-region (point-min) (point-max) temp-ics))
;; compare the output of step 2 with the input of step 1
(save-excursion
(find-file temp-ics)
(goto-char (point-min))
;;(when (re-search-forward "\nUID:.*\n" nil t)
;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min) (point-max))))
(should (string= org-input cycled)))))
;; clean up
(kill-buffer (find-buffer-visiting temp-diary))
(with-current-buffer (find-buffer-visiting temp-ics)
(set-buffer-modified-p nil)
(kill-buffer (current-buffer)))
(delete-file temp-diary)
(delete-file temp-ics))))
;; compare the output of step 2 with the input of step 1
(save-excursion
(find-file temp-ics)
(goto-char (point-min))
;;(when (re-search-forward "\nUID:.*\n" nil t)
;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min) (point-max))))
(should (string= org-input cycled)))))
;; clean up
(kill-buffer (find-buffer-visiting temp-diary))
(with-current-buffer (find-buffer-visiting temp-ics)
(set-buffer-modified-p nil)
(kill-buffer (current-buffer))))))))
(ert-deftest icalendar-cycle ()
"Perform cycling tests.

22
test/lisp/custom-tests.el
View file

@ -39,28 +39,28 @@
(should (null (custom-theme--load-path))))
;; Path comprises existing file.
(let* ((file (make-temp-file "file"))
(custom-theme-load-path (list file)))
(should (file-exists-p file))
(should (not (file-directory-p file)))
(should (null (custom-theme--load-path))))
(ert-with-temp-file file
(let* ((custom-theme-load-path (list file)))
(should (file-exists-p file))
(should (not (file-directory-p file)))
(should (null (custom-theme--load-path)))))
;; Path comprises existing directory.
(let* ((dir (make-temp-file "dir" t))
(custom-theme-load-path (list dir)))
(should (file-directory-p dir))
(should (equal (custom-theme--load-path) custom-theme-load-path)))
(ert-with-temp-directory dir
(let* ((custom-theme-load-path (list dir)))
(should (file-directory-p dir))
(should (equal (custom-theme--load-path) custom-theme-load-path))))
;; Expand `custom-theme-directory' path element.
(let ((custom-theme-load-path '(custom-theme-directory)))
(let ((custom-theme-directory (make-temp-name temporary-file-directory)))
(should (not (file-exists-p custom-theme-directory)))
(should (null (custom-theme--load-path))))
(let ((custom-theme-directory (make-temp-file "file")))
(ert-with-temp-file custom-theme-directory
(should (file-exists-p custom-theme-directory))
(should (not (file-directory-p custom-theme-directory)))
(should (null (custom-theme--load-path))))
(let ((custom-theme-directory (make-temp-file "dir" t)))
(ert-with-temp-directory custom-theme-directory
(should (file-directory-p custom-theme-directory))
(should (equal (custom-theme--load-path)
(list custom-theme-directory)))))

59
test/lisp/dired-aux-tests.el
View file

@ -26,20 +26,18 @@
(ert-deftest dired-test-bug27496 ()
"Test for https://debbugs.gnu.org/27496 ."
(skip-unless (executable-find shell-file-name))
(let* ((foo (make-temp-file "foo"))
(files (list foo)))
(unwind-protect
(cl-letf (((symbol-function 'read-char-from-minibuffer) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
(should-error (dired-do-shell-command "ls ? ./?" nil files))
(should-error (dired-do-shell-command "ls ./? ?" nil files))
(should-not (dired-do-shell-command "ls ? ?" nil files))
(should-error (dired-do-shell-command "ls * ./*" nil files))
(should-not (dired-do-shell-command "ls * *" nil files))
(should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
(delete-file foo))))
(ert-with-temp-file foo
(let* ((files (list foo)))
(cl-letf (((symbol-function 'read-char-from-minibuffer) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
(should-error (dired-do-shell-command "ls ? ./?" nil files))
(should-error (dired-do-shell-command "ls ./? ?" nil files))
(should-not (dired-do-shell-command "ls ? ?" nil files))
(should-error (dired-do-shell-command "ls * ./*" nil files))
(should-not (dired-do-shell-command "ls * *" nil files))
(should-not (dired-do-shell-command "ls ? ./`?`" nil files))))))
;; Auxiliary macro for `dired-test-bug28834': it binds
;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY.
@ -48,24 +46,21 @@
(defmacro with-dired-bug28834-test (create-dirs yes-or-no &rest body)
(declare (debug (form symbolp body)))
(let ((foo (make-symbol "foo")))
`(let* ((,foo (make-temp-file "foo" 'dir))
(dired-create-destination-dirs ,create-dirs))
(setq from (make-temp-file "from"))
(setq to-cp
(expand-file-name
"foo-cp" (file-name-as-directory (expand-file-name "bar" ,foo))))
(setq to-mv
(expand-file-name
"foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo))))
(unwind-protect
(if ,yes-or-no
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (_prompt) (eq ,yes-or-no 'yes))))
,@body)
,@body)
;; clean up
(delete-directory ,foo 'recursive)
(delete-file from)))))
`(ert-with-temp-directory ,foo
(ert-with-temp-file from
(let* ((dired-create-destination-dirs ,create-dirs))
(setq to-cp
(expand-file-name
"foo-cp" (file-name-as-directory (expand-file-name "bar" ,foo))))
(setq to-mv
(expand-file-name
"foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo))))
(unwind-protect
(if ,yes-or-no
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (_prompt) (eq ,yes-or-no 'yes))))
,@body)
,@body)))))))
(ert-deftest dired-test-bug28834 ()
"test for https://debbugs.gnu.org/28834 ."

152
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -693,24 +693,19 @@ byte-compiled. Run with dynamic binding."
(defun test-byte-comp-compile-and-load (compile &rest forms)
(declare (indent 1))
(let ((elfile nil)
(elcfile nil))
(unwind-protect
(progn
(setf elfile (make-temp-file "test-bytecomp" nil ".el"))
(when compile
(setf elcfile (make-temp-file "test-bytecomp" nil ".elc")))
(with-temp-buffer
(dolist (form forms)
(print form (current-buffer)))
(write-region (point-min) (point-max) elfile nil 'silent))
(if compile
(let ((byte-compile-dest-file-function
(lambda (e) elcfile)))
(byte-compile-file elfile)))
(load elfile nil 'nomessage))
(when elfile (delete-file elfile))
(when elcfile (delete-file elcfile)))))
(ert-with-temp-file elfile
:suffix ".el"
(ert-with-temp-file elcfile
:suffix ".elc"
(with-temp-buffer
(dolist (form forms)
(print form (current-buffer)))
(write-region (point-min) (point-max) elfile nil 'silent))
(if compile
(let ((byte-compile-dest-file-function
(lambda (e) elcfile)))
(byte-compile-file elfile)))
(load elfile nil 'nomessage))))
(ert-deftest test-byte-comp-macro-expansion ()
(test-byte-comp-compile-and-load t
@ -1245,25 +1240,21 @@ literals (Bug#20852)."
(ert-deftest bytecomp-tests--not-writable-directory ()
"Test that byte compilation works if the output directory isn't
writable (Bug#44631)."
(let ((directory (make-temp-file "bytecomp-tests-" :directory)))
(unwind-protect
(let* ((input-file (expand-file-name "test.el" directory))
(output-file (expand-file-name "test.elc" directory))
(byte-compile-dest-file-function
(lambda (_) output-file))
(byte-compile-error-on-warn t))
(write-region "" nil input-file nil nil nil 'excl)
(write-region "" nil output-file nil nil nil 'excl)
(set-file-modes input-file #o400)
(set-file-modes output-file #o200)
(set-file-modes directory #o500)
(should (byte-compile-file input-file))
(should (file-regular-p output-file))
(should (cl-plusp (file-attribute-size
(file-attributes output-file)))))
(with-demoted-errors "Error cleaning up directory: %s"
(set-file-modes directory #o700)
(delete-directory directory :recursive)))))
(ert-with-temp-directory directory
(let* ((input-file (expand-file-name "test.el" directory))
(output-file (expand-file-name "test.elc" directory))
(byte-compile-dest-file-function
(lambda (_) output-file))
(byte-compile-error-on-warn t))
(write-region "" nil input-file nil nil nil 'excl)
(write-region "" nil output-file nil nil nil 'excl)
(set-file-modes input-file #o400)
(set-file-modes output-file #o200)
(set-file-modes directory #o500)
(should (byte-compile-file input-file))
(should (file-regular-p output-file))
(should (cl-plusp (file-attribute-size
(file-attributes output-file)))))))
(ert-deftest bytecomp-tests--dest-mountpoint ()
"Test that byte compilation works if the destination file is a
@ -1275,56 +1266,49 @@ mountpoint (Bug#44631)."
(skip-unless (not (file-remote-p bwrap)))
(skip-unless (file-executable-p emacs))
(skip-unless (not (file-remote-p emacs)))
(let ((directory (make-temp-file "bytecomp-tests-" :directory)))
(unwind-protect
(let* ((input-file (expand-file-name "test.el" directory))
(output-file (expand-file-name "test.elc" directory))
(unquoted-file (file-name-unquote output-file))
(byte-compile-dest-file-function
(lambda (_) output-file))
(byte-compile-error-on-warn t))
(should-not (file-remote-p input-file))
(should-not (file-remote-p output-file))
(write-region "" nil input-file nil nil nil 'excl)
(write-region "" nil output-file nil nil nil 'excl)
(set-file-modes input-file #o400)
(set-file-modes output-file #o200)
(set-file-modes directory #o500)
(with-temp-buffer
(let ((status (call-process
bwrap nil t nil
"--ro-bind" "/" "/"
"--bind" unquoted-file unquoted-file
emacs "--quick" "--batch" "--load=bytecomp"
(format "--eval=%S"
`(setq byte-compile-dest-file-function
(lambda (_) ,output-file)
byte-compile-error-on-warn t))
"--funcall=batch-byte-compile" input-file)))
(unless (eql status 0)
(ert-fail `((status . ,status)
(output . ,(buffer-string)))))))
(should (file-regular-p output-file))
(should (cl-plusp (file-attribute-size
(file-attributes output-file)))))
(with-demoted-errors "Error cleaning up directory: %s"
(set-file-modes directory #o700)
(delete-directory directory :recursive))))))
(ert-with-temp-directory directory
(let* ((input-file (expand-file-name "test.el" directory))
(output-file (expand-file-name "test.elc" directory))
(unquoted-file (file-name-unquote output-file))
(byte-compile-dest-file-function
(lambda (_) output-file))
(byte-compile-error-on-warn t))
(should-not (file-remote-p input-file))
(should-not (file-remote-p output-file))
(write-region "" nil input-file nil nil nil 'excl)
(write-region "" nil output-file nil nil nil 'excl)
(set-file-modes input-file #o400)
(set-file-modes output-file #o200)
(set-file-modes directory #o500)
(with-temp-buffer
(let ((status (call-process
bwrap nil t nil
"--ro-bind" "/" "/"
"--bind" unquoted-file unquoted-file
emacs "--quick" "--batch" "--load=bytecomp"
(format "--eval=%S"
`(setq byte-compile-dest-file-function
(lambda (_) ,output-file)
byte-compile-error-on-warn t))
"--funcall=batch-byte-compile" input-file)))
(unless (eql status 0)
(ert-fail `((status . ,status)
(output . ,(buffer-string)))))))
(should (file-regular-p output-file))
(should (cl-plusp (file-attribute-size
(file-attributes output-file))))))))
(ert-deftest bytecomp-tests--target-file-no-directory ()
"Check that Bug#45287 is fixed."
(let ((directory (make-temp-file "bytecomp-tests-" :directory)))
(unwind-protect
(let* ((default-directory directory)
(byte-compile-dest-file-function (lambda (_) "test.elc"))
(byte-compile-error-on-warn t))
(write-region "" nil "test.el" nil nil nil 'excl)
(should (byte-compile-file "test.el"))
(should (file-regular-p "test.elc"))
(should (cl-plusp (file-attribute-size
(file-attributes "test.elc")))))
(with-demoted-errors "Error cleaning up directory: %s"
(delete-directory directory :recursive)))))
(ert-with-temp-directory directory
(let* ((default-directory directory)
(byte-compile-dest-file-function (lambda (_) "test.elc"))
(byte-compile-error-on-warn t))
(write-region "" nil "test.el" nil nil nil 'excl)
(should (byte-compile-file "test.el"))
(should (file-regular-p "test.elc"))
(should (cl-plusp (file-attribute-size
(file-attributes "test.elc")))))))
(defun bytecomp-tests--get-vars ()
(list (ignore-errors (symbol-value 'bytecomp-tests--var1))

19
test/lisp/emacs-lisp/gv-tests.el
View file

@ -21,22 +21,21 @@
(require 'edebug)
(require 'ert)
(require 'ert-x)
(eval-when-compile (require 'cl-lib))
(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar)
(&rest filebody)
&rest body)
(declare (indent 2))
`(let ((default-directory (make-temp-file "gv-test" t)))
(unwind-protect
(let ((,elvar "gv-test-deffoo.el")
(,elcvar "gv-test-deffoo.elc"))
(with-temp-file ,elvar
(insert ";; -*- lexical-binding: t; -*-\n")
(dolist (form ',filebody)
(pp form (current-buffer))))
,@body)
(delete-directory default-directory t))))
`(ert-with-temp-directory default-directory
(let ((,elvar "gv-test-deffoo.el")
(,elcvar "gv-test-deffoo.elc"))
(with-temp-file ,elvar
(insert ";; -*- lexical-binding: t; -*-\n")
(dolist (form ',filebody)
(pp form (current-buffer))))
,@body)))
(ert-deftest gv-define-expander-in-file ()
(gv-tests--in-temp-dir (el elc)

32
test/lisp/eshell/eshell-tests.el
View file

@ -26,23 +26,23 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'esh-mode)
(require 'eshell)
(defmacro with-temp-eshell (&rest body)
"Evaluate BODY in a temporary Eshell buffer."
`(let* ((eshell-directory-name (make-temp-file "eshell" t))
;; We want no history file, so prevent Eshell from falling
;; back on $HISTFILE.
(process-environment (cons "HISTFILE" process-environment))
(eshell-history-file-name nil)
(eshell-buffer (eshell t)))
(unwind-protect
(with-current-buffer eshell-buffer
,@body)
(let (kill-buffer-query-functions)
(kill-buffer eshell-buffer)
(delete-directory eshell-directory-name t)))))
`(ert-with-temp-directory eshell-directory-name
(let* (;; We want no history file, so prevent Eshell from falling
;; back on $HISTFILE.
(process-environment (cons "HISTFILE" process-environment))
(eshell-history-file-name nil)
(eshell-buffer (eshell t)))
(unwind-protect
(with-current-buffer eshell-buffer
,@body)
(let (kill-buffer-query-functions)
(kill-buffer eshell-buffer))))))
(defun eshell-insert-command (text &optional func)
"Insert a command at the end of the buffer."
@ -65,11 +65,9 @@
(defun eshell-test-command-result (command)
"Like `eshell-command-result', but not using HOME."
(let ((eshell-directory-name (make-temp-file "eshell" t))
(eshell-history-file-name nil))
(unwind-protect
(eshell-command-result command)
(delete-directory eshell-directory-name t))))
(ert-with-temp-directory eshell-directory-name
(let ((eshell-history-file-name nil))
(eshell-command-result command))))
;;; Tests:

80
test/lisp/info-xref-tests.el
View file

@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'info-xref)
(defun info-xref-test-internal (body result)
@ -96,15 +97,17 @@ text.
(ert-deftest info-xref-test-makeinfo ()
"Test that info-xref can parse basic makeinfo output."
(skip-unless (executable-find "makeinfo"))
(let ((tempfile (make-temp-file "info-xref-test" nil ".texi"))
(tempfile2 (make-temp-file "info-xref-test2" nil ".texi"))
(errflag t))
(unwind-protect
(progn
;; tempfile contains xrefs to various things, including tempfile2.
(info-xref-test-write-file
tempfile
(concat "\
(ert-with-temp-file tempfile
:suffix ".texi"
(ert-with-temp-file tempfile2
:suffix ".texi"
(let ((errflag t))
(unwind-protect
(progn
;; tempfile contains xrefs to various things, including tempfile2.
(info-xref-test-write-file
tempfile
(concat "\
@xref{nodename,,,missing,Missing Manual}.
@xref{nodename,crossref,title,missing,Missing Manual}.
@ -114,35 +117,36 @@ text.
@xref{Chapter One,Something}.
"
(format "@xref{Chapter One,,,%s,Present Manual}.\n"
(file-name-sans-extension (file-name-nondirectory
tempfile2)))))
;; Something for tempfile to xref to.
(info-xref-test-write-file tempfile2 "")
(require 'info)
(save-window-excursion
(let ((Info-directory-list
(list
(or (file-name-directory tempfile) ".")))
Info-additional-directory-list)
(info-xref-check (format "%s.info" (file-name-sans-extension
tempfile))))
(should (equal (list info-xref-bad info-xref-good
info-xref-unavail)
'(0 1 2)))
(setq errflag nil)
;; If there was an error, we can leave this around.
(kill-buffer info-xref-output-buffer)))
;; Useful diagnostic in case of problems.
(if errflag
(with-temp-buffer
(call-process "makeinfo" nil t nil "--version")
(message "%s" (buffer-string))))
(mapc 'delete-file (list tempfile tempfile2
(format "%s.info" (file-name-sans-extension
tempfile))
(format "%s.info" (file-name-sans-extension
tempfile2)))))))
(format "@xref{Chapter One,,,%s,Present Manual}.\n"
(file-name-sans-extension (file-name-nondirectory
tempfile2)))))
;; Something for tempfile to xref to.
(info-xref-test-write-file tempfile2 "")
(require 'info)
(save-window-excursion
(let ((Info-directory-list
(list
(or (file-name-directory tempfile) ".")))
Info-additional-directory-list)
(info-xref-check (format "%s.info" (file-name-sans-extension
tempfile))))
(should (equal (list info-xref-bad info-xref-good
info-xref-unavail)
'(0 1 2)))
(setq errflag nil)
;; If there was an error, we can leave this around.
(kill-buffer info-xref-output-buffer)))
;; Useful diagnostic in case of problems.
(if errflag
(with-temp-buffer
(call-process "makeinfo" nil t nil "--version")
(message "%s" (buffer-string))))
(ignore-errors
(delete-file (format "%s.info" (file-name-sans-extension
tempfile))))
(ignore-errors
(delete-file (format "%s.info" (file-name-sans-extension
tempfile2)))))))))
(ert-deftest info-xref-test-emacs-manuals ()
"Test that all internal links in the Emacs manuals work."

790
test/lisp/vc/vc-tests.el
View file

@ -109,6 +109,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'vc)
(require 'log-edit)
@ -178,41 +179,38 @@ For backends which dont support it, it is emulated."
(defun vc-test--create-repo (backend)
"Create a test repository in `default-directory', a temporary directory."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--create-repo" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Check the revision granularity.
(should (memq (vc-test--revision-granularity-function backend)
'(file repository)))
;; Check the revision granularity.
(should (memq (vc-test--revision-granularity-function backend)
'(file repository)))
;; Create empty repository.
(make-directory default-directory)
(should (file-directory-p default-directory))
(vc-test--create-repo-function backend)
(should (eq (vc-responsible-backend default-directory) backend)))
;; Create empty repository.
(make-directory default-directory)
(should (file-directory-p default-directory))
(vc-test--create-repo-function backend)
(should (eq (vc-responsible-backend default-directory) backend)))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
;; FIXME: Why isn't there `vc-unregister'?
(defun vc-test--unregister-function (backend file)
@ -235,447 +233,429 @@ Catch the `vc-not-supported' error."
(defun vc-test--register (backend)
"Register and unregister a file.
This checks also `vc-backend' and `vc-responsible-backend'."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--register" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; For file oriented backends CVS, RCS and SVN the backend is
;; returned, and the directory is registered already.
(should (if (vc-backend default-directory)
(vc-registered default-directory)
(not (vc-registered default-directory))))
(should (eq (vc-responsible-backend default-directory) backend))
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; For file oriented backends CVS, RCS and SVN the backend is
;; returned, and the directory is registered already.
(should (if (vc-backend default-directory)
(vc-registered default-directory)
(not (vc-registered default-directory))))
(should (eq (vc-responsible-backend default-directory) backend))
(let ((tmp-name1 (expand-file-name "foo" default-directory))
(tmp-name2 "bla"))
;; Register files. Check for it.
(write-region "foo" nil tmp-name1 nil 'nomessage)
(should (file-exists-p tmp-name1))
(should-not (vc-backend tmp-name1))
(should (eq (vc-responsible-backend tmp-name1) backend))
(should-not (vc-registered tmp-name1))
(write-region "bla" nil tmp-name2 nil 'nomessage)
(should (file-exists-p tmp-name2))
(should-not (vc-backend tmp-name2))
(should (eq (vc-responsible-backend tmp-name2) backend))
(should-not (vc-registered tmp-name2))
(vc-register (list backend (list tmp-name1 tmp-name2)))
(should (file-exists-p tmp-name1))
(should (eq (vc-backend tmp-name1) backend))
(should (eq (vc-responsible-backend tmp-name1) backend))
(should (vc-registered tmp-name1))
(should (file-exists-p tmp-name2))
(should (eq (vc-backend tmp-name2) backend))
(should (eq (vc-responsible-backend tmp-name2) backend))
(should (vc-registered tmp-name2))
;; `vc-backend' accepts also a list of files,
;; `vc-responsible-backend' doesn't.
(should (vc-backend (list tmp-name1 tmp-name2)))
;; Unregister the files.
(unless (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name1)
'vc-not-supported)
(let ((tmp-name1 (expand-file-name "foo" default-directory))
(tmp-name2 "bla"))
;; Register files. Check for it.
(write-region "foo" nil tmp-name1 nil 'nomessage)
(should (file-exists-p tmp-name1))
(should-not (vc-backend tmp-name1))
(should-not (vc-registered tmp-name1)))
(unless (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name2)
'vc-not-supported)
(should (eq (vc-responsible-backend tmp-name1) backend))
(should-not (vc-registered tmp-name1))
(write-region "bla" nil tmp-name2 nil 'nomessage)
(should (file-exists-p tmp-name2))
(should-not (vc-backend tmp-name2))
(should-not (vc-registered tmp-name2)))
(should (eq (vc-responsible-backend tmp-name2) backend))
(should-not (vc-registered tmp-name2))
;; The files should still exist.
(should (file-exists-p tmp-name1))
(should (file-exists-p tmp-name2))))
(vc-register (list backend (list tmp-name1 tmp-name2)))
(should (file-exists-p tmp-name1))
(should (eq (vc-backend tmp-name1) backend))
(should (eq (vc-responsible-backend tmp-name1) backend))
(should (vc-registered tmp-name1))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
(should (file-exists-p tmp-name2))
(should (eq (vc-backend tmp-name2) backend))
(should (eq (vc-responsible-backend tmp-name2) backend))
(should (vc-registered tmp-name2))
;; `vc-backend' accepts also a list of files,
;; `vc-responsible-backend' doesn't.
(should (vc-backend (list tmp-name1 tmp-name2)))
;; Unregister the files.
(unless (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name1)
'vc-not-supported)
(should-not (vc-backend tmp-name1))
(should-not (vc-registered tmp-name1)))
(unless (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name2)
'vc-not-supported)
(should-not (vc-backend tmp-name2))
(should-not (vc-registered tmp-name2)))
;; The files should still exist.
(should (file-exists-p tmp-name1))
(should (file-exists-p tmp-name2))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--state (backend)
"Check the different states of a file."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--state" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check state of a nonexistent file.
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check state of a nonexistent file.
(message "vc-state2 %s" (vc-state tmp-name))
(should (null (vc-state tmp-name)))
(message "vc-state2 %s" (vc-state tmp-name))
(should (null (vc-state tmp-name)))
;; Write a new file. Check state.
(write-region "foo" nil tmp-name nil 'nomessage)
;; Write a new file. Check state.
(write-region "foo" nil tmp-name nil 'nomessage)
;; nil: Mtn
;; unregistered: Bzr CVS Git Hg SVN RCS
(message "vc-state3 %s %s" backend (vc-state tmp-name backend))
(should (memq (vc-state tmp-name backend) '(nil unregistered)))
;; nil: Mtn
;; unregistered: Bzr CVS Git Hg SVN RCS
(message "vc-state3 %s %s" backend (vc-state tmp-name backend))
(should (memq (vc-state tmp-name backend) '(nil unregistered)))
;; Register a file. Check state.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; Register a file. Check state.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; FIXME: nil is definitely wrong.
;; nil: SRC
;; added: Bzr CVS Git Hg Mtn SVN
;; up-to-date: RCS SCCS
(message "vc-state4 %s" (vc-state tmp-name))
(should (memq (vc-state tmp-name) '(nil added up-to-date)))
;; FIXME: nil is definitely wrong.
;; nil: SRC
;; added: Bzr CVS Git Hg Mtn SVN
;; up-to-date: RCS SCCS
(message "vc-state4 %s" (vc-state tmp-name))
(should (memq (vc-state tmp-name) '(nil added up-to-date)))
;; Unregister the file. Check state.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-state5 unsupported")
;; unregistered: Bzr Git RCS Hg
;; unsupported: CVS Mtn SCCS SRC SVN
(message "vc-state5 %s %s" backend (vc-state tmp-name backend))
(should (memq (vc-state tmp-name backend)
'(nil unregistered))))))
;; Unregister the file. Check state.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-state5 unsupported")
;; unregistered: Bzr Git RCS Hg
;; unsupported: CVS Mtn SCCS SRC SVN
(message "vc-state5 %s %s" backend (vc-state tmp-name backend))
(should (memq (vc-state tmp-name backend)
'(nil unregistered))))))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--working-revision (backend)
"Check the working revision of a repository."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--working-revision" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository. Check working revision of
;; repository, should be nil.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Create empty repository. Check working revision of
;; repository, should be nil.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; FIXME: Is the value for SVN correct?
;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC
;; "0": SVN
(message
"vc-working-revision1 %s" (vc-working-revision default-directory))
(should (member (vc-working-revision default-directory) '(nil "0")))
;; FIXME: Is the value for SVN correct?
;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC
;; "0": SVN
(message
"vc-working-revision1 %s" (vc-working-revision default-directory))
(should (member (vc-working-revision default-directory) '(nil "0")))
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check initial working revision, should be nil until
;; it's registered.
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check initial working revision, should be nil until
;; it's registered.
(message "vc-working-revision2 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name))
(message "vc-working-revision2 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name))
;; Write a new file. Check working revision.
(write-region "foo" nil tmp-name nil 'nomessage)
;; Write a new file. Check working revision.
(write-region "foo" nil tmp-name nil 'nomessage)
(message "vc-working-revision3 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name))
(message "vc-working-revision3 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name))
;; Register a file. Check working revision.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; Register a file. Check working revision.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; XXX: nil is fine, at least in Git's case, because
;; `vc-register' only makes the file `added' in this case.
;; nil: Git Mtn
;; "0": Bzr CVS Hg SRC SVN
;; "1.1": RCS SCCS
;; "-1": Hg versions before 5 (probably)
(message "vc-working-revision4 %s" (vc-working-revision tmp-name))
(should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1")))
;; XXX: nil is fine, at least in Git's case, because
;; `vc-register' only makes the file `added' in this case.
;; nil: Git Mtn
;; "0": Bzr CVS Hg SRC SVN
;; "1.1": RCS SCCS
;; "-1": Hg versions before 5 (probably)
(message "vc-working-revision4 %s" (vc-working-revision tmp-name))
(should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1")))
;; TODO: Call `vc-checkin', and check the resulting
;; working revision. None of the return values should be
;; nil then.
;; TODO: Call `vc-checkin', and check the resulting
;; working revision. None of the return values should be
;; nil then.
;; Unregister the file. Check working revision.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-working-revision5 unsupported")
;; nil: Bzr Git Hg RCS
;; unsupported: CVS Mtn SCCS SRC SVN
(message "vc-working-revision5 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name)))))
;; Unregister the file. Check working revision.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-working-revision5 unsupported")
;; nil: Bzr Git Hg RCS
;; unsupported: CVS Mtn SCCS SRC SVN
(message "vc-working-revision5 %s" (vc-working-revision tmp-name))
(should-not (vc-working-revision tmp-name)))))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--checkout-model (backend)
"Check the checkout model of a repository."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--checkout-model" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Surprisingly, none of the backends returns 'announce.
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model1 %s"
(vc-checkout-model backend default-directory))
(should (memq (vc-checkout-model backend default-directory)
'(announce implicit locking)))
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check checkout model of a nonexistent file.
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
;; Surprisingly, none of the backends returns 'announce.
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model2 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking)))
"vc-checkout-model1 %s"
(vc-checkout-model backend default-directory))
(should (memq (vc-checkout-model backend default-directory)
'(announce implicit locking)))
;; Write a new file. Check checkout model.
(write-region "foo" nil tmp-name nil 'nomessage)
(let ((tmp-name (expand-file-name "foo" default-directory)))
;; Check checkout model of a nonexistent file.
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model3 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking)))
;; Register a file. Check checkout model.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model4 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking)))
;; Unregister the file. Check checkout model.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-checkout-model5 unsupported")
;; implicit: Bzr Git Hg
;; locking: RCS
;; unsupported: CVS Mtn SCCS SRC SVN
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model5 %s" (vc-checkout-model backend tmp-name))
"vc-checkout-model2 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking))))))
'(announce implicit locking)))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Write a new file. Check checkout model.
(write-region "foo" nil tmp-name nil 'nomessage)
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model3 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking)))
;; Register a file. Check checkout model.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; implicit: Bzr CVS Git Hg Mtn SRC SVN
;; locking: RCS SCCS
(message
"vc-checkout-model4 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking)))
;; Unregister the file. Check checkout model.
(if (eq (vc-test--run-maybe-unsupported-function
'vc-test--unregister-function backend tmp-name)
'vc-not-supported)
(message "vc-checkout-model5 unsupported")
;; implicit: Bzr Git Hg
;; locking: RCS
;; unsupported: CVS Mtn SCCS SRC SVN
(message
"vc-checkout-model5 %s" (vc-checkout-model backend tmp-name))
(should (memq (vc-checkout-model backend tmp-name)
'(announce implicit locking))))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--rename-file (backend)
"Check the rename-file action."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--rename-file" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Create empty repository.
(make-directory default-directory)
(vc-test--create-repo-function backend)
(let ((tmp-name (expand-file-name "foo" default-directory))
(new-name (expand-file-name "bar" default-directory)))
;; Write a new file.
(write-region "foo" nil tmp-name nil 'nomessage)
(let ((tmp-name (expand-file-name "foo" default-directory))
(new-name (expand-file-name "bar" default-directory)))
;; Write a new file.
(write-region "foo" nil tmp-name nil 'nomessage)
;; Register it. Renaming can fail otherwise.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
;; Register it. Renaming can fail otherwise.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
(vc-rename-file tmp-name new-name)
(vc-rename-file tmp-name new-name)
(should (not (file-exists-p tmp-name)))
(should (file-exists-p new-name))
(should (not (file-exists-p tmp-name)))
(should (file-exists-p new-name))
(should (equal (vc-state new-name)
(if (memq backend '(RCS SCCS))
'up-to-date
'added)))))
(should (equal (vc-state new-name)
(if (memq backend '(RCS SCCS))
'up-to-date
'added)))))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
(declare-function log-edit-done "vc/log-edit")
(defun vc-test--version-diff (backend)
"Check the diff version of a repository."
(ert-with-temp-directory tempdir
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
;; git tries various approaches to guess a user name and email,
;; which can fail depending on how the system is configured.
;; Eg if the user account has no GECOS, git commit can fail with
;; status 128 "fatal: empty ident name".
(when (memq backend '(Bzr Git))
(setq process-environment (cons "EMAIL=john@doe.ee"
process-environment)))
(if (eq backend 'Git)
(setq process-environment (append '("GIT_AUTHOR_NAME=A"
"GIT_COMMITTER_NAME=C")
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
(let ((vc-handled-backends `(,backend))
(default-directory
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
(process-environment process-environment)
tempdir
vc-test--cleanup-hook)
(when (eq backend 'Bzr)
(setq tempdir (make-temp-file "vc-test--version-diff" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
;; git tries various approaches to guess a user name and email,
;; which can fail depending on how the system is configured.
;; Eg if the user account has no GECOS, git commit can fail with
;; status 128 "fatal: empty ident name".
(when (memq backend '(Bzr Git))
(setq process-environment (cons "EMAIL=john@doe.ee"
process-environment)))
(if (eq backend 'Git)
(setq process-environment (append '("GIT_AUTHOR_NAME=A"
"GIT_COMMITTER_NAME=C")
process-environment)))
(unwind-protect
(progn
;; Cleanup.
(add-hook
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
(vc-test--create-repo-function backend)
;; Create empty repository. Check repository checkout model.
(make-directory default-directory)
(vc-test--create-repo-function backend)
(let* ((tmp-name (expand-file-name "foo" default-directory))
(files (list (file-name-nondirectory tmp-name))))
;; Write and register a new file.
(write-region "originaltext" nil tmp-name nil 'nomessage)
(vc-register (list backend files))
(let* ((tmp-name (expand-file-name "foo" default-directory))
(files (list (file-name-nondirectory tmp-name))))
;; Write and register a new file.
(write-region "originaltext" nil tmp-name nil 'nomessage)
(vc-register (list backend files))
(let ((buff (find-file tmp-name)))
(with-current-buffer buff
(progn
;; Optionally checkout file.
(when (memq backend '(RCS CVS SCCS))
(vc-checkout tmp-name))
(let ((buff (find-file tmp-name)))
(with-current-buffer buff
;; Checkin file.
(vc-checkin files backend)
(insert "Testing vc-version-diff")
(log-edit-done))))
;; Modify file content.
(when (memq backend '(RCS CVS SCCS))
(vc-checkout tmp-name))
(write-region "updatedtext" nil tmp-name nil 'nomessage)
;; Check version diff.
(vc-version-diff files nil nil)
(should (bufferp (get-buffer "*vc-diff*")))
(with-current-buffer "*vc-diff*"
(progn
;; Optionally checkout file.
(when (memq backend '(RCS CVS SCCS))
(vc-checkout tmp-name))
(let ((rawtext (buffer-substring-no-properties (point-min)
(point-max))))
(should (string-search "-originaltext" rawtext))
(should (string-search "+updatedtext" rawtext)))))))
;; Checkin file.
(vc-checkin files backend)
(insert "Testing vc-version-diff")
(log-edit-done))))
;; Modify file content.
(when (memq backend '(RCS CVS SCCS))
(vc-checkout tmp-name))
(write-region "updatedtext" nil tmp-name nil 'nomessage)
;; Check version diff.
(vc-version-diff files nil nil)
(should (bufferp (get-buffer "*vc-diff*")))
(with-current-buffer "*vc-diff*"
(progn
(let ((rawtext (buffer-substring-no-properties (point-min)
(point-max))))
(should (string-search "-originaltext" rawtext))
(should (string-search "+updatedtext" rawtext)))))))
;; Save exit.
(ignore-errors
(if tempdir (delete-directory tempdir t))
(run-hooks 'vc-test--cleanup-hook)))))
;; Save exit.
(ignore-errors
(run-hooks 'vc-test--cleanup-hook))))))
;; Create the test cases.

79
test/src/buffer-tests.el
View file

@ -1442,45 +1442,44 @@ with parameters from the *Messages* buffer modification."
(ignore-errors (delete-file auto-save))))))))
(ert-deftest test-kill-buffer-auto-save-delete ()
(let ((file (make-temp-file "ert"))
auto-save)
(should (file-exists-p file))
(setq kill-buffer-delete-auto-save-files t)
;; Always answer yes.
(cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
(unwind-protect
(progn
(find-file file)
(auto-save-mode t)
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
(do-auto-save)
(should (file-exists-p auto-save))
;; This should delete the auto-save file.
(kill-buffer (current-buffer))
(should-not (file-exists-p auto-save)))
(ignore-errors (delete-file file))
(when auto-save
(ignore-errors (delete-file auto-save)))))
;; Answer no to deletion.
(cl-letf (((symbol-function #'yes-or-no-p)
(lambda (prompt)
(not (string-search "Delete auto-save file" prompt)))))
(unwind-protect
(progn
(find-file file)
(auto-save-mode t)
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
(do-auto-save)
(should (file-exists-p auto-save))
;; This should not delete the auto-save file.
(kill-buffer (current-buffer))
(should (file-exists-p auto-save)))
(ignore-errors (delete-file file))
(when auto-save
(ignore-errors (delete-file auto-save)))))))
(ert-with-temp-file file
(let (auto-save)
(should (file-exists-p file))
(setq kill-buffer-delete-auto-save-files t)
;; Always answer yes.
(cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
(unwind-protect
(progn
(find-file file)
(auto-save-mode t)
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
(do-auto-save)
(should (file-exists-p auto-save))
;; This should delete the auto-save file.
(kill-buffer (current-buffer))
(should-not (file-exists-p auto-save)))
(ignore-errors (delete-file file))
(when auto-save
(ignore-errors (delete-file auto-save)))))
;; Answer no to deletion.
(cl-letf (((symbol-function #'yes-or-no-p)
(lambda (prompt)
(not (string-search "Delete auto-save file" prompt)))))
(unwind-protect
(progn
(find-file file)
(auto-save-mode t)
(insert "foo\n")
(should buffer-auto-save-file-name)
(setq auto-save buffer-auto-save-file-name)
(do-auto-save)
(should (file-exists-p auto-save))
;; This should not delete the auto-save file.
(kill-buffer (current-buffer))
(should (file-exists-p auto-save)))
(when auto-save
(ignore-errors (delete-file auto-save))))))))
;;; buffer-tests.el ends here

48
test/src/comp-tests.el
View file

@ -53,30 +53,32 @@
"Compile the compiler and load it to compile it-self.
Check that the resulting binaries do not differ."
:tags '(:expensive-test :nativecomp)
(let* ((byte+native-compile t) ; FIXME HACK
(comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el"
(ert-with-temp-file comp1-src
:suffix "-comp-stage1.el"
(ert-with-temp-file comp2-src
:suffix "-comp-stage2.el"
(let* ((byte+native-compile t) ; FIXME HACK
(comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el"
(ert-resource-directory)))
(comp1-src (make-temp-file "stage1-" nil ".el"))
(comp2-src (make-temp-file "stage2-" nil ".el"))
;; Can't use debug symbols.
(native-comp-debug 0))
(copy-file comp-src comp1-src t)
(copy-file comp-src comp2-src t)
(let ((load-no-native t))
(load (concat comp-src "c") nil nil t t))
(should-not (subr-native-elisp-p (symbol-function #'native-compile)))
(message "Compiling stage1...")
(let* ((t0 (current-time))
(comp1-eln (native-compile comp1-src)))
(message "Done in %d secs" (float-time (time-since t0)))
(load comp1-eln nil nil t t)
(should (subr-native-elisp-p (symbol-function 'native-compile)))
(message "Compiling stage2...")
(let ((t0 (current-time))
(comp2-eln (native-compile comp2-src)))
(message "Done in %d secs" (float-time (time-since t0)))
(message "Comparing %s %s" comp1-eln comp2-eln)
(should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0))))))
;; Can't use debug symbols.
(native-comp-debug 0))
(copy-file comp-src comp1-src t)
(copy-file comp-src comp2-src t)
(let ((load-no-native t))
(load (concat comp-src "c") nil nil t t))
(should-not (subr-native-elisp-p (symbol-function #'native-compile)))
(message "Compiling stage1...")
(let* ((t0 (current-time))
(comp1-eln (native-compile comp1-src)))
(message "Done in %d secs" (float-time (time-since t0)))
(load comp1-eln nil nil t t)
(should (subr-native-elisp-p (symbol-function 'native-compile)))
(message "Compiling stage2...")
(let ((t0 (current-time))
(comp2-eln (native-compile comp2-src)))
(message "Done in %d secs" (float-time (time-since t0)))
(message "Comparing %s %s" comp1-eln comp2-eln)
(should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0))))))))
(comp-deftest provide ()
"Testing top level provide."

3
test/src/inotify-tests.el
View file

@ -38,8 +38,7 @@
;; (ert-deftest filewatch-file-watch-aspects-check ()
;; "Test whether `file-watch' properly checks the aspects."
;; (let ((temp-file (make-temp-file "filewatch-aspects")))
;; (should (stringp temp-file))
;; (ert-with-temp-file temp-file
;; (should-error (file-watch temp-file 'wrong nil)
;; :type 'error)
;; (should-error (file-watch temp-file '(modify t) nil)

34
test/src/process-tests.el
View file

@ -65,24 +65,22 @@
(when (eq system-type 'windows-nt)
(ert-deftest process-test-quoted-batfile ()
"Check that Emacs hides CreateProcess deficiency (bug#18745)."
(let (batfile)
(unwind-protect
(progn
;; CreateProcess will fail when both the bat file and 1st
;; argument are quoted, so include spaces in both of those
;; to force quoting.
(setq batfile (make-temp-file "echo args" nil ".bat"))
(with-temp-file batfile
(insert "@echo arg1=%1, arg2=%2\n"))
(with-temp-buffer
(call-process batfile nil '(t t) t "x &y")
(should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
(with-temp-buffer
(call-process-shell-command
(mapconcat #'shell-quote-argument (list batfile "x &y") " ")
nil '(t t) t)
(should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))
(when batfile (delete-file batfile))))))
(ert-with-temp-file batfile
;; CreateProcess will fail when both the bat file and 1st
;; argument are quoted, so include spaces in both of those
;; to force quoting.
:prefix "echo args"
:suffix ".bat"
(with-temp-file batfile
(insert "@echo arg1=%1, arg2=%2\n"))
(with-temp-buffer
(call-process batfile nil '(t t) t "x &y")
(should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
(with-temp-buffer
(call-process-shell-command
(mapconcat #'shell-quote-argument (list batfile "x &y") " ")
nil '(t t) t)
(should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))))
(ert-deftest process-test-stderr-buffer ()
(skip-unless (executable-find "bash"))