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:
parent
5dd27fef58
commit
385741fae2
41 changed files with 1314 additions and 1398 deletions
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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")))))
|
||||
|
|
|
@ -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 "Здра́вствуйте!" "中文,普通话,汉语" "åäöøñ"
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -19,6 +19,7 @@
|
|||
|
||||
;;; Code:
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'dired-aux)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
|
|
|
@ -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 ."
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
|
|
|
@ -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 '()))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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 ."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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'.
|
||||
|
|
|
@ -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 ."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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'."
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"))
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
Loading…
Add table
Reference in a new issue