[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master cdd7589: Prefer ert-with-temp-(directory|file) in most remaining
|
From: |
Stefan Kangas |
|
Subject: |
master cdd7589: Prefer ert-with-temp-(directory|file) in most remaining tests |
|
Date: |
Sun, 7 Nov 2021 19:33:50 -0500 (EST) |
branch: master
commit cdd7589330466523f3f069d13f355c18a872f259
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>
Prefer ert-with-temp-(directory|file) in most remaining tests
* 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.
---
test/lisp/auth-source-tests.el | 49 +-
test/lisp/autorevert-tests.el | 835 ++++++++++++++++---------------
test/lisp/calendar/icalendar-tests.el | 56 +--
test/lisp/custom-tests.el | 22 +-
test/lisp/dired-aux-tests.el | 59 +--
test/lisp/emacs-lisp/bytecomp-tests.el | 152 +++---
test/lisp/emacs-lisp/gv-tests.el | 19 +-
test/lisp/eshell/eshell-tests.el | 32 +-
test/lisp/info-xref-tests.el | 80 +--
test/lisp/vc/vc-tests.el | 876 ++++++++++++++++-----------------
test/src/buffer-tests.el | 79 ++-
test/src/comp-tests.el | 48 +-
test/src/inotify-tests.el | 3 +-
test/src/process-tests.el | 34 +-
14 files changed, 1145 insertions(+), 1199 deletions(-)
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 0d2143f..34c68b4 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -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")
- ))
-
- (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))))))
-
- (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)))
+ )))
+ (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)
+
+ (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)))))))))
(ert-deftest auth-source-test-secrets-create-secret ()
(skip-unless secrets-enabled)
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 7dce398..b9d4532 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -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)
-
- (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)))
-
- ;; 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)))))
-
- ;; Exit.
- (ignore-errors
- (with-current-buffer buf (set-buffer-modified-p nil))
- (kill-buffer buf))
- (ignore-errors (delete-file tmpfile))))))
+ (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))
+
+ ;; 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))
+
+ ;; 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)))))))
(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))
-
- (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)))
-
- ;; 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))))))
+ (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)))
+
+ ;; 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))))))
+
+ ;; 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)
-
- ;; 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)))
-
- ;; 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)))))
-
- ;; Exit.
- (ignore-errors
- (with-current-buffer buf (set-buffer-modified-p nil))
- (kill-buffer buf))
- (ignore-errors (delete-file tmpfile))))))
+ (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)
+
+ (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)))
+
+ ;; 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)))))))
(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)
-
- ;; 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)))))
-
- ;; Exit.
- (ignore-errors (kill-buffer buf))
- (ignore-errors (delete-file tmpfile)))))
+ (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)
+
+ ;; 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))))))
(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-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))
-
- (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))))))
+ (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
+ ;; 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))))))
+
+ ;; 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) ""))
-
- (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))
-
- ;; 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"))
-
- ;; 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"))
-
- ;; 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)))))))
+ (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.
+
+ (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"))
+
+ ;; 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"))
+
+ ;; 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)))
+
+ ;; 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)
-
- (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)))
-
- (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)))
-
- ;; 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)))
-
- (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)))));)
+ (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))
+
+ (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")))))
+
+ ;; 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))
+
+ (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")))))
+
+ ;; 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.")
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 264da3c..9e8a8e7 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -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))))
-
- (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))
-
- ;; 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))))
+ (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)
+
+ ;; 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))))))))
(ert-deftest icalendar-cycle ()
"Perform cycling tests.
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 6ebf2d5..769db6c 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -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)))))
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 88a2c9f..374164f 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -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 ."
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index cc6455b..5aadd67 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -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))
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index b9850ec..6ee274a 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -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)
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index a460f45..0974784 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -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:
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 0b8091f..9379a53 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -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."
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index aa401a2..578d7eb 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -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."
-
- (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)))
-
- ;; 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)))
-
- ;; Save exit.
- (ignore-errors
- (if tempdir (delete-directory tempdir t))
- (run-hooks 'vc-test--cleanup-hook)))))
+ (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)))
+
+ ;; 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)))
+
+ ;; 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'."
-
- (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))
-
- (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)
+ (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)))
+
+ ;; 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-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)))
+ (should (eq (vc-responsible-backend tmp-name1) backend))
+ (should-not (vc-registered tmp-name1))
- ;; The files should still exist.
- (should (file-exists-p tmp-name1))
- (should (file-exists-p tmp-name2))))
-
- ;; Save exit.
- (ignore-errors
- (if tempdir (delete-directory tempdir t))
- (run-hooks 'vc-test--cleanup-hook)))))
+ (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)
+ (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."
-
- (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)
-
- (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)))
-
- ;; 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)))
-
- ;; 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)))
-
- ;; 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)))))
+ (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)))
+
+ ;; 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.
+
+ (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)
+
+ ;; 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))))
+
+ ;; 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))))))
+
+ ;; Save exit.
+ (ignore-errors
+ (run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--working-revision (backend)
"Check the working revision of a repository."
-
- (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)))
-
- ;; 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")))
-
- (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))
-
- ;; 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))
-
- ;; 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")))
-
- ;; 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)))))
-
- ;; Save exit.
- (ignore-errors
- (if tempdir (delete-directory tempdir t))
- (run-hooks 'vc-test--cleanup-hook)))))
+ (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)))
+
+ ;; 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")))
+
+ (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))
+
+ ;; 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))
+
+ ;; 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")))
+
+ ;; 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)))))
+
+ ;; Save exit.
+ (ignore-errors
+ (run-hooks 'vc-test--cleanup-hook))))))
(defun vc-test--checkout-model (backend)
"Check the checkout model of a repository."
-
- (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)))
-
- ;; 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
+ (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)))
+
+ ;; 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-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)))
+ ;; 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)))
- ;; Register a file. Check checkout model.
- (vc-register
- (list backend (list (file-name-nondirectory tmp-name))))
+ ;; 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-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-model3 %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)))))
+ ;; 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."
-
- (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)))
-
- ;; 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)
-
- ;; Register it. Renaming can fail otherwise.
- (vc-register
- (list backend (list (file-name-nondirectory tmp-name))))
-
- (vc-rename-file tmp-name 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)))))
-
- ;; Save exit.
- (ignore-errors
- (if tempdir (delete-directory tempdir t))
- (run-hooks 'vc-test--cleanup-hook)))))
+ (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)))
+
+ ;; 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)
+
+ ;; Register it. Renaming can fail otherwise.
+ (vc-register
+ (list backend (list (file-name-nondirectory tmp-name))))
+
+ (vc-rename-file tmp-name 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)))))
+
+ ;; 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."
-
- (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)
-
- (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
+ (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)))
+
+ ;; 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 ((buff (find-file tmp-name)))
+ (with-current-buffer buff
+ (progn
+ ;; Optionally checkout file.
+ (when (memq backend '(RCS CVS SCCS))
+ (vc-checkout tmp-name))
+
+ ;; 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))
-
- ;; 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)))))
+ (let ((rawtext (buffer-substring-no-properties (point-min)
+ (point-max))))
+ (should (string-search "-originaltext" rawtext))
+ (should (string-search "+updatedtext" rawtext)))))))
+
+ ;; Save exit.
+ (ignore-errors
+ (run-hooks 'vc-test--cleanup-hook))))))
;; Create the test cases.
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index ac213d1..7943ac2 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -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
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index ecf62a4..025bc20 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -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."
diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el
index c341af5..70330ac 100644
--- a/test/src/inotify-tests.el
+++ b/test/src/inotify-tests.el
@@ -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)
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 785194b..b831ca3 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -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"))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master cdd7589: Prefer ert-with-temp-(directory|file) in most remaining tests,
Stefan Kangas <=