Prefer ert-with-temp-(directory|file)

* test/lisp/abbrev-tests.el (read-write-abbrev-file-test)
(read-write-abbrev-file-test-with-props)
(abbrev-edit-save-to-file-test):
* test/lisp/auth-source-tests.el (auth-source-test-netrc-create-secret)
(auth-source-delete):
* test/lisp/autoinsert-tests.el (autoinsert-tests-auto-insert-file):
* test/lisp/bookmark-tests.el (with-bookmark-test-save-load):
* test/lisp/buff-menu-tests.el (buff-menu-24962):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-export):
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
* test/lisp/dired-tests.el
(dired-test-bug27243-01, dired-test-bug27243-02)
(dired-test-bug27243-03, dired-test-bug27631)
(dired-test-bug27968, dired-test-with-temp-dirs):
* test/lisp/dired-x-tests.el (dired-test-bug25942):
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
* test/lisp/emacs-lisp/check-declare-tests.el (check-declare-tests-scan)
(check-declare-tests-verify-mismatch):
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env):
* test/lisp/emacs-lisp/package-tests.el (with-package-test)
(package-test-signed):
* test/lisp/emacs-lisp/testcover-tests.el (testcover-tests-markup-region)
(testcover-tests-run-test-case):
* test/lisp/emulation/viper-tests.el (viper-test-undo-kmacro):
* test/lisp/epg-tests.el (with-epg-tests):
* test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history):
* test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631):
* test/lisp/ffap-tests.el (ffap-tests-25243):
* test/lisp/files-tests.el (files-tests-bug-18141)
(files-tests-read-file-in-~, files-tests-make-directory)
(files-tests-copy-directory, files-tests-executable-find)
(files-tests-dont-rewrite-precious-files)
(files-tests--save-some-buffers):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27631):
* test/lisp/mail/uudecode-tests.el (uudecode-tests-decode-region-internal)
(uudecode-tests-decode-region-external):
* test/lisp/net/browse-url-tests.el (browse-url-tests-delete-temp-file):
* test/lisp/progmodes/elisp-mode-tests.el (xref--case-insensitive):
* test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list):
* test/lisp/progmodes/flymake-tests.el (ruby-backend):
* test/lisp/progmodes/python-tests.el (python-tests-with-temp-file):
* test/lisp/progmodes/sql-tests.el (with-sql-test-connect-harness):
* test/lisp/saveplace-tests.el (saveplace-test-save-place-to-alist/file)
(saveplace-test-forget-unreadable-files)
(saveplace-test-place-alist-to-file):
* test/lisp/so-long-tests/spelling-tests.el:
* test/lisp/textmodes/reftex-tests.el (reftex-locate-bibliography-files)
(reftex-parse-from-file-test):
* test/lisp/thumbs-tests.el (thumbs-tests-thumbsdir/create-if-missing):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
(vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
* test/lisp/vc/diff-mode-tests.el (diff-mode-test-ignore-trailing-dashes):
* test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-bug32173-02, wdired-test-symlink-name)
(wdired-test-unfinished-edit-01, wdired-test-bug34915)
(wdired-test-bug39280):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-default):
* test/src/filelock-tests.el (filelock-tests--fixture):
* test/src/inotify-tests.el (inotify-file-watch-simple):
* test/src/undo-tests.el (undo-test-file-modified): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
In some cases, this is just cleanup, but in several cases this fixes
bugs where an error would have lead to us not cleaning up.
This commit is contained in:
Stefan Kangas 2021-11-06 23:20:59 +01:00
parent 5dd27fef58
commit 385741fae2
41 changed files with 1314 additions and 1398 deletions

View file

@ -28,6 +28,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'abbrev)
(require 'seq)
@ -236,44 +237,41 @@
(ert-deftest read-write-abbrev-file-test ()
"Test reading and writing abbrevs from file."
(let ((temp-test-file (make-temp-file "ert-abbrev-test"))
(ert-test-abbrevs (setup-test-abbrev-table)))
(write-abbrev-file temp-test-file)
(clear-abbrev-table ert-test-abbrevs)
(should (abbrev-table-empty-p ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs)))
(delete-file temp-test-file)))
(ert-with-temp-file temp-test-file
(let ((ert-test-abbrevs (setup-test-abbrev-table)))
(write-abbrev-file temp-test-file)
(clear-abbrev-table ert-test-abbrevs)
(should (abbrev-table-empty-p ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs))))))
(ert-deftest read-write-abbrev-file-test-with-props ()
"Test reading and writing abbrevs from file."
(let ((temp-test-file (make-temp-file "ert-abbrev-test"))
(ert-test-abbrevs (setup-test-abbrev-table-with-props)))
(write-abbrev-file temp-test-file)
(clear-abbrev-table ert-test-abbrevs)
(should (abbrev-table-empty-p ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "fooBar" (abbrev-expansion "fb" ert-test-abbrevs)))
(delete-file temp-test-file)))
(ert-with-temp-file temp-test-file
(let ((ert-test-abbrevs (setup-test-abbrev-table-with-props)))
(write-abbrev-file temp-test-file)
(clear-abbrev-table ert-test-abbrevs)
(should (abbrev-table-empty-p ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "fooBar" (abbrev-expansion "fb" ert-test-abbrevs))))))
(ert-deftest abbrev-edit-save-to-file-test ()
"Test saving abbrev definitions in buffer to file."
(defvar ert-save-test-table nil)
(let ((temp-test-file (make-temp-file "ert-abbrev-test"))
(ert-test-abbrevs (setup-test-abbrev-table)))
(with-temp-buffer
(goto-char (point-min))
(insert "(ert-save-test-table)\n")
(insert "\n" "\"s-a-t\"\t" "0\t" "\"save-abbrevs-test\"\n")
(should (equal "abbrev-ert-test"
(abbrev-expansion "a-e-t" ert-test-abbrevs)))
;; clears abbrev tables
(abbrev-edit-save-to-file temp-test-file)
(should-not (abbrev-expansion "a-e-t" ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "save-abbrevs-test"
(abbrev-expansion "s-a-t" ert-save-test-table)))
(delete-file temp-test-file))))
(ert-with-temp-file temp-test-file
(let ((ert-test-abbrevs (setup-test-abbrev-table)))
(with-temp-buffer
(goto-char (point-min))
(insert "(ert-save-test-table)\n")
(insert "\n" "\"s-a-t\"\t" "0\t" "\"save-abbrevs-test\"\n")
(should (equal "abbrev-ert-test"
(abbrev-expansion "a-e-t" ert-test-abbrevs)))
;; clears abbrev tables
(abbrev-edit-save-to-file temp-test-file)
(should-not (abbrev-expansion "a-e-t" ert-test-abbrevs))
(read-abbrev-file temp-test-file)
(should (equal "save-abbrevs-test"
(abbrev-expansion "s-a-t" ert-save-test-table)))))))
(ert-deftest inverse-add-abbrev-skips-trailing-nonword ()
"Test that adding an inverse abbrev skips trailing nonword characters."

View file

@ -27,6 +27,7 @@
;;; Code:
(require 'ert)
(eval-when-compile (require 'ert-x))
(require 'cl-lib)
(require 'auth-source)
(require 'secrets)
@ -360,77 +361,73 @@
(format "%s@%s" (plist-get auth-info :user) (plist-get auth-info :host))))))
(ert-deftest auth-source-test-netrc-create-secret ()
(let* ((netrc-file (make-temp-file "auth-source-test"))
(auth-sources (list netrc-file))
(auth-source-save-behavior t)
host auth-info auth-passwd)
(unwind-protect
(dolist (passwd '("foo" "" nil))
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
(lambda (_prompt &optional _initial _history default
_inherit-input-method)
default)))
(setq host
(md5 (concat (prin1-to-string process-environment) passwd))
auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(should (string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (equal auth-passwd passwd))
(when (functionp (plist-get auth-info :save-function))
(funcall (plist-get auth-info :save-function)))
(ert-with-temp-file netrc-file
:suffix "auth-source-test"
(let* ((auth-sources (list netrc-file))
(auth-source-save-behavior t)
host auth-info auth-passwd)
(dolist (passwd '("foo" "" nil))
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
(lambda (_prompt &optional _initial _history default
_inherit-input-method)
default)))
(setq host
(md5 (concat (prin1-to-string process-environment) passwd))
auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(should (string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (equal auth-passwd passwd))
(when (functionp (plist-get auth-info :save-function))
(funcall (plist-get auth-info :save-function)))
;; Check, that the item has been created indeed.
(auth-source-forget+ :host t)
(setq auth-source-netrc-cache nil)
(setq auth-info (car (auth-source-search :host host))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(with-temp-buffer
(insert-file-contents netrc-file)
(if (zerop (length passwd))
(progn
(should-not (plist-get auth-info :user))
(should-not (plist-get auth-info :host))
(should-not auth-passwd)
(should-not (search-forward host nil 'noerror)))
(should
(string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (string-equal auth-passwd passwd))
(should (search-forward host nil 'noerror))))))
;; Cleanup.
(delete-file netrc-file))))
;; Check, that the item has been created indeed.
(auth-source-forget+ :host t)
(setq auth-source-netrc-cache nil)
(setq auth-info (car (auth-source-search :host host))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(with-temp-buffer
(insert-file-contents netrc-file)
(if (zerop (length passwd))
(progn
(should-not (plist-get auth-info :user))
(should-not (plist-get auth-info :host))
(should-not auth-passwd)
(should-not (search-forward host nil 'noerror)))
(should
(string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (string-equal auth-passwd passwd))
(should (search-forward host nil 'noerror)))))))))
(ert-deftest auth-source-delete ()
(let* ((netrc-file (make-temp-file "auth-source-test" nil nil "\
(ert-with-temp-file netrc-file
:suffix "auth-source-test" :text "\
machine a1 port a2 user a3 password a4
machine b1 port b2 user b3 password b4
machine c1 port c2 user c3 password c4\n"))
(auth-sources (list netrc-file))
(auth-source-do-cache nil)
(expected '((:host "a1" :port "a2" :user "a3" :secret "a4")))
(parameters '(:max 1 :host t)))
(unwind-protect
(let ((found (apply #'auth-source-delete parameters)))
(dolist (f found)
(let ((s (plist-get f :secret)))
(setf f (plist-put f :secret
(if (functionp s) (funcall s) s)))))
;; Note: The netrc backend doesn't delete anything, so
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))
(delete-file netrc-file))))
machine c1 port c2 user c3 password c4\n"
(let* ((auth-sources (list netrc-file))
(auth-source-do-cache nil)
(expected '((:host "a1" :port "a2" :user "a3" :secret "a4")))
(parameters '(:max 1 :host t))
(found (apply #'auth-source-delete parameters)))
(dolist (f found)
(let ((s (plist-get f :secret)))
(setf f (plist-put f :secret
(if (functionp s) (funcall s) s)))))
;; Note: The netrc backend doesn't delete anything, so
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))))
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here

View file

@ -28,6 +28,7 @@
(require 'autoinsert)
(require 'ert)
(require 'ert-x)
(ert-deftest autoinsert-tests-auto-insert-skeleton ()
(let ((auto-insert-alist '((text-mode nil "f" _ "oo")))
@ -39,16 +40,14 @@
(should (equal (point) (+ (point-min) 1))))))
(ert-deftest autoinsert-tests-auto-insert-file ()
(let ((temp-file (make-temp-file "autoinsert-tests" nil nil "foo")))
(unwind-protect
(let ((auto-insert-alist `((text-mode . ,temp-file)))
(auto-insert-query nil))
(with-temp-buffer
(text-mode)
(auto-insert)
(should (equal (buffer-string) "foo"))))
(when (file-exists-p temp-file)
(delete-file temp-file)))))
(ert-with-temp-file temp-file
:text "foo"
(let ((auto-insert-alist `((text-mode . ,temp-file)))
(auto-insert-query nil))
(with-temp-buffer
(text-mode)
(auto-insert)
(should (equal (buffer-string) "foo"))))))
(ert-deftest autoinsert-tests-auto-insert-function ()
(let ((auto-insert-alist '((text-mode . (lambda () (insert "foo")))))

View file

@ -371,16 +371,14 @@ Same as `with-bookmark-test' but also sets a temporary
`bookmark-default-file', evaluates BODY, and then runs the test
that saves and then loads the bookmark file."
`(with-bookmark-test
(let ((file (make-temp-file "bookmark-tests-")))
(unwind-protect
(let ((bookmark-default-file file)
(old-alist bookmark-alist))
,@body
(bookmark-save nil file t)
(setq bookmark-alist nil)
(bookmark-load file nil t)
(should (equal bookmark-alist old-alist)))
(delete-file file)))))
(ert-with-temp-file file
(let ((bookmark-default-file file)
(old-alist bookmark-alist))
,@body
(bookmark-save nil file t)
(setq bookmark-alist nil)
(bookmark-load file nil t)
(should (equal bookmark-alist old-alist))))))
(defvar bookmark-tests-non-ascii-data
(concat "Здра́вствуйте!" "中文,普通话,汉语" "åäöøñ"

View file

@ -24,19 +24,20 @@
;;; Code:
(require 'ert)
(eval-when-compile (require 'ert-x))
(ert-deftest buff-menu-24962 ()
"Test for https://debbugs.gnu.org/24962 ."
(let* ((file (make-temp-file "foo"))
(buf (find-file file)))
(unwind-protect
(progn
(rename-buffer " foo")
(list-buffers)
(with-current-buffer "*Buffer List*"
(should (string= " foo" (buffer-name (Buffer-menu-buffer))))))
(and (buffer-live-p buf) (kill-buffer buf))
(and (file-exists-p file) (delete-file file)))))
(ert-with-temp-file file
:suffix "foo"
(let ((buf (find-file file)))
(unwind-protect
(progn
(rename-buffer " foo")
(list-buffers)
(with-current-buffer "*Buffer List*"
(should (string= " foo" (buffer-name (Buffer-menu-buffer))))))
(and (buffer-live-p buf) (kill-buffer buf))))))
(provide 'buff-menu-tests)

View file

@ -698,17 +698,18 @@ and ISO style input data must use english month names."
"Actually perform export test.
Argument INPUT input diary string.
Argument EXPECTED-OUTPUT expected iCalendar result string."
(let ((temp-file (make-temp-file "icalendar-tests-ics")))
(ert-with-temp-file temp-file
:suffix "icalendar-tests-ics"
(unwind-protect
(progn
(with-temp-buffer
(insert input)
(icalendar-export-region (point-min) (point-max) temp-file))
(save-excursion
(find-file temp-file)
(goto-char (point-min))
(cond (expected-output
(should (re-search-forward "^\\s-*BEGIN:VCALENDAR
(progn
(with-temp-buffer
(insert input)
(icalendar-export-region (point-min) (point-max) temp-file))
(save-excursion
(find-file temp-file)
(goto-char (point-min))
(cond (expected-output
(should (re-search-forward "^\\s-*BEGIN:VCALENDAR
PRODID:-//Emacs//NONSGML icalendar.el//EN
VERSION:2.0
BEGIN:VEVENT
@ -717,23 +718,22 @@ UID:emacs[0-9]+
END:VEVENT
END:VCALENDAR
\\s-*$"
nil t))
(should (string-match
(concat "^\\s-*"
(regexp-quote (buffer-substring-no-properties
(match-beginning 1) (match-end 1)))
"\\s-*$")
expected-output)))
(t
(should (re-search-forward "^\\s-*BEGIN:VCALENDAR
nil t))
(should (string-match
(concat "^\\s-*"
(regexp-quote (buffer-substring-no-properties
(match-beginning 1) (match-end 1)))
"\\s-*$")
expected-output)))
(t
(should (re-search-forward "^\\s-*BEGIN:VCALENDAR
PRODID:-//Emacs//NONSGML icalendar.el//EN
VERSION:2.0
END:VCALENDAR
\\s-*$"
nil t))))))
nil t))))))
;; cleanup!!
(kill-buffer (find-buffer-visiting temp-file))
(delete-file temp-file))))
(kill-buffer (find-buffer-visiting temp-file)))))
(ert-deftest icalendar-export-ordinary-no-time ()
"Perform export test."
@ -1031,7 +1031,8 @@ During import test the timezone is set to Central European Time."
(defun icalendar-tests--do-test-import (expected-output)
"Actually perform import test.
Argument EXPECTED-OUTPUT file containing expected diary string."
(let ((temp-file (make-temp-file "icalendar-test-diary")))
(ert-with-temp-file temp-file
:suffix "icalendar-test-diary"
;; Test the Catch-the-mysterious-coding-header logic below.
;; Ruby-mode adds an after-save-hook which inserts the header!
;; (save-excursion
@ -1061,8 +1062,7 @@ Argument EXPECTED-OUTPUT file containing expected diary string."
(let ((result (buffer-substring-no-properties (point-min) (point-max))))
(should (string= expected-output result)))
(kill-buffer (find-buffer-visiting temp-file))
(delete-file temp-file))))
(kill-buffer (find-buffer-visiting temp-file)))))
(ert-deftest icalendar-import-non-recurring ()
"Perform standard import tests."

View file

@ -37,25 +37,24 @@
(defmacro with-todo-test (&rest body)
"Set up an isolated `todo-mode' test environment."
(declare (debug (body)))
`(let* ((todo-test-home (make-temp-file "todo-test-home-" t))
;; Since we change HOME, clear this to avoid a conflict
;; e.g. if Emacs runs within the user's home directory.
(abbreviated-home-dir nil)
(process-environment (cons (format "HOME=%s" todo-test-home)
process-environment))
(todo-directory (ert-resource-directory))
(todo-default-todo-file (todo-short-file-name
(car (funcall todo-files-function)))))
(unwind-protect
(progn ,@body)
;; Restore pre-test-run state of test files.
(dolist (f (directory-files todo-directory))
(let ((buf (get-file-buffer f)))
(when buf
(with-current-buffer buf
(restore-buffer-modified-p nil)
(kill-buffer)))))
(delete-directory todo-test-home t))))
`(ert-with-temp-directory todo-test-home
(let* (;; Since we change HOME, clear this to avoid a conflict
;; e.g. if Emacs runs within the user's home directory.
(abbreviated-home-dir nil)
(process-environment (cons (format "HOME=%s" todo-test-home)
process-environment))
(todo-directory (ert-resource-directory))
(todo-default-todo-file (todo-short-file-name
(car (funcall todo-files-function)))))
(unwind-protect
(progn ,@body)
;; Restore pre-test-run state of test files.
(dolist (f (directory-files todo-directory))
(let ((buf (get-file-buffer f)))
(when buf
(with-current-buffer buf
(restore-buffer-modified-p nil)
(kill-buffer)))))))))
(defun todo-test--show (num &optional archive)
"Display category NUM of test todo file.

View file

@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'dired-aux)
(eval-when-compile (require 'cl-lib))

View file

@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'dired)
(ert-deftest dired-autoload ()
@ -141,116 +142,113 @@
(ert-deftest dired-test-bug27243-01 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ."
(let* ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t)))
(save-pos (lambda ()
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(dired-save-positions))))
(dired-auto-revert-buffer t) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; dired-buffers-for-dir.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(should-not (dired-buffers-for-dir test-dir))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(message "Saved pos: %S" (funcall save-pos))
;; Point must be at end-of-buffer.
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(should (eobp)))
(push (dired test-dir) buffers)
(message "Saved pos: %S" (funcall save-pos))
;; Previous dired call shouldn't create a new buffer: must visit the one
;; created by `find-file-noselect' above.
(should (eq 1 (length (dired-buffers-for-dir test-dir))))
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(message "Saved pos: %S" (funcall save-pos))
(write-region "Test" nil test-file nil 'silent nil 'excl)
(message "Saved pos: %S" (funcall save-pos))
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat test-dir (file-name-as-directory "test-subdir"))))
(message "Saved pos: %S" (funcall save-pos))
(push (dired-find-file) buffers)
(let ((pt2 (point))) ; Point is on test-file.
(pop-to-buffer-same-window buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
(ert-with-temp-directory test-dir
(let* ((save-pos (lambda ()
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(dired-save-positions))))
(dired-auto-revert-buffer t) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; dired-buffers-for-dir.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(should-not (dired-buffers-for-dir test-dir))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(message "Saved pos: %S" (funcall save-pos))
;; Point must be at end-of-buffer.
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(should (eobp)))
(push (dired test-dir) buffers)
(message "Saved pos: %S" (funcall save-pos))
;; Previous dired call shouldn't create a new buffer: must visit the one
;; created by `find-file-noselect' above.
(should (eq 1 (length (dired-buffers-for-dir test-dir))))
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(message "Saved pos: %S" (funcall save-pos))
(write-region "Test" nil test-file nil 'silent nil 'excl)
(message "Saved pos: %S" (funcall save-pos))
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat test-dir (file-name-as-directory "test-subdir"))))
(message "Saved pos: %S" (funcall save-pos))
(push (dired-find-file) buffers)
(should (eq (point) pt2))))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory test-dir t))))
(let ((pt2 (point))) ; Point is on test-file.
(pop-to-buffer-same-window buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
(push (dired-find-file) buffers)
(should (eq (point) pt2))))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug27243-02 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ."
(let ((test-dir (make-temp-file "test-dir-" t))
(dired-auto-revert-buffer t) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; string comparisons below.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(push (dired test-dir) buffers)
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(write-region "Test" nil test-file nil 'silent nil 'excl)
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat (file-name-as-directory test-dir)
(file-name-as-directory "test-subdir"))))
(push (dired-find-file) buffers)
;; Point is on test-file.
(switch-to-buffer buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
(push (dired test-dir) buffers)
(should (eq (point) pt1)))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory test-dir t))))
(ert-with-temp-directory test-dir
(let ((dired-auto-revert-buffer t) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; string comparisons below.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(push (dired test-dir) buffers)
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(write-region "Test" nil test-file nil 'silent nil 'excl)
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat (file-name-as-directory test-dir)
(file-name-as-directory "test-subdir"))))
(push (dired-find-file) buffers)
;; Point is on test-file.
(switch-to-buffer buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
(push (dired test-dir) buffers)
(should (eq (point) pt1)))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug27243-03 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ."
(let ((test-dir (make-temp-file "test-dir-" t))
(dired-auto-revert-buffer t)
allbufs)
(unwind-protect
(progn
(with-current-buffer (find-file-noselect test-dir)
(push (current-buffer) allbufs)
(make-directory "test-subdir1")
(make-directory "test-subdir2")
(let ((test-file1 "test-file1")
(test-file2 "test-file2"))
(with-current-buffer (find-file-noselect "test-subdir1")
(push (current-buffer) allbufs)
(write-region "Test1" nil test-file1 nil 'silent nil 'excl))
(with-current-buffer (find-file-noselect "test-subdir2")
(push (current-buffer) allbufs)
(write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
;; Call find-file with a wild card and test point in each file.
(let ((buffers (find-file (concat (file-name-as-directory test-dir)
"*")
t)))
(dolist (buf buffers)
(let ((pt (with-current-buffer buf (point))))
(switch-to-buffer (find-file-noselect test-dir))
(find-file (buffer-name buf))
(should (equal (point) pt))))
(append buffers allbufs)))
(dolist (buf allbufs)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory test-dir t))))
(ert-with-temp-directory test-dir
(let ((dired-auto-revert-buffer t)
allbufs)
(unwind-protect
(progn
(with-current-buffer (find-file-noselect test-dir)
(push (current-buffer) allbufs)
(make-directory "test-subdir1")
(make-directory "test-subdir2")
(let ((test-file1 "test-file1")
(test-file2 "test-file2"))
(with-current-buffer (find-file-noselect "test-subdir1")
(push (current-buffer) allbufs)
(write-region "Test1" nil test-file1 nil 'silent nil 'excl))
(with-current-buffer (find-file-noselect "test-subdir2")
(push (current-buffer) allbufs)
(write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
;; Call find-file with a wild card and test point in each file.
(let ((buffers (find-file (concat (file-name-as-directory test-dir)
"*")
t)))
(dolist (buf buffers)
(let ((pt (with-current-buffer buf (point))))
(switch-to-buffer (find-file-noselect test-dir))
(find-file (buffer-name buf))
(should (equal (point) pt))))
(append buffers allbufs)))
(dolist (buf allbufs)
(when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug7131 ()
"Test for https://debbugs.gnu.org/7131 ."
@ -274,22 +272,21 @@
;; ls-lisp-tests.el and em-ls-tests.el.
(skip-unless (and (not (featurep 'ls-lisp))
(not (featurep 'eshell))))
(let* ((dir (make-temp-file "bug27631" 'dir))
(dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
buf)
(unwind-protect
(progn
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-with-temp-directory dir
(let* ((dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
buf)
(unwind-protect
(progn
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest dired-test-bug27899 ()
"Test for https://debbugs.gnu.org/27899 ."
@ -310,72 +307,69 @@
(ert-deftest dired-test-bug27968 ()
"Test for https://debbugs.gnu.org/27968 ."
(let* ((top-dir (make-temp-file "top-dir" t))
(subdir (expand-file-name "subdir" top-dir))
(header-len-fn (lambda ()
(save-excursion
(goto-char 1)
(forward-line 1)
(- (point-at-eol) (point)))))
orig-len len diff pos line-nb)
(make-directory subdir 'parents)
(unwind-protect
(with-current-buffer (dired-noselect subdir)
(setq orig-len (funcall header-len-fn)
pos (point)
line-nb (line-number-at-pos))
;; Bug arises when the header line changes its length; this may
;; happen if the used space has changed: for instance, with the
;; creation of additional files.
(make-directory "subdir" t)
(dired-revert)
;; Change the header line.
(save-excursion
(goto-char 1)
(forward-line 1)
(let ((inhibit-read-only t)
(new-header " test-bug27968"))
(delete-region (point) (point-at-eol))
(when (= orig-len (length new-header))
;; Wow lucky guy! I must buy lottery today.
(setq new-header (concat new-header " :-)")))
(insert new-header)))
(setq len (funcall header-len-fn)
diff (- len orig-len))
(should-not (zerop diff)) ; Header length has changed.
;; If diff > 0, then the point moves back.
;; If diff < 0, then the point moves forward.
;; If diff = 0, then the point doesn't move.
;; Sometimes this point movement causes
;; line-nb != (line-number-at-pos pos), so that we get
;; an unexpected file at point if we store buffer points.
;; Note that the line number before/after revert
;; doesn't change.
(should (= line-nb
(line-number-at-pos)
(line-number-at-pos (+ pos diff))))
;; After revert, the point must be in 'subdir' line.
(should (equal "subdir" (dired-get-filename 'local t))))
(delete-directory top-dir t))))
(ert-with-temp-directory top-dir
(let* ((subdir (expand-file-name "subdir" top-dir))
(header-len-fn (lambda ()
(save-excursion
(goto-char 1)
(forward-line 1)
(- (point-at-eol) (point)))))
orig-len len diff pos line-nb)
(make-directory subdir 'parents)
(with-current-buffer (dired-noselect subdir)
(setq orig-len (funcall header-len-fn)
pos (point)
line-nb (line-number-at-pos))
;; Bug arises when the header line changes its length; this may
;; happen if the used space has changed: for instance, with the
;; creation of additional files.
(make-directory "subdir" t)
(dired-revert)
;; Change the header line.
(save-excursion
(goto-char 1)
(forward-line 1)
(let ((inhibit-read-only t)
(new-header " test-bug27968"))
(delete-region (point) (point-at-eol))
(when (= orig-len (length new-header))
;; Wow lucky guy! I must buy lottery today.
(setq new-header (concat new-header " :-)")))
(insert new-header)))
(setq len (funcall header-len-fn)
diff (- len orig-len))
(should-not (zerop diff)) ; Header length has changed.
;; If diff > 0, then the point moves back.
;; If diff < 0, then the point moves forward.
;; If diff = 0, then the point doesn't move.
;; Sometimes this point movement causes
;; line-nb != (line-number-at-pos pos), so that we get
;; an unexpected file at point if we store buffer points.
;; Note that the line number before/after revert
;; doesn't change.
(should (= line-nb
(line-number-at-pos)
(line-number-at-pos (+ pos diff))))
;; After revert, the point must be in 'subdir' line.
(should (equal "subdir" (dired-get-filename 'local t)))))))
(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
"Helper macro for Bug#27940 test."
(declare (indent 1) (debug body))
(let ((dir (make-symbol "dir")))
`(let* ((,dir (make-temp-file "bug27940" t))
(dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
(inhibit-message t)
(default-directory ,dir))
(dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
(unless ,just-empty-dirs
(dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
(make-directory "zeta-empty-dir")
(unwind-protect
(progn
,@body)
(delete-directory ,dir t)
(kill-buffer (current-buffer))))))
`(ert-with-temp-directory ,dir
(let* ((dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
(inhibit-message t)
(default-directory ,dir))
(dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
(unless ,just-empty-dirs
(dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
(make-directory "zeta-empty-dir")
(unwind-protect
(progn
,@body)
(kill-buffer (current-buffer)))))))
(ert-deftest dired-test-bug27940 ()
"Test for https://debbugs.gnu.org/27940 ."

View file

@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'dired-x)
@ -31,23 +32,20 @@
(append (copy-sequence dirs)
(delete "c" (copy-sequence files)))
#'string<))
(dir (make-temp-file "Bug25942" 'dir))
(extension "c"))
(unwind-protect
(progn
(dolist (d dirs)
(make-directory (expand-file-name d dir)))
(dolist (f files)
(write-region nil nil (expand-file-name f dir)))
(dired dir)
(dired-mark-extension extension)
(should (equal '("bar.c" "foo.c")
(sort (dired-get-marked-files 'local) #'string<)))
(dired-unmark-all-marks)
(dired-mark-suffix extension)
(should (equal all-but-c
(sort (dired-get-marked-files 'local) #'string<))))
(delete-directory dir 'recursive))))
(ert-with-temp-directory dir
(dolist (d dirs)
(make-directory (expand-file-name d dir)))
(dolist (f files)
(write-region nil nil (expand-file-name f dir)))
(dired dir)
(dired-mark-extension extension)
(should (equal '("bar.c" "foo.c")
(sort (dired-get-marked-files 'local) #'string<)))
(dired-unmark-all-marks)
(dired-mark-suffix extension)
(should (equal all-but-c
(sort (dired-get-marked-files 'local) #'string<))))))
(ert-deftest dired-guess-default ()
(let ((dired-guess-shell-alist-user nil)

View file

@ -1016,10 +1016,9 @@ byte-compiled. Run with dynamic binding."
(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
(declare (indent 1))
(cl-check-type file-name-var symbol)
`(let ((,file-name-var (make-temp-file "emacs")))
`(ert-with-temp-file ,file-name-var
(unwind-protect
(progn ,@body)
(delete-file ,file-name-var)
(let ((elc (concat ,file-name-var ".elc")))
(if (file-exists-p elc) (delete-file elc))))))

View file

@ -28,6 +28,7 @@
(require 'check-declare)
(require 'ert)
(require 'ert-x)
(eval-when-compile (require 'subr-x))
(ert-deftest check-declare-tests-locate ()
@ -36,62 +37,53 @@
(string-prefix-p "ext:" (check-declare-locate "ext:foo" ""))))
(ert-deftest check-declare-tests-scan ()
(let ((file (make-temp-file "check-declare-tests-")))
(unwind-protect
(progn
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(declare-function ring-insert \"ring\" (ring item))"
"(let ((foo 'code)) foo)")
"\n")))
(let ((res (check-declare-scan file)))
(should (= (length res) 1))
(pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
(should (string-match-p "ring" fnfile))
(should (equal "ring-insert" fn))
(should (equal '(ring item) arglist))
(should-not fileonly))))
(delete-file file))))
(ert-with-temp-file file
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(declare-function ring-insert \"ring\" (ring item))"
"(let ((foo 'code)) foo)")
"\n")))
(let ((res (check-declare-scan file)))
(should (= (length res) 1))
(pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
(should (string-match-p "ring" fnfile))
(should (equal "ring-insert" fn))
(should (equal '(ring item) arglist))
(should-not fileonly)))))
(ert-deftest check-declare-tests-verify ()
(let ((file (make-temp-file "check-declare-tests-")))
(unwind-protect
(progn
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(defun foo-fun ())"
"(defun ring-insert (ring item)"
"\"Insert onto ring RING the item ITEM.\""
"nil)")
"\n")))
(should-not
(check-declare-verify
file '(("foo.el" "ring-insert" (ring item))))))
(delete-file file))))
(ert-with-temp-file file
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(defun foo-fun ())"
"(defun ring-insert (ring item)"
"\"Insert onto ring RING the item ITEM.\""
"nil)")
"\n")))
(should-not
(check-declare-verify
file '(("foo.el" "ring-insert" (ring item)))))))
(ert-deftest check-declare-tests-verify-mismatch ()
(let ((file (make-temp-file "check-declare-tests-")))
(unwind-protect
(progn
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(defun foo-fun ())"
"(defun ring-insert (ring)"
"\"Insert onto ring RING the item ITEM.\""
"nil)")
"\n")))
(should
(equal
(check-declare-verify
file '(("foo.el" "ring-insert" (ring item))))
'(("foo.el" "ring-insert" "arglist mismatch")))))
(delete-file file))))
(ert-with-temp-file file
(with-temp-file file
(insert
(string-join
'(";; foo comment"
"(defun foo-fun ())"
"(defun ring-insert (ring)"
"\"Insert onto ring RING the item ITEM.\""
"nil)")
"\n")))
(should
(equal
(check-declare-verify
file '(("foo.el" "ring-insert" (ring item))))
'(("foo.el" "ring-insert" "arglist mismatch"))))))
(ert-deftest check-declare-tests-sort ()
(should-not (check-declare-sort '()))

View file

@ -107,27 +107,27 @@ back to the top level.")
"Set up the environment for an Edebug test BODY, run it, and clean up."
(declare (debug (body)))
`(edebug-tests-with-default-config
(let ((edebug-tests-failure-in-post-command nil)
(edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el"))
(find-file-suppress-same-file-warnings t))
(edebug-tests-setup-code-file edebug-tests-temp-file)
(ert-with-message-capture
edebug-tests-messages
(unwind-protect
(with-current-buffer (find-file edebug-tests-temp-file)
(read-only-mode)
(setq lexical-binding t)
(eval-buffer)
,@body
(when edebug-tests-failure-in-post-command
(signal (car edebug-tests-failure-in-post-command)
(cdr edebug-tests-failure-in-post-command))))
(unload-feature 'edebug-test-code)
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(set-buffer-modified-p nil))
(ignore-errors (kill-buffer (find-file-noselect
edebug-tests-temp-file)))
(ignore-errors (delete-file edebug-tests-temp-file)))))))
(ert-with-temp-file edebug-tests-temp-file
:suffix ".el"
(let ((edebug-tests-failure-in-post-command nil)
(find-file-suppress-same-file-warnings t))
(edebug-tests-setup-code-file edebug-tests-temp-file)
(ert-with-message-capture
edebug-tests-messages
(unwind-protect
(with-current-buffer (find-file edebug-tests-temp-file)
(read-only-mode)
(setq lexical-binding t)
(eval-buffer)
,@body
(when edebug-tests-failure-in-post-command
(signal (car edebug-tests-failure-in-post-command)
(cdr edebug-tests-failure-in-post-command))))
(unload-feature 'edebug-test-code)
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(set-buffer-modified-p nil))
(ignore-errors (kill-buffer (find-file-noselect
edebug-tests-temp-file)))))))))
;; The following macro and its support functions implement an extension
;; to keyboard macros to allow interleaving of keyboard macro

View file

@ -115,57 +115,55 @@
&rest body)
"Set up temporary locations and variables for testing."
(declare (indent 1) (debug (([&rest form]) body)))
`(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t))
(process-environment (cons (format "HOME=%s" package-test-user-dir)
process-environment))
(package-user-dir package-test-user-dir)
(package-gnupghome-dir (expand-file-name "gnupg" package-user-dir))
(package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
(default-directory package-test-file-dir)
abbreviated-home-dir
package--initialized
package-alist
,@(if update-news
'(package-update-news-on-upload t)
(list (cl-gensym)))
,@(if upload-base
'((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
(package-archive-upload-base package-test-archive-upload-base))
(list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
(let ((buf (get-buffer "*Packages*")))
(when (buffer-live-p buf)
(kill-buffer buf)))
(unwind-protect
(progn
,(if basedir `(cd ,basedir))
(unless (file-directory-p package-user-dir)
(mkdir package-user-dir))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
,@(when install
`((package-initialize)
(package-refresh-contents)
(mapc 'package-install ,install)))
(with-temp-buffer
,(if file
`(insert-file-contents ,file))
,@body)))
`(ert-with-temp-directory package-test-user-dir
(let* ((process-environment (cons (format "HOME=%s" package-test-user-dir)
process-environment))
(package-user-dir package-test-user-dir)
(package-gnupghome-dir (expand-file-name "gnupg" package-user-dir))
(package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
(default-directory package-test-file-dir)
abbreviated-home-dir
package--initialized
package-alist
,@(if update-news
'(package-update-news-on-upload t)
(list (cl-gensym)))
,@(if upload-base
'((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
(package-archive-upload-base package-test-archive-upload-base))
(list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
(let ((buf (get-buffer "*Packages*")))
(when (buffer-live-p buf)
(kill-buffer buf)))
(unwind-protect
(progn
,(if basedir `(cd ,basedir))
(unless (file-directory-p package-user-dir)
(mkdir package-user-dir))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
,@(when install
`((package-initialize)
(package-refresh-contents)
(mapc 'package-install ,install)))
(with-temp-buffer
,(if file
`(insert-file-contents ,file))
,@body)))
(when ,upload-base
(dolist (f '("archive-contents"
"simple-single-1.3.el"
"simple-single-1.4.el"
"simple-single-readme.txt"))
(ignore-errors
(delete-file
(expand-file-name f package-test-archive-upload-base))))
(delete-directory package-test-archive-upload-base))
(when (file-directory-p package-test-user-dir)
(delete-directory package-test-user-dir t))
(when ,upload-base
(dolist (f '("archive-contents"
"simple-single-1.3.el"
"simple-single-1.4.el"
"simple-single-readme.txt"))
(ignore-errors
(delete-file
(expand-file-name f package-test-archive-upload-base))))
(delete-directory package-test-archive-upload-base))
(when (and (boundp 'package-test-archive-upload-base)
(file-directory-p package-test-archive-upload-base))
(delete-directory package-test-archive-upload-base t)))))
(when (and (boundp 'package-test-archive-upload-base)
(file-directory-p package-test-archive-upload-base))
(delete-directory package-test-archive-upload-base t))))))
(defmacro with-fake-help-buffer (&rest body)
"Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
@ -715,25 +713,23 @@ but with a different end of line convention (bug#48137)."
(defvar epg-config--program-alist) ; Silence byte-compiler.
(ert-deftest package-test-signed ()
"Test verifying package signature."
(skip-unless (let ((homedir (make-temp-file "package-test" t)))
(unwind-protect
(let ((process-environment
(cons (concat "HOME=" homedir)
process-environment)))
(require 'epg-config)
(defvar epg-config--program-alist)
(epg-find-configuration
'OpenPGP nil
;; By default we require gpg2 2.1+ due to some
;; practical problems with pinentry. But this
;; test works fine with 2.0 as well.
(let ((prog-alist (copy-tree epg-config--program-alist)))
(setf (alist-get "gpg2"
(alist-get 'OpenPGP prog-alist)
nil nil #'equal)
"2.0")
prog-alist)))
(delete-directory homedir t))))
(skip-unless (ert-with-temp-directory homedir
(let ((process-environment
(cons (concat "HOME=" homedir)
process-environment)))
(require 'epg-config)
(defvar epg-config--program-alist)
(epg-find-configuration
'OpenPGP nil
;; By default we require gpg2 2.1+ due to some
;; practical problems with pinentry. But this
;; test works fine with 2.0 as well.
(let ((prog-alist (copy-tree epg-config--program-alist)))
(setf (alist-get "gpg2"
(alist-get 'OpenPGP prog-alist)
nil nil #'equal)
"2.0")
prog-alist)))))
(let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
(package-test-data-dir (ert-resource-file "signed")))
(with-package-test ()

View file

@ -45,34 +45,34 @@ testcases.el. This can be used to create test cases if Testcover
is working correctly on a code sample. OPTARGS are optional
arguments for `testcover-start'."
(interactive "r")
(let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
(find-file-suppress-same-file-warnings t)
(code (buffer-substring beg end))
(marked-up-code))
(unwind-protect
(progn
(with-temp-file tempfile
(insert code))
(save-current-buffer
(let ((buf (find-file-noselect tempfile)))
(set-buffer buf)
(apply 'testcover-start (cons tempfile optargs))
(testcover-mark-all buf)
(dolist (overlay (overlays-in (point-min) (point-max)))
(let ((ov-face (overlay-get overlay 'face)))
(goto-char (overlay-end overlay))
(cond
((eq ov-face 'testcover-nohits) (insert "!!!"))
((eq ov-face 'testcover-1value) (insert "%%%"))
(t nil))))
(setq marked-up-code (buffer-string)))
(set-buffer-modified-p nil)))
(ignore-errors (kill-buffer (find-file-noselect tempfile)))
(ignore-errors (delete-file tempfile)))
(ert-with-temp-file tempfile
:suffix ".el"
(let ((find-file-suppress-same-file-warnings t)
(code (buffer-substring beg end))
(marked-up-code))
(unwind-protect
(progn
(with-temp-file tempfile
(insert code))
(save-current-buffer
(let ((buf (find-file-noselect tempfile)))
(set-buffer buf)
(apply 'testcover-start (cons tempfile optargs))
(testcover-mark-all buf)
(dolist (overlay (overlays-in (point-min) (point-max)))
(let ((ov-face (overlay-get overlay 'face)))
(goto-char (overlay-end overlay))
(cond
((eq ov-face 'testcover-nohits) (insert "!!!"))
((eq ov-face 'testcover-1value) (insert "%%%"))
(t nil))))
(setq marked-up-code (buffer-string)))
(set-buffer-modified-p nil)))
(ignore-errors (kill-buffer (find-file-noselect tempfile))))
;; Now replace the original code with the marked up code.
(delete-region beg end)
(insert marked-up-code))))
;; Now replace the original code with the marked up code.
(delete-region beg end)
(insert marked-up-code)))))
(eval-and-compile
(defun testcover-tests-unmarkup-region (beg end)
@ -99,32 +99,32 @@ arguments for `testcover-start'."
(eval-and-compile
(defun testcover-tests-run-test-case (marked-up-code)
"Test the operation of Testcover on the string MARKED-UP-CODE."
(let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
(find-file-suppress-same-file-warnings t))
(unwind-protect
(progn
(with-temp-file tempfile
(insert marked-up-code))
;; Remove the marks and mark the code up again. The original
;; and recreated versions should match.
(save-current-buffer
(set-buffer (find-file-noselect tempfile))
;; Fail the test if the debugger tries to become active,
;; which can happen if Testcover fails to attach itself
;; correctly. Note that this will prevent debugging
;; these tests using Edebug.
(cl-letf (((symbol-function #'edebug-default-enter)
(lambda (&rest _args)
(ert-fail "Debugger invoked during test run"))))
(dolist (byte-compile '(t nil))
(testcover-tests-unmarkup-region (point-min) (point-max))
(unwind-protect
(testcover-tests-markup-region (point-min) (point-max) byte-compile)
(set-buffer-modified-p nil))
(should (string= marked-up-code
(buffer-string)))))))
(ignore-errors (kill-buffer (find-file-noselect tempfile)))
(ignore-errors (delete-file tempfile))))))
(ert-with-temp-file tempfile
:suffix ".el"
(let ((find-file-suppress-same-file-warnings t))
(unwind-protect
(progn
(with-temp-file tempfile
(insert marked-up-code))
;; Remove the marks and mark the code up again. The original
;; and recreated versions should match.
(save-current-buffer
(set-buffer (find-file-noselect tempfile))
;; Fail the test if the debugger tries to become active,
;; which can happen if Testcover fails to attach itself
;; correctly. Note that this will prevent debugging
;; these tests using Edebug.
(cl-letf (((symbol-function #'edebug-default-enter)
(lambda (&rest _args)
(ert-fail "Debugger invoked during test run"))))
(dolist (byte-compile '(t nil))
(testcover-tests-unmarkup-region (point-min) (point-max))
(unwind-protect
(testcover-tests-markup-region (point-min) (point-max) byte-compile)
(set-buffer-modified-p nil))
(should (string= marked-up-code
(buffer-string)))))))
(ignore-errors (kill-buffer (find-file-noselect tempfile))))))))
;; Convert test case file to ert-defmethod.

View file

@ -21,7 +21,8 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'viper)
(defun viper-test-undo-kmacro (kmacro)
@ -30,47 +31,42 @@
This function makes as many attempts as possible to clean up
after itself, although it will leave a buffer called
*viper-test-buffer* if it fails (this is deliberate!)."
(let (
;; Viper just turns itself off during batch use.
(noninteractive nil)
;; Switch off start up message or it will chew the key presses.
(viper-inhibit-startup-message 't)
;; Select an expert-level for the same reason.
(viper-expert-level 5)
;; viper loads this even with -q so make sure it's empty!
(viper-custom-file-name (make-temp-file "viper-tests" nil ".elc"))
(before-buffer (current-buffer)))
(unwind-protect
(progn
;; viper-mode is essentially global, so set it here.
(viper-mode)
;; We must switch to buffer because we are using a keyboard macro
;; which appears to not go to the current-buffer but what ever is
;; currently taking keyboard events. We use a named buffer because
;; then we can see what it in it if it all goes wrong.
(switch-to-buffer
(get-buffer-create
"*viper-test-buffer*"))
(erase-buffer)
;; The new buffer fails to enter vi state so set it.
(viper-change-state-to-vi)
;; Run the macro.
(execute-kbd-macro kmacro)
(let ((rtn
(buffer-substring-no-properties
(point-min)
(point-max))))
;; Kill the buffer iff the macro succeeds.
(kill-buffer)
rtn))
;; Switch everything off and restore the buffer.
(toggle-viper-mode)
(delete-file viper-custom-file-name)
(switch-to-buffer before-buffer))))
(ert-deftest viper-test-go ()
"Test that this file is running."
(should t))
(ert-with-temp-file viper-custom-file-name
;; viper loads this even with -q so make sure it's empty!
:prefix "emacs-viper-tests" :suffix ".elc"
(let (;; Viper just turns itself off during batch use.
(noninteractive nil)
;; Switch off start up message or it will chew the key presses.
(viper-inhibit-startup-message 't)
;; Select an expert-level for the same reason.
(viper-expert-level 5)
(before-buffer (current-buffer)))
(unwind-protect
(progn
;; viper-mode is essentially global, so set it here.
(viper-mode)
;; We must switch to buffer because we are using a keyboard macro
;; which appears to not go to the current-buffer but what ever is
;; currently taking keyboard events. We use a named buffer because
;; then we can see what it in it if it all goes wrong.
(switch-to-buffer
(get-buffer-create
"*viper-test-buffer*"))
(erase-buffer)
;; The new buffer fails to enter vi state so set it.
(viper-change-state-to-vi)
;; Run the macro.
(execute-kbd-macro kmacro)
(let ((rtn
(buffer-substring-no-properties
(point-min)
(point-max))))
;; Kill the buffer iff the macro succeeds.
(kill-buffer)
rtn))
;; Switch everything off and restore the buffer.
(toggle-viper-mode)
(switch-to-buffer before-buffer)))))
(ert-deftest viper-test-fix ()
"Test that the viper kmacro fixture is working."

View file

@ -58,48 +58,45 @@
(cl-defmacro with-epg-tests ((&optional &key require-passphrase
require-public-key
require-secret-key)
&rest body)
&rest body)
"Set up temporary locations and variables for testing."
(declare (indent 1) (debug (sexp body)))
`(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))
(process-environment
(append
(list "GPG_AGENT_INFO"
(format "GNUPGHOME=%s" epg-tests-home-directory))
process-environment)))
(unwind-protect
;; GNUPGHOME is needed to find a usable gpg, so we can't
;; check whether to skip any earlier (Bug#23561).
(let ((epg-config (or (epg-tests-find-usable-gpg-configuration
,require-passphrase ,require-public-key)
(ert-skip "No usable gpg config")))
(context (epg-make-context 'OpenPGP)))
(setf (epg-context-program context)
(alist-get 'program epg-config))
(setf (epg-context-home-directory context)
epg-tests-home-directory)
,(if require-passphrase
'(with-temp-file (expand-file-name
"gpg-agent.conf" epg-tests-home-directory)
(insert "pinentry-program "
(ert-resource-file "dummy-pinentry")
"\n")
(epg-context-set-passphrase-callback
context
#'epg-tests-passphrase-callback)))
,(if require-public-key
'(epg-import-keys-from-file
context
(ert-resource-file "pubkey.asc")))
,(if require-secret-key
'(epg-import-keys-from-file
context
(ert-resource-file "seckey.asc")))
(with-temp-buffer
(setq-local epg-tests-context context)
,@body))
(when (file-directory-p epg-tests-home-directory)
(delete-directory epg-tests-home-directory t)))))
`(ert-with-temp-directory epg-tests-home-directory
(let* ((process-environment
(append
(list "GPG_AGENT_INFO"
(format "GNUPGHOME=%s" epg-tests-home-directory))
process-environment)))
;; GNUPGHOME is needed to find a usable gpg, so we can't
;; check whether to skip any earlier (Bug#23561).
(let ((epg-config (or (epg-tests-find-usable-gpg-configuration
,require-passphrase ,require-public-key)
(ert-skip "No usable gpg config")))
(context (epg-make-context 'OpenPGP)))
(setf (epg-context-program context)
(alist-get 'program epg-config))
(setf (epg-context-home-directory context)
epg-tests-home-directory)
,(if require-passphrase
'(with-temp-file (expand-file-name
"gpg-agent.conf" epg-tests-home-directory)
(insert "pinentry-program "
(ert-resource-file "dummy-pinentry")
"\n")
(epg-context-set-passphrase-callback
context
#'epg-tests-passphrase-callback)))
,(if require-public-key
'(epg-import-keys-from-file
context
(ert-resource-file "pubkey.asc")))
,(if require-secret-key
'(epg-import-keys-from-file
context
(ert-resource-file "seckey.asc")))
(with-temp-buffer
(setq-local epg-tests-context context)
,@body)))))
(ert-deftest epg-decrypt-1 ()
:expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme

View file

@ -20,19 +20,18 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'em-hist)
(ert-deftest eshell-write-readonly-history ()
"Test that having read-only strings in history is okay."
(let ((histfile (make-temp-file "eshell-history"))
(eshell-history-ring (make-ring 2)))
(ring-insert eshell-history-ring
(propertize "echo foo" 'read-only t))
(ring-insert eshell-history-ring
(propertize "echo bar" 'read-only t))
(unwind-protect
(eshell-write-history histfile)
(delete-file histfile))))
(ert-with-temp-file histfile
(let ((eshell-history-ring (make-ring 2)))
(ring-insert eshell-history-ring
(propertize "echo foo" 'read-only t))
(ring-insert eshell-history-ring
(propertize "echo bar" 'read-only t))
(eshell-write-history histfile))))
(provide 'em-hist-test)

View file

@ -25,30 +25,30 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'em-ls)
(require 'dired)
(ert-deftest em-ls-test-bug27631 ()
"Test for https://debbugs.gnu.org/27631 ."
(let* ((dir (make-temp-file "bug27631" 'dir))
(dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
(orig eshell-ls-use-in-dired)
buf)
(unwind-protect
(progn
(customize-set-value 'eshell-ls-use-in-dired t)
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(customize-set-variable 'eshell-ls-use-in-dired orig)
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-with-temp-directory dir
(let* ((dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
(orig eshell-ls-use-in-dired)
buf)
(unwind-protect
(progn
(customize-set-value 'eshell-ls-use-in-dired t)
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(customize-set-variable 'eshell-ls-use-in-dired orig)
(when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest em-ls-test-bug27817 ()
"Test for https://debbugs.gnu.org/27817 ."

View file

@ -25,30 +25,29 @@
(require 'cl-lib)
(require 'ert)
(require 'ert-x)
(require 'ffap)
(ert-deftest ffap-tests-25243 ()
"Test for https://debbugs.gnu.org/25243 ."
(let ((file (make-temp-file "test-Bug#25243")))
(unwind-protect
(with-temp-file file
(let ((str "diff --git b/lisp/ffap.el a/lisp/ffap.el
(ert-with-temp-file file
:suffix "-bug25243"
(let ((str "diff --git b/lisp/ffap.el a/lisp/ffap.el
index 3d7cebadcf..ad4b70d737 100644
--- b/lisp/ffap.el
+++ a/lisp/ffap.el
@@ -203,6 +203,9 @@ ffap-foo-at-bar-prefix
"))
(transient-mark-mode 1)
(when (natnump ffap-max-region-length)
(insert
(concat
str
(make-string ffap-max-region-length #xa)
(format "%s ENDS HERE" file)))
(call-interactively 'mark-whole-buffer)
(should (equal "" (ffap-string-at-point)))
(should (equal '(1 1) ffap-string-at-point-region)))))
(and (file-exists-p file) (delete-file file)))))
(transient-mark-mode 1)
(when (natnump ffap-max-region-length)
(insert
(concat
str
(make-string ffap-max-region-length #xa)
(format "%s ENDS HERE" file)))
(call-interactively 'mark-whole-buffer)
(should (equal "" (ffap-string-at-point)))
(should (equal '(1 1) ffap-string-at-point-region))))))
(ert-deftest ffap-gopher-at-point ()
(with-temp-buffer

View file

@ -176,15 +176,14 @@ form.")
;; If called interactively, environment variable
;; $EMACS_TEST_DIRECTORY does not exist.
(skip-unless (file-exists-p files-test-bug-18141-file))
(let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz")))
(unwind-protect
(progn
(copy-file files-test-bug-18141-file tempfile t)
(with-current-buffer (find-file-noselect tempfile)
(set-buffer-modified-p t)
(save-buffer)
(should (eq buffer-file-coding-system 'iso-2022-7bit-unix))))
(delete-file tempfile))))
(ert-with-temp-file tempfile
:prefix "emacs-test-files-bug-18141"
:suffix ".gz"
(copy-file files-test-bug-18141-file tempfile t)
(with-current-buffer (find-file-noselect tempfile)
(set-buffer-modified-p t)
(save-buffer)
(should (eq buffer-file-coding-system 'iso-2022-7bit-unix)))))
(ert-deftest files-tests-make-temp-file-empty-prefix ()
"Test make-temp-file with an empty prefix."
@ -283,22 +282,20 @@ If we are in a directory named `~', the default value should not
be $HOME."
(cl-letf (((symbol-function 'completing-read)
(lambda (_prompt _coll &optional _pred _req init _hist def _)
(or def init)))
(dir (make-temp-file "read-file-name-test" t)))
(unwind-protect
(let ((subdir (expand-file-name "./~/" dir)))
(make-directory subdir t)
(with-temp-buffer
(setq default-directory subdir)
(should-not (equal
(expand-file-name (read-file-name "File: "))
(expand-file-name "~/")))
;; Don't overquote either!
(setq default-directory (concat "/:" subdir))
(should-not (equal
(expand-file-name (read-file-name "File: "))
(concat "/:/:" subdir)))))
(delete-directory dir 'recursive))))
(or def init))))
(ert-with-temp-directory dir
(let ((subdir (expand-file-name "./~/" dir)))
(make-directory subdir t)
(with-temp-buffer
(setq default-directory subdir)
(should-not (equal
(expand-file-name (read-file-name "File: "))
(expand-file-name "~/")))
;; Don't overquote either!
(setq default-directory (concat "/:" subdir))
(should-not (equal
(expand-file-name (read-file-name "File: "))
(concat "/:/:" subdir))))))))
(ert-deftest files-tests-file-name-non-special-quote-unquote ()
(let (;; Just in case it is quoted, who knows.
@ -1231,26 +1228,26 @@ works as expected if the default directory is quoted."
(insert-directory-wildcard-in-dir-p (car path-res)))))))
(ert-deftest files-tests-make-directory ()
(let* ((dir (make-temp-file "files-mkdir-test" t))
(dirname (file-name-as-directory dir))
(file (concat dirname "file"))
(subdir1 (concat dirname "subdir1"))
(subdir2 (concat dirname "subdir2"))
(a/b (concat dirname "a/b")))
(write-region "" nil file)
(should-error (make-directory "/"))
(should-not (make-directory "/" t))
(should-error (make-directory dir))
(should-not (make-directory dir t))
(should-error (make-directory dirname))
(should-not (make-directory dirname t))
(should-error (make-directory file))
(should-error (make-directory file t))
(should-not (make-directory subdir1))
(should-not (make-directory subdir2 t))
(should-error (make-directory a/b))
(should-not (make-directory a/b t))
(delete-directory dir 'recursive)))
(ert-with-temp-directory dir
(let* ((dirname (file-name-as-directory dir))
(file (concat dirname "file"))
(subdir1 (concat dirname "subdir1"))
(subdir2 (concat dirname "subdir2"))
(a/b (concat dirname "a/b")))
(write-region "" nil file)
(should-error (make-directory "/"))
(should-not (make-directory "/" t))
(should-error (make-directory dir))
(should-not (make-directory dir t))
(should-error (make-directory dirname))
(should-not (make-directory dirname t))
(should-error (make-directory file))
(should-error (make-directory file t))
(should-not (make-directory subdir1))
(should-not (make-directory subdir2 t))
(should-error (make-directory a/b))
(should-not (make-directory a/b t))
(delete-directory dir 'recursive))))
(ert-deftest files-tests-file-modes-symbolic-to-number ()
(let ((alist (list (cons "a=rwx" #o777)
@ -1318,21 +1315,21 @@ name (Bug#28412)."
(should (eq (buffer-size) 1))))))
(ert-deftest files-tests-copy-directory ()
(let* ((dir (make-temp-file "files-mkdir-test" t))
(dirname (file-name-as-directory dir))
(source (concat dirname "source"))
(dest (concat dirname "dest/new/directory/"))
(file (concat (file-name-as-directory source) "file"))
(source2 (concat dirname "source2"))
(dest2 (concat dirname "dest/new2")))
(make-directory source)
(write-region "" nil file)
(copy-directory source dest t t t)
(should (file-exists-p (concat dest "file")))
(make-directory (concat (file-name-as-directory source2) "a") t)
(copy-directory source2 dest2)
(should (file-directory-p (concat (file-name-as-directory dest2) "a")))
(delete-directory dir 'recursive)))
(ert-with-temp-directory dir
(let* ((dirname (file-name-as-directory dir))
(source (concat dirname "source"))
(dest (concat dirname "dest/new/directory/"))
(file (concat (file-name-as-directory source) "file"))
(source2 (concat dirname "source2"))
(dest2 (concat dirname "dest/new2")))
(make-directory source)
(write-region "" nil file)
(copy-directory source dest t t t)
(should (file-exists-p (concat dest "file")))
(make-directory (concat (file-name-as-directory source2) "a") t)
(copy-directory source2 dest2)
(should (file-directory-p (concat (file-name-as-directory dest2) "a")))
(delete-directory dir 'recursive))))
(ert-deftest files-tests-abbreviated-home-dir ()
"Test that changing HOME does not confuse `abbreviate-file-name'.
@ -1351,43 +1348,41 @@ See <https://debbugs.gnu.org/19657#20>."
(ert-deftest files-tests-executable-find ()
"Test that `executable-find' works also with a relative or remote PATH.
See <https://debbugs.gnu.org/35241>."
(let ((tmpfile (make-temp-file "files-test" nil (car exec-suffixes))))
(unwind-protect
(progn
(set-file-modes tmpfile #o777)
(let ((exec-path `(,temporary-file-directory)))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile)))))
;; An empty element of `exec-path' means `default-directory'.
(let ((default-directory temporary-file-directory)
(exec-path nil))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile)))))
;; The remote file name shall be quoted, and handled like a
;; non-existing directory.
(let ((default-directory "/ssh::")
(exec-path (append exec-path `("." ,temporary-file-directory))))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile))))))
(delete-file tmpfile))))
(ert-with-temp-file tmpfile
:suffix (car exec-suffixes)
(let ((tmpfile (make-temp-file "files-test" nil )))
(set-file-modes tmpfile #o777)
(let ((exec-path `(,temporary-file-directory)))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile)))))
;; An empty element of `exec-path' means `default-directory'.
(let ((default-directory temporary-file-directory)
(exec-path nil))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile)))))
;; The remote file name shall be quoted, and handled like a
;; non-existing directory.
(let ((default-directory "/ssh::")
(exec-path (append exec-path `("." ,temporary-file-directory))))
(should
(equal tmpfile
(executable-find (file-name-nondirectory tmpfile))))))))
(ert-deftest files-tests-dont-rewrite-precious-files ()
"Test that `file-precious-flag' forces files to be saved by
renaming only, rather than modified in-place."
(let* ((temp-file-name (make-temp-file "files-tests"))
(advice (lambda (_start _end filename &rest _r)
(should-not (string= filename temp-file-name)))))
(unwind-protect
(with-current-buffer (find-file-noselect temp-file-name)
(advice-add #'write-region :before advice)
(setq-local file-precious-flag t)
(insert "foobar")
(should (null (save-buffer))))
(ignore-errors (advice-remove #'write-region advice))
(ignore-errors (delete-file temp-file-name)))))
(ert-with-temp-file temp-file-name
(let* ((advice (lambda (_start _end filename &rest _r)
(should-not (string= filename temp-file-name)))))
(unwind-protect
(with-current-buffer (find-file-noselect temp-file-name)
(advice-add #'write-region :before advice)
(setq-local file-precious-flag t)
(insert "foobar")
(should (null (save-buffer))))
(ignore-errors (advice-remove #'write-region advice))))))
(ert-deftest files-test-file-size-human-readable ()
(should (equal (file-size-human-readable 13) "13"))
@ -1578,40 +1573,39 @@ on BUF-1 and BUF-2 after the `save-some-buffers' call.
The test is repeated with `save-some-buffers-default-predicate'
let-bound to PRED and passing nil as second arg of
`save-some-buffers'."
(let* ((dir (make-temp-file "testdir" 'dir))
(file-1 (expand-file-name "subdir-1/file.foo" dir))
(file-2 (expand-file-name "subdir-2/file.bar" dir))
(inhibit-message t)
buf-1 buf-2)
(unwind-protect
(progn
(make-empty-file file-1 'parens)
(make-empty-file file-2 'parens)
(setq buf-1 (find-file file-1)
buf-2 (find-file file-2))
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf (insert "foobar\n")))
;; Run the test.
(with-current-buffer buf-1
(let ((save-some-buffers-default-predicate def-pred-bind))
(save-some-buffers t pred))
(should (eq exp-1 (buffer-modified-p buf-1)))
(should (eq exp-2 (buffer-modified-p buf-2))))
;; Set both buffers as modified to run another test.
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf (set-buffer-modified-p t)))
;; The result of this test must be identical as the previous one.
(with-current-buffer buf-1
(let ((save-some-buffers-default-predicate (or pred def-pred-bind)))
(save-some-buffers t nil))
(should (eq exp-1 (buffer-modified-p buf-1)))
(should (eq exp-2 (buffer-modified-p buf-2)))))
;; Clean up.
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf
(set-buffer-modified-p nil)
(kill-buffer buf)))
(delete-directory dir 'recursive))))
(ert-with-temp-directory dir
(let* ((file-1 (expand-file-name "subdir-1/file.foo" dir))
(file-2 (expand-file-name "subdir-2/file.bar" dir))
(inhibit-message t)
buf-1 buf-2)
(unwind-protect
(progn
(make-empty-file file-1 'parens)
(make-empty-file file-2 'parens)
(setq buf-1 (find-file file-1)
buf-2 (find-file file-2))
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf (insert "foobar\n")))
;; Run the test.
(with-current-buffer buf-1
(let ((save-some-buffers-default-predicate def-pred-bind))
(save-some-buffers t pred))
(should (eq exp-1 (buffer-modified-p buf-1)))
(should (eq exp-2 (buffer-modified-p buf-2))))
;; Set both buffers as modified to run another test.
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf (set-buffer-modified-p t)))
;; The result of this test must be identical as the previous one.
(with-current-buffer buf-1
(let ((save-some-buffers-default-predicate (or pred def-pred-bind)))
(save-some-buffers t nil))
(should (eq exp-1 (buffer-modified-p buf-1)))
(should (eq exp-2 (buffer-modified-p buf-2)))))
;; Clean up.
(dolist (buf (list buf-1 buf-2))
(with-current-buffer buf
(set-buffer-modified-p nil)
(kill-buffer buf)))))))
(ert-deftest files-tests-save-some-buffers ()
"Test `save-some-buffers'.

View file

@ -25,6 +25,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'ls-lisp)
(require 'dired)
@ -59,22 +60,22 @@
(ert-deftest ls-lisp-test-bug27631 ()
"Test for https://debbugs.gnu.org/27631 ."
(let* ((dir (make-temp-file "bug27631" 'dir))
(dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(progn
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-with-temp-directory dir
:suffix "bug27631"
(let* ((dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(progn
(make-directory dir1)
(make-directory dir2)
(with-temp-file (expand-file-name "a.txt" dir1))
(with-temp-file (expand-file-name "b.txt" dir2))
(setq buf (dired (expand-file-name "dir*/*.txt" dir)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest ls-lisp-test-bug27693 ()
"Test for https://debbugs.gnu.org/27693 ."

View file

@ -50,14 +50,11 @@ Same as `uudecode-tests-encoded-str' but plain text.")
(should (equal (buffer-string) uudecode-tests-decoded-str)))
;; Write to file
(with-temp-buffer
(let ((tmpfile (make-temp-file "uudecode-tests-")))
(unwind-protect
(progn
(insert uudecode-tests-encoded-str)
(uudecode-decode-region-internal (point-min) (point-max) tmpfile)
(should (equal (uudecode-tests-read-file tmpfile)
uudecode-tests-decoded-str)))
(delete-file tmpfile)))))
(ert-with-temp-file tmpfile
(insert uudecode-tests-encoded-str)
(uudecode-decode-region-internal (point-min) (point-max) tmpfile)
(should (equal (uudecode-tests-read-file tmpfile)
uudecode-tests-decoded-str)))))
(ert-deftest uudecode-tests-decode-region-external ()
;; Write to buffer
@ -68,14 +65,11 @@ Same as `uudecode-tests-encoded-str' but plain text.")
(should (equal (buffer-string) uudecode-tests-decoded-str)))
;; Write to file
(with-temp-buffer
(let ((tmpfile (make-temp-file "uudecode-tests-")))
(unwind-protect
(progn
(insert uudecode-tests-encoded-str)
(uudecode-decode-region-external (point-min) (point-max) tmpfile)
(should (equal (uudecode-tests-read-file tmpfile)
uudecode-tests-decoded-str)))
(delete-file tmpfile))))))
(ert-with-temp-file tmpfile
(insert uudecode-tests-encoded-str)
(uudecode-decode-region-external (point-min) (point-max) tmpfile)
(should (equal (uudecode-tests-read-file tmpfile)
uudecode-tests-decoded-str))))))
(provide 'uudecode-tests)
;;; uudecode-tests.el ends here

View file

@ -28,6 +28,7 @@
(require 'browse-url)
(require 'ert)
(require 'ert-x)
(ert-deftest browse-url-tests-browser-kind ()
(should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org")
@ -87,11 +88,10 @@
"ftp://foo/")))
(ert-deftest browse-url-tests-delete-temp-file ()
(let ((browse-url-temp-file-name
(make-temp-file "browse-url-tests-")))
(ert-with-temp-file browse-url-temp-file-name
(browse-url-delete-temp-file)
(should-not (file-exists-p browse-url-temp-file-name)))
(let ((file (make-temp-file "browse-url-tests-")))
(ert-with-temp-file file
(browse-url-delete-temp-file file)
(should-not (file-exists-p file))))

View file

@ -302,12 +302,9 @@
;; tmp may be on a different filesystem to the tests, but, ehh.
(defvar xref--case-insensitive
(let ((dir (make-temp-file "xref-test" t)))
(unwind-protect
(progn
(with-temp-file (expand-file-name "hElLo" dir) "hello")
(file-exists-p (expand-file-name "HELLO" dir)))
(delete-directory dir t)))
(ert-with-temp-directory dir
(with-temp-file (expand-file-name "hElLo" dir) "hello")
(file-exists-p (expand-file-name "HELLO" dir)))
"Non-nil if file system seems to be case-insensitive.")
(defun xref-elisp-test-run (xrefs expected-xrefs)

View file

@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'etags)
(eval-when-compile (require 'cl-lib))
@ -95,21 +96,19 @@
(ert-deftest etags-buffer-local-tags-table-list ()
"Test that a buffer-local value of `tags-table-list' is used."
(let ((file (make-temp-file "etag-test-tmpfile")))
(unwind-protect
(progn
(set-buffer (find-file-noselect file))
(fundamental-mode)
(setq-local tags-table-list
(list (expand-file-name "manual/etags/ETAGS.good_3"
etags-tests--test-dir)))
(cl-letf ((tag-tables tags-table-list)
(tags-file-name nil)
((symbol-function 'read-file-name)
(lambda (&rest _)
(error "We should not prompt the user"))))
(should (visit-tags-table-buffer))
(should (equal tags-file-name (car tag-tables)))))
(delete-file file))))
(ert-with-temp-file file
:suffix "etag-test-tmpfile"
(set-buffer (find-file-noselect file))
(fundamental-mode)
(setq-local tags-table-list
(list (expand-file-name "manual/etags/ETAGS.good_3"
etags-tests--test-dir)))
(cl-letf ((tag-tables tags-table-list)
(tags-file-name nil)
((symbol-function 'read-file-name)
(lambda (&rest _)
(error "We should not prompt the user"))))
(should (visit-tags-table-buffer))
(should (equal tags-file-name (car tag-tables))))))
;;; etags-tests.el ends here

View file

@ -23,6 +23,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'flymake)
(eval-when-compile (require 'subr-x)) ; string-trim
@ -123,22 +124,21 @@ SEVERITY-PREDICATE is used to setup
"Test the ruby backend."
(skip-unless (executable-find "ruby"))
;; Some versions of ruby fail if HOME doesn't exist (bug#29187).
(let* ((tempdir (make-temp-file "flymake-tests-ruby" t))
(process-environment (cons (format "HOME=%s" tempdir)
process-environment))
;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20
;; for this particular yuckiness
(abbreviated-home-dir nil))
(unwind-protect
(let ((ruby-mode-hook
(lambda ()
(setq flymake-diagnostic-functions '(ruby-flymake-simple)))))
(flymake-tests--with-flymake ("test.rb")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))))
(delete-directory tempdir t))))
(ert-with-temp-directory tempdir
:suffix "flymake-tests-ruby"
(let* ((process-environment (cons (format "HOME=%s" tempdir)
process-environment))
;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20
;; for this particular yuckiness
(abbreviated-home-dir nil)
(ruby-mode-hook
(lambda ()
(setq flymake-diagnostic-functions '(ruby-flymake-simple)))))
(flymake-tests--with-flymake ("test.rb")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))))))
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."

View file

@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'python)
;; Dependencies for testing:
@ -48,17 +49,17 @@ BODY is code to be executed within the temp buffer. Point is
always located at the beginning of buffer."
(declare (indent 1) (debug t))
;; temp-file never actually used for anything?
`(let* ((temp-file (make-temp-file "python-tests" nil ".py"))
(buffer (find-file-noselect temp-file))
(python-indent-guess-indent-offset nil))
(unwind-protect
(with-current-buffer buffer
(python-mode)
(insert ,contents)
(goto-char (point-min))
,@body)
(and buffer (kill-buffer buffer))
(delete-file temp-file))))
`(ert-with-temp-file temp-file
:suffix "-python.py"
(let ((buffer (find-file-noselect temp-file))
(python-indent-guess-indent-offset nil))
(unwind-protect
(with-current-buffer buffer
(python-mode)
(insert ,contents)
(goto-char (point-min))
,@body)
(and buffer (kill-buffer buffer))))))
(defun python-tests-look-at (string &optional num restore-point)
"Move point at beginning of STRING in the current buffer.

View file

@ -28,6 +28,7 @@
(require 'cl-lib)
(require 'ert)
(require 'ert-x)
(require 'sql)
(ert-deftest sql-tests-postgres-list-databases ()
@ -63,52 +64,49 @@ Identify tests by ID. Set :sql-login dialect attribute to
LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED
string of values passed to the comint function for validation."
(declare (indent 2))
`(cl-letf
((sql-test-login-params ' ,login-params)
((symbol-function 'sql-comint-test)
(lambda (product options &optional buf-name)
(with-current-buffer (get-buffer-create buf-name)
(insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
((symbol-function 'sql-run-test)
(lambda (&optional buffer)
(interactive "P")
(sql-product-interactive 'sqltest buffer)))
(sql-user nil)
(sql-server nil)
(sql-database nil)
(sql-product-alist
'((ansi)
(sqltest
:name "SqlTest"
:sqli-login sql-test-login-params
:sqli-comint-func sql-comint-test)))
(sql-connection-alist
'((,(format "test-%s" id)
,@connection)))
(sql-password-wallet
(list
(make-temp-file
"sql-test-netrc" nil nil
(mapconcat #'identity
'("machine aMachine user aUserName password \"netrc-A aPassword\""
"machine aServer user aUserName password \"netrc-B aPassword\""
"machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
"machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
"machine aDatabase user aUserName password \"netrc-E aPassword\""
"machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
"machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
) "\n")))))
(let* ((connection ,(format "test-%s" id))
(buffername (format "*SQL: ERT TEST <%s>*" connection)))
(when (get-buffer buffername)
(kill-buffer buffername))
(sql-connect connection buffername)
(should (get-buffer buffername))
(should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
(when (get-buffer buffername)
(kill-buffer buffername))
(delete-file (car sql-password-wallet)))))
`(ert-with-temp-file tempfile
:suffix "sql-test-netrc"
:text (concat
"machine aMachine user aUserName password \"netrc-A aPassword\""
"machine aServer user aUserName password \"netrc-B aPassword\""
"machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
"machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
"machine aDatabase user aUserName password \"netrc-E aPassword\""
"machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
"machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
"\n")
(cl-letf
((sql-test-login-params ' ,login-params)
((symbol-function 'sql-comint-test)
(lambda (product options &optional buf-name)
(with-current-buffer (get-buffer-create buf-name)
(insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
((symbol-function 'sql-run-test)
(lambda (&optional buffer)
(interactive "P")
(sql-product-interactive 'sqltest buffer)))
(sql-user nil)
(sql-server nil)
(sql-database nil)
(sql-product-alist
'((ansi)
(sqltest
:name "SqlTest"
:sqli-login sql-test-login-params
:sqli-comint-func sql-comint-test)))
(sql-connection-alist
'((,(format "test-%s" id)
,@connection)))
(sql-password-wallet (list tempfile)))
(let* ((connection ,(format "test-%s" id))
(buffername (format "*SQL: ERT TEST <%s>*" connection)))
(when (get-buffer buffername)
(kill-buffer buffername))
(sql-connect connection buffername)
(should (get-buffer buffername))
(should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
(when (get-buffer buffername)
(kill-buffer buffername))))))
(ert-deftest sql-test-connect ()
"Test of basic `sql-connect'."

View file

@ -41,49 +41,42 @@
(ert-deftest saveplace-test-save-place-to-alist/file ()
(save-place-mode)
(let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
(tmpfile (file-truename tmpfile))
(save-place-alist nil)
(save-place-loaded t)
(loc tmpfile)
(pos 4))
(unwind-protect
(save-window-excursion
(find-file loc)
(insert "abc") ; must insert something
(save-place-to-alist)
(should (equal save-place-alist (list (cons tmpfile pos)))))
(delete-file tmpfile))))
(ert-with-temp-file tmpfile
(let* ((tmpfile (file-truename tmpfile))
(save-place-alist nil)
(save-place-loaded t)
(loc tmpfile)
(pos 4))
(save-window-excursion
(find-file loc)
(insert "abc") ; must insert something
(save-place-to-alist)
(should (equal save-place-alist (list (cons tmpfile pos))))))))
(ert-deftest saveplace-test-forget-unreadable-files ()
(save-place-mode)
(let* ((save-place-loaded t)
(tmpfile (make-temp-file "emacs-test-saveplace-"))
(alist-orig (list (cons "/this/file/does/not/exist" 10)
(cons tmpfile 1917)))
(save-place-alist alist-orig))
(unwind-protect
(progn
(save-place-forget-unreadable-files)
(should (equal save-place-alist (cdr alist-orig))))
(delete-file tmpfile))))
(ert-with-temp-file tmpfile
:suffix "-saveplace"
(let* ((save-place-loaded t)
(alist-orig (list (cons "/this/file/does/not/exist" 10)
(cons tmpfile 1917)))
(save-place-alist alist-orig))
(save-place-forget-unreadable-files)
(should (equal save-place-alist (cdr alist-orig))))))
(ert-deftest saveplace-test-place-alist-to-file ()
(save-place-mode)
(let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
(tmpfile2 (make-temp-file "emacs-test-saveplace-"))
(save-place-file tmpfile)
(save-place-alist (list (cons tmpfile2 99))))
(unwind-protect
(progn (save-place-alist-to-file)
(setq save-place-alist nil)
(save-window-excursion
(find-file save-place-file)
(unwind-protect
(should (string-match tmpfile2 (buffer-string)))
(kill-buffer))))
(delete-file tmpfile)
(delete-file tmpfile2))))
(ert-with-temp-file tmpfile
(ert-with-temp-file tmpfile2
(let* ((save-place-file tmpfile)
(save-place-alist (list (cons tmpfile2 99))))
(save-place-alist-to-file)
(setq save-place-alist nil)
(save-window-excursion
(find-file save-place-file)
(unwind-protect
(should (string-match tmpfile2 (buffer-string)))
(kill-buffer)))))))
(ert-deftest saveplace-test-load-alist-from-file ()
(save-place-mode)

View file

@ -23,6 +23,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'ispell)
(require 'cl-lib)
@ -50,20 +51,19 @@
;; The Emacs test Makefile's use of HOME=/nonexistent triggers an error
;; when starting the inferior ispell process, so we set HOME to a valid
;; (but empty) temporary directory for this test.
(let* ((tmpdir (make-temp-file "so-long." :dir ".ispell"))
(process-environment (cons (format "HOME=%s" tmpdir)
process-environment))
(find-spelling-mistake
(unwind-protect
(cl-letf (((symbol-function 'ispell-command-loop)
(lambda (_miss _guess word _start _end)
(message "Unrecognised word: %s." word)
(throw 'mistake t))))
(catch 'mistake
(find-library "so-long")
(ispell-buffer)
nil))
(delete-directory tmpdir))))
(should (not find-spelling-mistake)))))
(ert-with-temp-file tmpdir
:suffix "so-long.ispell"
(let* ((process-environment (cons (format "HOME=%s" tmpdir)
process-environment))
(find-spelling-mistake
(cl-letf (((symbol-function 'ispell-command-loop)
(lambda (_miss _guess word _start _end)
(message "Unrecognised word: %s." word)
(throw 'mistake t))))
(catch 'mistake
(find-library "so-long")
(ispell-buffer)
nil))))
(should (not find-spelling-mistake))))))
;;; spelling-tests.el ends here

View file

@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
;;; reftex
(require 'reftex)
@ -33,32 +34,31 @@
(ert-deftest reftex-locate-bibliography-files ()
"Test `reftex-locate-bibliography-files'."
(let ((temp-dir (make-temp-file "reftex-bib" 'dir))
(files '("ref1.bib" "ref2.bib"))
(test '(("\\addbibresource{ref1.bib}\n" . ("ref1.bib"))
("\\\\addbibresource[label=x]{ref2.bib}\\n" . ("ref2.bib"))
("\\begin{document}\n\\bibliographystyle{plain}\n
(ert-with-temp-directory temp-dir
(let ((files '("ref1.bib" "ref2.bib"))
(test '(("\\addbibresource{ref1.bib}\n" . ("ref1.bib"))
("\\\\addbibresource[label=x]{ref2.bib}\\n" . ("ref2.bib"))
("\\begin{document}\n\\bibliographystyle{plain}\n
\\bibliography{ref1,ref2}\n\\end{document}" . ("ref1.bib" "ref2.bib"))))
(reftex-bibliography-commands
;; Default value: See reftex-vars.el `reftex-bibliography-commands'
'("bibliography" "nobibliography" "setupbibtex\\[.*?database="
"addbibresource")))
(with-temp-buffer
(insert "test\n")
(reftex-bibliography-commands
;; Default value: See reftex-vars.el `reftex-bibliography-commands'
'("bibliography" "nobibliography" "setupbibtex\\[.*?database="
"addbibresource")))
(with-temp-buffer
(insert "test\n")
(mapc
(lambda (file)
(write-region (point-min) (point-max) (expand-file-name file
temp-dir)))
files))
(mapc
(lambda (file)
(write-region (point-min) (point-max) (expand-file-name file
temp-dir)))
files))
(mapc
(lambda (data)
(with-temp-buffer
(insert (car data))
(let ((res (mapcar #'file-name-nondirectory
(reftex-locate-bibliography-files temp-dir))))
(should (equal res (cdr data))))))
test)
(delete-directory temp-dir 'recursive)))
(lambda (data)
(with-temp-buffer
(insert (car data))
(let ((res (mapcar #'file-name-nondirectory
(reftex-locate-bibliography-files temp-dir))))
(should (equal res (cdr data))))))
test))))
(ert-deftest reftex-what-environment-test ()
"Test `reftex-what-environment'."
@ -102,12 +102,12 @@
;; reason. (An alternative solution would be to use file-equal-p,
;; but I'm too lazy to do that, as one of the tests compares a
;; list.)
(let* ((temp-dir (file-truename (make-temp-file "reftex-parse" 'dir)))
(tex-file (expand-file-name "test.tex" temp-dir))
(bib-file (expand-file-name "ref.bib" temp-dir)))
(with-temp-buffer
(insert
"\\begin{document}
(ert-with-temp-directory temp-dir
(let* ((tex-file (expand-file-name "test.tex" temp-dir))
(bib-file (expand-file-name "ref.bib" temp-dir)))
(with-temp-buffer
(insert
"\\begin{document}
\\section{test}\\label{sec:test}
\\subsection{subtest}
@ -118,27 +118,26 @@
\\bibliographystyle{plain}
\\bibliography{ref}
\\end{document}")
(write-region (point-min) (point-max) tex-file))
(with-temp-buffer
(insert "test\n")
(write-region (point-min) (point-max) bib-file))
(reftex-ensure-compiled-variables)
(let ((parsed (reftex-parse-from-file tex-file nil temp-dir)))
(should (equal (car parsed) `(eof ,tex-file)))
(pop parsed)
(while parsed
(let ((entry (pop parsed)))
(cond
((eq (car entry) 'bib)
(should (string= (cadr entry) bib-file)))
((eq (car entry) 'toc)) ;; ...
((string= (car entry) "eq:foo"))
((string= (car entry) "sec:test"))
((eq (car entry) 'bof)
(should (string= (cadr entry) tex-file))
(should (null parsed)))
(t (should-not t)))))
(delete-directory temp-dir 'recursive))))
(write-region (point-min) (point-max) tex-file))
(with-temp-buffer
(insert "test\n")
(write-region (point-min) (point-max) bib-file))
(reftex-ensure-compiled-variables)
(let ((parsed (reftex-parse-from-file tex-file nil temp-dir)))
(should (equal (car parsed) `(eof ,tex-file)))
(pop parsed)
(while parsed
(let ((entry (pop parsed)))
(cond
((eq (car entry) 'bib)
(should (string= (cadr entry) bib-file)))
((eq (car entry) 'toc)) ;; ...
((string= (car entry) "eq:foo"))
((string= (car entry) "sec:test"))
((eq (car entry) 'bof)
(should (string= (cadr entry) tex-file))
(should (null parsed)))
(t (should-not t)))))))))
;;; reftex-cite
(require 'reftex-cite)

View file

@ -20,15 +20,13 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'thumbs)
(ert-deftest thumbs-tests-thumbsdir/create-if-missing ()
(let ((thumbs-thumbsdir (make-temp-file "thumbs-test" t)))
(unwind-protect
(progn
(delete-directory thumbs-thumbsdir)
(should (file-directory-p (thumbs-thumbsdir))))
(delete-directory thumbs-thumbsdir))))
(ert-with-temp-directory thumbs-thumbsdir
(delete-directory thumbs-thumbsdir)
(should (file-directory-p (thumbs-thumbsdir)))))
(provide 'thumbs-tests)
;;; thumbs-tests.el ends here

View file

@ -173,35 +173,33 @@ wristwatches
wrongheadedly
wrongheadedness
youthfulness
")
(temp-dir (make-temp-file "diff-mode-test" 'dir)))
"))
(ert-with-temp-directory temp-dir
(let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
(buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
(unwind-protect
(progn
(with-current-buffer buf (insert fil_before) (save-buffer))
(with-current-buffer buf2 (insert fil2_before) (save-buffer))
(let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
(buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
(unwind-protect
(progn
(with-current-buffer buf (insert fil_before) (save-buffer))
(with-current-buffer buf2 (insert fil2_before) (save-buffer))
(with-temp-buffer
(cd temp-dir)
(insert patch)
(goto-char (point-min))
(diff-apply-hunk)
(diff-apply-hunk)
(diff-apply-hunk))
(with-temp-buffer
(cd temp-dir)
(insert patch)
(goto-char (point-min))
(diff-apply-hunk)
(diff-apply-hunk)
(diff-apply-hunk))
(should (equal (with-current-buffer buf (buffer-string))
fil_after))
(should (equal (with-current-buffer buf2 (buffer-string))
fil2_after)))
(should (equal (with-current-buffer buf (buffer-string))
fil_after))
(should (equal (with-current-buffer buf2 (buffer-string))
fil2_after)))
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)
(with-current-buffer buf2 (set-buffer-modified-p nil))
(kill-buffer buf2)
(delete-directory temp-dir 'recursive))))))
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)
(with-current-buffer buf2 (set-buffer-modified-p nil))
(kill-buffer buf2)))))))
(ert-deftest diff-mode-test-hunk-text-no-newline ()
"Check output of `diff-hunk-text' with no newline at end of file."

View file

@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'ediff-ptch)
(ert-deftest ediff-ptch-test-bug25010 ()
@ -45,34 +46,33 @@ index 6a07f80..6e8e947 100644
"Test for https://debbugs.gnu.org/26084 ."
(skip-unless (executable-find "git"))
(skip-unless (executable-find ediff-patch-program))
(let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
(default-directory (file-name-as-directory tmpdir))
(patch (make-temp-file "ediff-ptch-test"))
(qux (expand-file-name "qux.txt" tmpdir))
(bar (expand-file-name "bar.txt" tmpdir))
(git-program (executable-find "git")))
;; Create repository.
(with-temp-buffer
(insert "qux here\n")
(write-region nil nil qux nil 'silent)
(erase-buffer)
(insert "bar here\n")
(write-region nil nil bar nil 'silent))
(call-process git-program nil nil nil "init")
(call-process git-program nil nil nil "add" ".")
(call-process git-program nil nil nil "commit" "-m" "Test repository.")
;; Update repo., save the diff and reset to initial state.
(with-temp-buffer
(insert "foo here\n")
(write-region nil nil qux nil 'silent)
(write-region nil nil bar nil 'silent))
(call-process git-program nil `(:file ,patch) nil "diff")
(call-process git-program nil nil nil "reset" "--hard" "HEAD")
;; Visit the diff file i.e., patch; extract from it the parts
;; affecting just each of the files: store in patch-bar the part
;; affecting 'bar', and in patch-qux the part affecting 'qux'.
(find-file patch)
(unwind-protect
(ert-with-temp-directory tmpdir
(ert-with-temp-file patch
(let* ((default-directory (file-name-as-directory tmpdir))
(qux (expand-file-name "qux.txt" tmpdir))
(bar (expand-file-name "bar.txt" tmpdir))
(git-program (executable-find "git")))
;; Create repository.
(with-temp-buffer
(insert "qux here\n")
(write-region nil nil qux nil 'silent)
(erase-buffer)
(insert "bar here\n")
(write-region nil nil bar nil 'silent))
(call-process git-program nil nil nil "init")
(call-process git-program nil nil nil "add" ".")
(call-process git-program nil nil nil "commit" "-m" "Test repository.")
;; Update repo., save the diff and reset to initial state.
(with-temp-buffer
(insert "foo here\n")
(write-region nil nil qux nil 'silent)
(write-region nil nil bar nil 'silent))
(call-process git-program nil `(:file ,patch) nil "diff")
(call-process git-program nil nil nil "reset" "--hard" "HEAD")
;; Visit the diff file i.e., patch; extract from it the parts
;; affecting just each of the files: store in patch-bar the part
;; affecting 'bar', and in patch-qux the part affecting 'qux'.
(find-file patch)
(let* ((info
(progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map))
(patch-bar
@ -116,9 +116,7 @@ index 6a07f80..6e8e947 100644
(buffer-string))
(with-temp-buffer
(insert-file-contents backup)
(buffer-string)))))))
(delete-directory tmpdir 'recursive)
(delete-file patch)))))
(buffer-string))))))))))))
(provide 'ediff-ptch-tests)

View file

@ -25,6 +25,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'vc-bzr)
(require 'vc-dir)
@ -51,106 +52,97 @@
;; temporary directory.
;; TODO does this means tests should be setting XDG_ variables (not
;; just HOME) to temporary values too?
(let* ((homedir (make-temp-file "vc-bzr-test" t))
(bzrdir (expand-file-name "bzr" homedir))
(ignored-dir (progn
(make-directory bzrdir)
(expand-file-name "ignored-dir" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
(make-directory ignored-dir)
(with-temp-buffer
(insert (file-name-nondirectory ignored-dir))
(write-region nil nil (expand-file-name ".bzrignore" bzrdir)
nil 'silent))
(skip-unless (eq 0 ; some internal bzr error
(call-process vc-bzr-program nil nil nil "init")))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
(with-temp-buffer
(insert "unregistered file")
(write-region nil nil (expand-file-name "testfile2" ignored-dir)
nil 'silent))
(vc-dir ignored-dir)
(while (vc-dir-busy)
(sit-for 0.1))
;; FIXME better to explicitly test for error from process sentinel.
(with-current-buffer "*vc-dir*"
(goto-char (point-min))
(should (search-forward "unregistered" nil t))))
(delete-directory homedir t))))
(ert-with-temp-directory homedir
(let* ((bzrdir (expand-file-name "bzr" homedir))
(ignored-dir (progn
(make-directory bzrdir)
(expand-file-name "ignored-dir" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(make-directory ignored-dir)
(with-temp-buffer
(insert (file-name-nondirectory ignored-dir))
(write-region nil nil (expand-file-name ".bzrignore" bzrdir)
nil 'silent))
(skip-unless (eq 0 ; some internal bzr error
(call-process vc-bzr-program nil nil nil "init")))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
(with-temp-buffer
(insert "unregistered file")
(write-region nil nil (expand-file-name "testfile2" ignored-dir)
nil 'silent))
(vc-dir ignored-dir)
(while (vc-dir-busy)
(sit-for 0.1))
;; FIXME better to explicitly test for error from process sentinel.
(with-current-buffer "*vc-dir*"
(goto-char (point-min))
(should (search-forward "unregistered" nil t))))))
;; Not specific to bzr.
(ert-deftest vc-bzr-test-bug9781 ()
"Test for https://debbugs.gnu.org/9781 ."
(skip-unless (executable-find vc-bzr-program))
(let* ((homedir (make-temp-file "vc-bzr-test" t))
(bzrdir (expand-file-name "bzr" homedir))
(subdir (progn
(make-directory bzrdir)
(expand-file-name "subdir" bzrdir)))
(file (expand-file-name "file" bzrdir))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
(skip-unless (eq 0 ; some internal bzr error
(call-process vc-bzr-program nil nil nil "init")))
(make-directory subdir)
(with-temp-buffer
(insert "text")
(write-region nil nil file nil 'silent)
(write-region nil nil (expand-file-name "subfile" subdir)
nil 'silent))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
(call-process vc-bzr-program nil nil nil "remove" subdir)
(with-temp-buffer
(insert "different text")
(write-region nil nil file nil 'silent))
(vc-dir bzrdir)
(while (vc-dir-busy)
(sit-for 0.1))
(vc-dir-mark-all-files t)
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t)))
(vc-next-action nil))
(should (get-buffer "*vc-log*")))
(delete-directory homedir t))))
(ert-with-temp-directory homedir
(let* ((bzrdir (expand-file-name "bzr" homedir))
(subdir (progn
(make-directory bzrdir)
(expand-file-name "subdir" bzrdir)))
(file (expand-file-name "file" bzrdir))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(skip-unless (eq 0 ; some internal bzr error
(call-process vc-bzr-program nil nil nil "init")))
(make-directory subdir)
(with-temp-buffer
(insert "text")
(write-region nil nil file nil 'silent)
(write-region nil nil (expand-file-name "subfile" subdir)
nil 'silent))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
(call-process vc-bzr-program nil nil nil "remove" subdir)
(with-temp-buffer
(insert "different text")
(write-region nil nil file nil 'silent))
(vc-dir bzrdir)
(while (vc-dir-busy)
(sit-for 0.1))
(vc-dir-mark-all-files t)
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t)))
(vc-next-action nil))
(should (get-buffer "*vc-log*")))))
;; https://lists.gnu.org/r/help-gnu-emacs/2012-04/msg00145.html
(ert-deftest vc-bzr-test-faulty-bzr-autoloads ()
"Test we can generate autoloads in a bzr directory when bzr is faulty."
(skip-unless (executable-find vc-bzr-program))
(let* ((homedir (make-temp-file "vc-bzr-test" t))
(bzrdir (expand-file-name "bzr" homedir))
(file (progn
(make-directory bzrdir)
(expand-file-name "foo.el" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
(progn
(call-process vc-bzr-program nil nil nil "init")
(with-temp-buffer
(insert ";;;###autoload
(ert-with-temp-directory homedir
(let* ((bzrdir (expand-file-name "bzr" homedir))
(file (progn
(make-directory bzrdir)
(expand-file-name "foo.el" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(call-process vc-bzr-program nil nil nil "init")
(with-temp-buffer
(insert ";;;###autoload
\(defun foo () \"foo\" (interactive) (message \"foo!\"))")
(write-region nil nil file nil 'silent))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
;; Deleting dirstate ensures both that vc-bzr's status heuristic
;; fails, so it has to call the external bzr status, and
;; causes bzr status to fail. This simulates a broken bzr
;; installation.
(delete-file ".bzr/checkout/dirstate")
(should (progn (make-directory-autoloads
default-directory
(expand-file-name "loaddefs.el" bzrdir))
t)))
(delete-directory homedir t))))
(write-region nil nil file nil 'silent))
(call-process vc-bzr-program nil nil nil "add")
(call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
;; Deleting dirstate ensures both that vc-bzr's status heuristic
;; fails, so it has to call the external bzr status, and
;; causes bzr status to fail. This simulates a broken bzr
;; installation.
(delete-file ".bzr/checkout/dirstate")
(should (progn (make-directory-autoloads
default-directory
(expand-file-name "loaddefs.el" bzrdir))
t)))))
;;; vc-bzr-tests.el ends here

View file

@ -20,6 +20,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'dired)
(require 'wdired)
@ -28,104 +29,100 @@
(ert-deftest wdired-test-bug32173-01 ()
"Test using non-nil wdired-use-interactive-rename.
Partially modifying a file name should succeed."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert replace)
(wdired-finish-edit)
(should (equal (dired-file-name-at-point) new-file)))
(if buf (kill-buffer buf))
(delete-directory test-dir t)))))
(ert-with-temp-directory test-dir
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert replace)
(wdired-finish-edit)
(should (equal (dired-file-name-at-point) new-file)))
(if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-bug32173-02 ()
"Test using non-nil wdired-use-interactive-rename.
Aborting an edit should leaving original file name unchanged."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
;; Make dired-do-create-files-regexp a noop to mimic typing C-g
;; at its prompt before wdired-finish-edit returns.
(advice-add 'dired-do-create-files-regexp
:override
(lambda (&rest _) (ignore))
'((name . "advice-dired-do-create-files-regexp")))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert "bar")
(wdired-finish-edit)
(should (equal (dired-get-filename) test-file)))
(if buf (kill-buffer buf))
(delete-directory test-dir t)))))
(ert-with-temp-directory test-dir
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
;; Make dired-do-create-files-regexp a noop to mimic typing C-g
;; at its prompt before wdired-finish-edit returns.
(advice-add 'dired-do-create-files-regexp
:override
(lambda (&rest _) (ignore))
'((name . "advice-dired-do-create-files-regexp")))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert "bar")
(wdired-finish-edit)
(should (equal (dired-get-filename) test-file)))
(if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-symlink-name ()
"Test the file name of a symbolic link.
The Dired and WDired functions returning the name should include
only the name before the link arrow."
(let* ((test-dir (make-temp-file "test-dir-" t))
(link-name "foo"))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(skip-unless
;; This check is for wdired, not symbolic links, so skip
;; it when make-symbolic-link fails for any reason (like
;; insufficient privileges).
(ignore-errors (make-symbolic-link "./bar/baz" link-name) t))
(revert-buffer)
(let* ((file-name (dired-get-filename))
(dir-part (file-name-directory file-name))
(lf-name (concat dir-part link-name)))
(should (equal file-name lf-name))
(dired-toggle-read-only)
(should (equal (wdired-get-filename) lf-name))
(dired-toggle-read-only)))
(if buf (kill-buffer buf))
(delete-directory test-dir t)))))
(ert-with-temp-directory test-dir
(let* ((link-name "foo"))
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(skip-unless
;; This check is for wdired, not symbolic links, so skip
;; it when make-symbolic-link fails for any reason (like
;; insufficient privileges).
(ignore-errors (make-symbolic-link "./bar/baz" link-name) t))
(revert-buffer)
(let* ((file-name (dired-get-filename))
(dir-part (file-name-directory file-name))
(lf-name (concat dir-part link-name)))
(should (equal file-name lf-name))
(dired-toggle-read-only)
(should (equal (wdired-get-filename) lf-name))
(dired-toggle-read-only)))
(if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-unfinished-edit-01 ()
"Test editing a file name without saving the change.
Finding the new name should be possible while still in
wdired-mode."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file)))
(write-region "" nil test-file nil 'silent)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert replace)
(should (equal (dired-get-filename) new-file)))
(when buf
(with-current-buffer buf
;; Prevent kill-buffer-query-functions from chiming in.
(set-buffer-modified-p nil)
(kill-buffer buf)))
(delete-directory test-dir t)))))
(ert-with-temp-directory test-dir
(let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
(new-file (string-replace "foo" replace test-file)))
(write-region "" nil test-file nil 'silent)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(should (equal (dired-file-name-at-point) test-file))
(dired-toggle-read-only)
(kill-region (point) (progn (search-forward ".")
(forward-char -1) (point)))
(insert replace)
(should (equal (dired-get-filename) new-file)))
(when buf
(with-current-buffer buf
;; Prevent kill-buffer-query-functions from chiming in.
(set-buffer-modified-p nil)
(kill-buffer buf))))))))
(defvar server-socket-dir)
(declare-function dired-smart-shell-command "dired-x"
@ -139,61 +136,59 @@ dired-move-to-end-of-filename handles indicator characters, it
suffices to compare the return values of dired-get-filename and
wdired-get-filename before and after editing."
;; FIXME: Add a test for a door (indicator ">") only under Solaris?
(let* ((test-dir (make-temp-file "test-dir-" t))
(server-socket-dir test-dir)
(dired-listing-switches "-Fl")
(dired-ls-F-marks-symlinks (eq system-type 'darwin))
(buf (find-file-noselect test-dir)))
(unwind-protect
(progn
(with-current-buffer buf
(dired-create-empty-file "foo")
(set-file-modes "foo" (file-modes-symbolic-to-number "+x"))
(make-symbolic-link "foo" "bar")
(make-directory "foodir")
(require 'dired-x)
(dired-smart-shell-command "mkfifo foopipe")
(server-force-delete)
;; FIXME? This seems a heavy-handed way of making a socket.
(server-start) ; Add a socket file.
(kill-buffer buf))
(dired test-dir)
(dired-toggle-read-only)
(let (names)
;; Test that the file names are the same in Dired and WDired.
(while (not (eobp))
(should (equal (dired-get-filename 'no-dir t)
(wdired-get-filename t)))
(insert "w")
(push (wdired-get-filename t) names)
(dired-next-line 1))
(wdired-finish-edit)
;; Test that editing the file names ignores the indicator
;; character.
(let (dir)
(while (and (dired-previous-line 1)
(setq dir (dired-get-filename 'no-dir t)))
(should (equal dir (pop names)))))))
(kill-buffer (get-buffer test-dir))
(server-force-delete)
(delete-directory test-dir t))))
(ert-with-temp-directory test-dir
(let* ((server-socket-dir test-dir)
(dired-listing-switches "-Fl")
(dired-ls-F-marks-symlinks (eq system-type 'darwin))
(buf (find-file-noselect test-dir)))
(unwind-protect
(progn
(with-current-buffer buf
(dired-create-empty-file "foo")
(set-file-modes "foo" (file-modes-symbolic-to-number "+x"))
(make-symbolic-link "foo" "bar")
(make-directory "foodir")
(require 'dired-x)
(dired-smart-shell-command "mkfifo foopipe")
(server-force-delete)
;; FIXME? This seems a heavy-handed way of making a socket.
(server-start) ; Add a socket file.
(kill-buffer buf))
(dired test-dir)
(dired-toggle-read-only)
(let (names)
;; Test that the file names are the same in Dired and WDired.
(while (not (eobp))
(should (equal (dired-get-filename 'no-dir t)
(wdired-get-filename t)))
(insert "w")
(push (wdired-get-filename t) names)
(dired-next-line 1))
(wdired-finish-edit)
;; Test that editing the file names ignores the indicator
;; character.
(let (dir)
(while (and (dired-previous-line 1)
(setq dir (dired-get-filename 'no-dir t)))
(should (equal dir (pop names)))))))
(kill-buffer (get-buffer test-dir))
(server-force-delete)))))
(ert-deftest wdired-test-bug39280 ()
"Test for https://debbugs.gnu.org/39280."
(let* ((test-dir (make-temp-file "test-dir" 'dir))
(fname "foo")
(full-fname (expand-file-name fname test-dir)))
(make-empty-file full-fname)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(dired-toggle-read-only)
(dolist (old '(t nil))
(should (equal fname (wdired-get-filename 'nodir old)))
(should (equal full-fname (wdired-get-filename nil old))))
(wdired-finish-edit))
(if buf (kill-buffer buf))
(delete-directory test-dir t)))))
(ert-with-temp-directory test-dir
(let* ((fname "foo")
(full-fname (expand-file-name fname test-dir)))
(make-empty-file full-fname)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
(with-current-buffer buf
(dired-toggle-read-only)
(dolist (old '(t nil))
(should (equal fname (wdired-get-filename 'nodir old)))
(should (equal full-fname (wdired-get-filename nil old))))
(wdired-finish-edit))
(if buf (kill-buffer buf)))))))
(provide 'wdired-tests)
;;; wdired-tests.el ends here

View file

@ -19,6 +19,8 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'cl-lib)
(ert-deftest overlay-modification-hooks-message-other-buf ()
@ -1421,25 +1423,23 @@ with parameters from the *Messages* buffer modification."
(should (= (length (overlays-in (point-min) (point-max))) 0))))
(ert-deftest test-kill-buffer-auto-save-default ()
(let ((file (make-temp-file "ert"))
auto-save)
(should (file-exists-p file))
;; 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))
(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)
;; 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))
(kill-buffer (current-buffer))
(should (file-exists-p auto-save)))
(when auto-save
(ignore-errors (delete-file auto-save))))))))
(ert-deftest test-kill-buffer-auto-save-delete ()
(let ((file (make-temp-file "ert"))

View file

@ -28,6 +28,7 @@
(require 'cl-macs)
(require 'ert)
(require 'ert-x)
(require 'seq)
(defun filelock-tests--fixture (test-function)
@ -36,22 +37,20 @@ Create a test directory and a buffer whose `buffer-file-name' and
`buffer-file-truename' are a file within it, then call
TEST-FUNCTION. Finally, delete the buffer and the test
directory."
(let* ((temp-dir (make-temp-file "filelock-tests" t))
(name (concat (file-name-as-directory temp-dir)
"userfile"))
(create-lockfiles t))
(unwind-protect
(with-temp-buffer
(setq buffer-file-name name
buffer-file-truename name)
(unwind-protect
(save-current-buffer
(funcall test-function))
;; Set `buffer-file-truename' nil to prevent unlocking,
;; which might prompt the user and/or signal errors.
(setq buffer-file-name nil
buffer-file-truename nil)))
(delete-directory temp-dir t nil))))
(ert-with-temp-directory temp-dir
(let ((name (concat (file-name-as-directory temp-dir)
"userfile"))
(create-lockfiles t))
(with-temp-buffer
(setq buffer-file-name name
buffer-file-truename name)
(unwind-protect
(save-current-buffer
(funcall test-function))
;; Set `buffer-file-truename' nil to prevent unlocking,
;; which might prompt the user and/or signal errors.
(setq buffer-file-name nil
buffer-file-truename nil))))))
(defun filelock-tests--make-lock-name (file-name)
"Return the lock file name for FILE-NAME.

View file

@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(declare-function inotify-add-watch "inotify.c" (file-name aspect callback))
(declare-function inotify-rm-watch "inotify.c" (watch-descriptor))
@ -50,23 +51,21 @@
(ert-deftest inotify-file-watch-simple ()
"Test if watching a normal file works."
(skip-unless (featurep 'inotify))
(let ((temp-file (make-temp-file "inotify-simple"))
(events 0))
(let ((wd
(inotify-add-watch temp-file t (lambda (_ev)
(setq events (1+ events))))))
(unwind-protect
(progn
(with-temp-file temp-file
(insert "Foo\n"))
(read-event nil nil 5)
(should (> events 0)))
(should (inotify-valid-p wd))
(inotify-rm-watch wd)
(should-not (inotify-valid-p wd))
(delete-file temp-file)))))
(ert-with-temp-file temp-file
(let ((events 0))
(let ((wd
(inotify-add-watch temp-file t (lambda (_ev)
(setq events (1+ events))))))
(unwind-protect
(progn
(with-temp-file temp-file
(insert "Foo\n"))
(read-event nil nil 5)
(should (> events 0)))
(should (inotify-valid-p wd))
(inotify-rm-watch wd)
(should-not (inotify-valid-p wd)))))))
(provide 'inotify-tests)

View file

@ -46,6 +46,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'facemenu)
(ert-deftest undo-test0 ()
@ -218,17 +219,14 @@
(ert-deftest undo-test-file-modified ()
"Test undoing marks buffer visiting file unmodified."
(let ((tempfile (make-temp-file "undo-test")))
(unwind-protect
(progn
(with-current-buffer (find-file-noselect tempfile)
(insert "1")
(undo-boundary)
(set-buffer-modified-p nil)
(insert "2")
(undo)
(should-not (buffer-modified-p))))
(delete-file tempfile))))
(ert-with-temp-file tempfile
(with-current-buffer (find-file-noselect tempfile)
(insert "1")
(undo-boundary)
(set-buffer-modified-p nil)
(insert "2")
(undo)
(should-not (buffer-modified-p)))))
(ert-deftest undo-test-region-not-most-recent ()
"Test undo in region of an edit not the most recent."