Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Improve autorevert-tests

Browse source 
* doc/misc/trampver.texi:
* lisp/net/trampver.el: Change version to "2.8.1-pre".

* lisp/autorevert.el (auto-revert-mode, auto-revert-tail-mode)
(auto-revert-notify-handler, auto-revert--end-lockout):
Use `auto-revert-buffer'.
(auto-revert-notify-handler): Rearrange setting current buffer.
(auto-revert-handler): Add debug message.  Rearrange check.
Cancel lockout timer if running.

* lisp/net/tramp.el (tramp-barf-if-file-missing)
(with-parsed-tramp-file-name, tramp-skeleton-file-truename):
* lisp/net/tramp-archive.el (with-parsed-tramp-archive-file-name):
* lisp/net/tramp-message.el (tramp-with-demoted-errors):
Fix debug declatation.

* lisp/net/tramp-sh.el (tramp-sh-gio-monitor-process-filter): Do not
prepend remote prefix.

* test/lisp/autorevert-tests.el: Unify file notification libraries
"gio-monitor" and "gvfs-monitor-dir" to "gio".
(top): Set some Tramp related variables.
(auto-revert--timeout): Increase value.
(auto-revert--test-enabled-remote)
(auto-revert-test02-auto-revert-deleted-file): Do not check for
EMACS_HYDRA_CI environment variable.
(auto-revert--wait-for-revert): Fix regexp to search for.
(auto-revert--deftest-remote): Fix debug declatation.  Do not tag
:unstable.
(with-auto-revert-test): Fix debug declatation.  Adapt revert intervals.
(auto-revert-test*): Start with (file-notify-rm-all-watches).  Use
`buffer-string' and `string-match-p'.
(auto-revert-test00-auto-revert-mode): Unlock initial lockout.
(auto-revert-test01-auto-revert-several-files): Rearrange
temporary directory and file settings.
(auto-revert-test02-auto-revert-deleted-file): Adapt debug message.
(auto-revert-test03-auto-revert-tail-mode): Use `with-auto-revert-test'.
(auto-revert-test04-auto-revert-mode-dired):
Use `ert-with-temp-directory'.  Adapt prefix of tmpfile.
(auto-revert-test04-auto-revert-mode-dired)
(auto-revert-test05-global-notify, auto-revert-test06-write-file):
Wait for proper file modification.
(auto-revert-test--instrument-kill-buffer-hook): Fix debug message.
(auto-revert-test07-auto-revert-several-buffers): Use
`with-auto-revert-test.

* test/lisp/filenotify-tests.el: Unify file notification libraries
"gio-monitor" and "gvfs-monitor-dir" to "gio".
(file-notify--deftest-remote): Fix debug declatation.  Do not skip
for "gio".
(file-notify--test-with-actions): Fix debug declatation.

* test/lisp/net/tramp-tests.el (filenotify): Require.
(ert-remote-temporary-file-directory)
(tramp-test41-special-characters, tramp-test42-utf8)
(tramp-test45-asynchronous-requests): Do not check for
EMACS_HYDRA_CI environment variable.
(tramp-test46-file-notifications): New test.
This commit is contained in:
Michael Albinus 2025-07-15 18:57:49 +02:00
parent 0237e0d1a4
commit 4c9b376607
10 changed files with 340 additions and 204 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/misc/trampver.texi
View file

@ -7,7 +7,7 @@
@c In the Tramp GIT, the version number and the bug report address
@c are auto-frobbed from configure.ac.
@set trampver 2.8.0
@set trampver 2.8.1-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 28.1

62
lisp/autorevert.el
View file

@ -415,7 +415,7 @@ without being changed in the part that is already in the buffer."
(auto-revert-remove-current-buffer))
(auto-revert-set-timer)
(when auto-revert-mode
(auto-revert-buffers)
(auto-revert-buffer (current-buffer))
(setq auto-revert-tail-mode nil)))
@ -470,7 +470,7 @@ Use `auto-revert-mode' for changes other than appends!"
(y-or-n-p "File changed on disk, content may be missing. \
Perform a full revert? ")
;; Use this (not just revert-buffer) for point-preservation.
(auto-revert-buffers))
(auto-revert-buffer (current-buffer)))
;; else we might reappend our own end when we save
(add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t)
(or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position
@ -716,9 +716,9 @@ system.")
(message "auto-revert-notify-handler %S" event))
(when (buffer-live-p buffer)
(if (eq action 'stopped)
;; File notification has stopped. Continue with polling.
(with-current-buffer buffer
(with-current-buffer buffer
(if (eq action 'stopped)
;; File notification has stopped. Continue with polling.
(when (or
;; A buffer associated with a file.
(and (stringp buffer-file-name)
@ -730,9 +730,8 @@ system.")
(auto-revert-notify-rm-watch)
;; Restart the timer if it wasn't running.
(unless auto-revert-timer
(auto-revert-set-timer))))
(auto-revert-set-timer)))
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
(and (stringp buffer-file-name)
@ -761,7 +760,7 @@ system.")
;; Revert it when first entry or it was reverted intervals ago.
(when (> (float-time (time-since auto-revert--last-time))
auto-revert--lockout-interval)
(auto-revert-handler))))))))))
(auto-revert-buffer buffer))))))))))
(defun auto-revert--end-lockout (buffer)
"End the lockout period after a notification.
@ -770,7 +769,7 @@ If the buffer needs to be reverted, do it now."
(with-current-buffer buffer
(setq auto-revert--lockout-timer nil)
(when auto-revert-notify-modified-p
(auto-revert-handler)))))
(auto-revert-buffer buffer)))))
;;;###autoload
(progn
@ -809,36 +808,37 @@ Run BODY."
(defun auto-revert-handler ()
"Revert current buffer, if appropriate.
This is an internal function used by Auto-Revert Mode."
(when auto-revert-debug
(message "auto-revert-handler %S" (current-buffer)))
(let* ((buffer (current-buffer)) size
;; Tramp caches the file attributes. Setting
;; `remote-file-name-inhibit-cache' forces Tramp to reread
;; the values.
(remote-file-name-inhibit-cache t)
(revert
(if buffer-file-name
(and (or auto-revert-remote-files
(not (file-remote-p buffer-file-name)))
(or (not auto-revert-notify-watch-descriptor)
auto-revert-notify-modified-p)
(not (memq (current-buffer) inhibit-auto-revert-buffers))
(if auto-revert-tail-mode
(and (file-readable-p buffer-file-name)
(/= auto-revert-tail-pos
(setq size
(file-attribute-size
(file-attributes buffer-file-name)))))
(funcall (or buffer-stale-function
#'buffer-stale--default-function)
t)))
(and (or auto-revert-mode
global-auto-revert-non-file-buffers)
(not (memq (current-buffer) inhibit-auto-revert-buffers))
(funcall (or buffer-stale-function
#'buffer-stale--default-function)
t))))
(and (or auto-revert-remote-files
(not (file-remote-p default-directory)))
(or (not auto-revert-notify-watch-descriptor)
auto-revert-notify-modified-p)
(not (memq (current-buffer) inhibit-auto-revert-buffers))
(if (and buffer-file-name auto-revert-tail-mode)
(and (file-readable-p buffer-file-name)
(/= auto-revert-tail-pos
(setq size
(file-attribute-size
(file-attributes buffer-file-name)))))
(and (or auto-revert-mode auto-revert--global-mode)
(funcall (or buffer-stale-function
#'buffer-stale--default-function)
t)))))
eob eoblist)
(when (timerp auto-revert--lockout-timer)
(cancel-timer auto-revert--lockout-timer))
(setq auto-revert-notify-modified-p nil
auto-revert--last-time (current-time))
auto-revert--last-time
(if revert (current-time) auto-revert--last-time)
auto-revert--lockout-timer nil)
(when revert
(when (and auto-revert-verbose
(not (eq revert 'fast)))

2
lisp/net/tramp-archive.el
View file

@ -557,7 +557,7 @@ A variable `foo-archive' (or `archive') will be bound to the
archive name part of FILENAME, assuming `foo' (or nil) is the
value of VAR. OTOH, the variable `foo-hop' (or `hop') won't be
offered."
(declare (debug (form symbolp body))
(declare (debug (form symbolp &rest body))
(indent 2))
(let ((bindings
(mapcar

2
lisp/net/tramp-message.el
View file

@ -454,7 +454,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
BODY is executed like wrapped by `with-demoted-errors'. FORMAT
is a format-string containing a %-sequence meaning to substitute
the resulting error message."
(declare (indent 2) (debug (symbolp form body)))
(declare (indent 2) (debug (symbolp form &rest body)))
(let ((err (make-symbol "err")))
`(condition-case-unless-debug ,err
(progn ,@body)

7
lisp/net/tramp-sh.el
View file

@ -3864,8 +3864,6 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-sh-gio-monitor-process-filter (proc string)
"Read output from \"gio monitor\" and add corresponding `file-notify' events."
(let ((events (process-get proc 'tramp-events))
(remote-prefix
(file-remote-p (tramp-get-default-directory (process-buffer proc))))
(rest-string (process-get proc 'tramp-rest-string))
pos)
(when rest-string
@ -3927,10 +3925,7 @@ Fall back to normal file name handler if no Tramp handler exists."
proc
(list
(intern-soft (match-string 2 string)))
;; File names are returned as absolute paths. We
;; must add the remote prefix.
(concat remote-prefix file)
(when file1 (concat remote-prefix file1)))))
file file1)))
(setq string (replace-match "" nil nil string))
;; Add an Emacs event now.
;; `insert-special-event' exists since Emacs 31.

6
lisp/net/tramp.el
View file

@ -2102,7 +2102,7 @@ of `current-buffer'."
"Execute BODY and return the result.
In case of an error, raise a `file-missing' error if FILENAME
does not exist, otherwise propagate the error."
(declare (indent 2) (debug (symbolp form body)))
(declare (indent 2) (debug (tramp-file-name-p form &rest body)))
(let ((err (make-symbol "err")))
`(condition-case ,err
(let (signal-hook-function) ,@body)
@ -2141,7 +2141,7 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit
If VAR is nil, then we bind `v' to the structure and `method', `user',
`domain', `host', `port', `localname', `hop' to the components."
(declare (indent 2) (debug (form symbolp body)))
(declare (indent 2) (debug (form symbolp &rest body)))
(let ((bindings
(mapcar
(lambda (elem)
@ -3601,7 +3601,7 @@ BODY is the backend specific code."
(defmacro tramp-skeleton-file-truename (filename &rest body)
"Skeleton for `tramp-*-handle-file-truename'.
BODY is the backend specific code."
(declare (indent 1) (debug (form body)))
(declare (indent 1) (debug (form &rest body)))
;; Preserve trailing "/".
`(funcall
(if (directory-name-p ,filename) #'file-name-as-directory #'identity)

6
lisp/net/trampver.el
View file

@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
;; Version: 2.8.0
;; Version: 2.8.1-pre
;; Package-Requires: ((emacs "28.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
(defconst tramp-version "2.8.0"
(defconst tramp-version "2.8.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "28.1"))
"ok"
(format "Tramp 2.8.0 is not fit for %s"
(format "Tramp 2.8.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))

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

@ -37,7 +37,7 @@
;; of a respective command. The first command found is used. In
;; order to use a dedicated one, the environment variable
;; $REMOTE_FILE_NOTIFY_LIBRARY shall be set, possible values are
;; "inotifywait", "gio-monitor" and "gvfs-monitor-dir".
;; "inotifywait", "gio" and "smb-notify".
;; Local file-notify libraries are auto-detected during Emacs
;; configuration. This can be changed with a respective configuration
@ -56,22 +56,33 @@
(require 'ert-x)
(require 'autorevert)
(setq auto-revert-debug nil
(setq auth-source-cache-expiry nil
auth-source-save-behavior nil
auto-revert-debug nil
auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
auto-revert-stop-on-user-input nil
ert-temp-file-prefix "auto-revert-test"
ert-temp-file-suffix ""
file-notify-debug nil
tramp-verbose 0)
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-allow-unsafe-temporary-files t
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-verbose 0
;; When the remote user id is 0, Tramp refuses unsafe temporary files.
tramp-allow-unsafe-temporary-files
(or tramp-allow-unsafe-temporary-files noninteractive))
(defun auto-revert--timeout ()
"Time to wait for a message."
(+ auto-revert-interval 0.1))
(+ auto-revert-interval 1))
(defvar auto-revert--messages nil
"Used to collect messages issued during a section of a test.")
;; Filter suppressed remote file-notify libraries.
(when (stringp (getenv "REMOTE_FILE_NOTIFY_LIBRARY"))
(dolist (lib '("inotifywait" "gio-monitor" "gvfs-monitor-dir"))
(dolist (lib '("inotifywait" "gio" "smb-notify"))
(unless (string-equal (getenv "REMOTE_FILE_NOTIFY_LIBRARY") lib)
(add-to-list 'tramp-connection-properties `(nil ,lib nil)))))
@ -88,7 +99,6 @@ being the result.")
(cons
t (ignore-errors
(and
(not (getenv "EMACS_HYDRA_CI"))
(file-remote-p ert-remote-temporary-file-directory)
(file-directory-p ert-remote-temporary-file-directory)
(file-writable-p ert-remote-temporary-file-directory))))))
@ -100,12 +110,13 @@ being the result.")
This expects `auto-revert--messages' to be bound by
`ert-with-message-capture' before calling."
;; Remote files do not cooperate well with timers. So we count ourselves.
(let ((ct (current-time)))
(let ((ct (current-time))
(text-quoting-style 'grave))
(while (and (< (float-time (time-subtract nil ct))
(auto-revert--timeout))
(null (string-match
(format-message
"Reverting buffer `%s'" (buffer-name buffer))
(null (string-match-p
(rx bol "Reverting buffer `"
(literal (buffer-name buffer)) "'" eol)
(or auto-revert--messages ""))))
(if (and (or file-notify--library
(file-remote-p temporary-file-directory))
@ -115,10 +126,10 @@ This expects `auto-revert--messages' to be bound by
(defmacro auto-revert--deftest-remote (test docstring)
"Define ert `TEST-remote' for remote files."
(declare (indent 1))
(declare (indent 1) (debug (symbolp stringp)))
`(ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
,docstring
:tags '(:expensive-test :unstable)
:tags '(:expensive-test)
(let ((temporary-file-directory
ert-remote-temporary-file-directory)
(auto-revert-remote-files t)
@ -132,12 +143,14 @@ This expects `auto-revert--messages' to be bound by
(error (message "%s" err) (signal (car err) (cdr err)))))))
(defmacro with-auto-revert-test (&rest body)
(declare (debug t))
`(let ((auto-revert-interval-orig auto-revert-interval)
(auto-revert--lockout-interval-orig auto-revert--lockout-interval))
(unwind-protect
(progn
(customize-set-variable 'auto-revert-interval 0.1)
(setq auto-revert--lockout-interval 0.05)
(unless (file-remote-p temporary-file-directory)
(customize-set-variable 'auto-revert-interval 0.1)
(setq auto-revert--lockout-interval 0.05))
,@body)
(customize-set-variable 'auto-revert-interval auto-revert-interval-orig)
(setq auto-revert--lockout-interval auto-revert--lockout-interval-orig))))
@ -148,6 +161,8 @@ This expects `auto-revert--messages' to be bound by
(ert-deftest auto-revert-test00-auto-revert-mode ()
"Check autorevert for a file."
(file-notify-rm-all-watches)
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(with-auto-revert-test
@ -160,18 +175,30 @@ This expects `auto-revert--messages' to be bound by
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
(ert-with-message-capture auto-revert--messages
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
;; returns nil. We also clean up.
(auto-revert-mode 1)
(should auto-revert-mode)
;; There was already an initial call of
;; `auto-revert-handler', which locks file
;; notification. Reset this lock.
(setq auto-revert--last-time 0)
(auto-revert-test--wait-for
(lambda () (null auto-revert--lockout-timer))
(auto-revert--timeout))
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert-tests--write-file
"another text" tmpfile (pop times))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf))
(should (string-match "another text" (buffer-string)))
(should
(string-match-p
"another text" (substring-no-properties (buffer-string))))
;; When the buffer is modified, it shall not be reverted.
(ert-with-message-capture auto-revert--messages
@ -180,7 +207,9 @@ This expects `auto-revert--messages' to be bound by
;; Check, that the buffer hasn't been reverted.
(auto-revert--wait-for-revert buf))
(should-not (string-match "any text" (buffer-string)))))
(should-not
(string-match-p
"any text" (substring-no-properties (buffer-string))))))
;; Exit.
(ignore-errors
@ -194,27 +223,35 @@ This expects `auto-revert--messages' to be bound by
(ert-deftest auto-revert-test01-auto-revert-several-files ()
"Check autorevert for several files at once."
(skip-unless (executable-find "cp" (file-remote-p temporary-file-directory)))
(file-notify-rm-all-watches)
(ert-with-temp-directory tmpdir1
(ert-with-temp-directory tmpdir2
(ert-with-temp-file tmpfile1
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(ert-with-temp-file tmpfile2
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(with-auto-revert-test
(let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory)))
(with-auto-revert-test
(ert-with-temp-directory tmpdir1
:prefix "auto-revert-test-parent"
(ert-with-temp-directory tmpdir2
:prefix "auto-revert-test-parent"
(ert-with-temp-file tmpfile1
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(ert-with-temp-file tmpfile2
:prefix (expand-file-name "auto-revert-test" tmpdir1)
(let* ((cp (executable-find
"cp" (file-remote-p temporary-file-directory)))
(times '(120 60 30 15))
buf1 buf2)
(unwind-protect
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "any text" tmpfile1 (pop times))
(auto-revert-tests--write-file
"any text" tmpfile1 (pop times))
(setq buf1 (find-file-noselect tmpfile1))
(auto-revert-tests--write-file "any text" tmpfile2 (pop times))
(auto-revert-tests--write-file
"any text" tmpfile2 (pop times))
(setq buf2 (find-file-noselect tmpfile2))
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
@ -236,14 +273,17 @@ This expects `auto-revert--messages' to be bound by
;; The following shell command is not portable on all
;; platforms, unfortunately.
(shell-command
(format "%s -f %s/* %s"
cp (file-local-name tmpdir2) (file-local-name tmpdir1)))
(format "%s -f %s/* %s" cp
(file-local-name tmpdir2) (file-local-name tmpdir1)))
;; Check, that the buffers have been reverted.
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
(auto-revert--wait-for-revert buf)
(should (string-match "another text" (buffer-string))))))
(should
(string-match-p
"another text"
(substring-no-properties (buffer-string)))))))
;; Exit.
(ignore-errors
@ -257,16 +297,11 @@ This expects `auto-revert--messages' to be bound by
;; This is inspired by Bug#23276.
(ert-deftest auto-revert-test02-auto-revert-deleted-file ()
"Check autorevert for a deleted file."
;; Repeated unpredictable failures, bug#32645.
:tags '(:unstable)
;; Unlikely to be hydra-specific?
;; (skip-when (getenv "EMACS_HYDRA_CI"))
(file-notify-rm-all-watches)
(with-auto-revert-test
(ert-with-temp-file tmpfile
(let (;; Try to catch bug#32645.
(auto-revert-debug (getenv "EMACS_HYDRA_CI"))
(file-notify-debug (getenv "EMACS_HYDRA_CI"))
(times '(120 60 30 15))
(let ((times '(120 60 30 15))
buf desc)
(unwind-protect
(progn
@ -275,7 +310,9 @@ This expects `auto-revert--messages' to be bound by
(with-current-buffer buf
(should-not
(file-notify-valid-p auto-revert-notify-watch-descriptor))
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
@ -289,51 +326,47 @@ This expects `auto-revert--messages' to be bound by
'before-revert-hook
(lambda ()
(when auto-revert-debug
(message "%s deleted" buffer-file-name))
(message "before-revert-hook %s deleted" buffer-file-name))
(delete-file buffer-file-name))
nil t)
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert-tests--write-file
"another text" tmpfile (pop times))
(should (eq desc auto-revert-notify-watch-descriptor))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer hasn't been reverted. File
;; notification should be disabled, falling back to
;; polling.
(should (string-match "any text" (buffer-string)))
;; With w32notify, and on emba, the `stopped' events are not sent.
(or (eq file-notify--library 'w32notify)
(getenv "EMACS_EMBA_CI")
(should-not
;; The auto-revert timer is wont to establish a new
;; watch soon after the previous descriptor is
;; destroyed, which not unnaturally interferes with
;; our testing for its destruction, since descriptor
;; IDs are reused. Therefore, test the identity of
;; the previous descriptor, not just its validity.
(and (eq desc auto-revert-notify-watch-descriptor)
(file-notify-valid-p auto-revert-notify-watch-descriptor))))
(should
(string-match-p
"any text" (substring-no-properties (buffer-string))))
;; Once the file has been recreated, the buffer shall be
;; reverted.
(kill-local-variable 'before-revert-hook)
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert-tests--write-file
"another text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-match "another text" (buffer-string)))
(should
(string-match-p
"another text" (substring-no-properties (buffer-string))))
;; When file notification is used, it must be reenabled
;; after recreation of the file. We cannot expect that
;; the descriptor is the same, so we just check the
;; existence.
(should (eq (null desc) (null auto-revert-notify-watch-descriptor)))
(should
(eq (null desc) (null auto-revert-notify-watch-descriptor)))
;; An empty file shall still be reverted.
(ert-with-message-capture auto-revert--messages
(auto-revert-tests--write-file "" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should (string-equal "" (buffer-string)))))
(should
(string-equal "" (substring-no-properties (buffer-string))))))
;; Exit.
(ignore-errors
@ -345,6 +378,9 @@ This expects `auto-revert--messages' to be bound by
(ert-deftest auto-revert-test03-auto-revert-tail-mode ()
"Check autorevert tail mode."
(file-notify-rm-all-watches)
(with-auto-revert-test
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(ert-with-temp-file tmpfile
@ -365,69 +401,90 @@ This expects `auto-revert--messages' to be bound by
(set-buffer-modified-p nil)
;; Modify file.
(auto-revert-tests--write-file "another text" tmpfile (pop times) 'append)
(auto-revert-tests--write-file
"another text" tmpfile (pop times) 'append)
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf)
(should
(string-match "modified text\nanother text" (buffer-string)))))
(string-match-p
"modified text\nanother text"
(substring-no-properties (buffer-string))))))
;; Exit.
(ignore-errors (kill-buffer buf))))))
(ignore-errors (kill-buffer buf)))))))
(auto-revert--deftest-remote auto-revert-test03-auto-revert-tail-mode
"Check remote autorevert tail mode.")
(ert-deftest auto-revert-test04-auto-revert-mode-dired ()
"Check autorevert for dired."
(file-notify-rm-all-watches)
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(with-auto-revert-test
(ert-with-temp-file tmpfile
(let* ((name (file-name-nondirectory tmpfile))
(times '(30))
buf)
(unwind-protect
(progn
(setq buf (dired-noselect temporary-file-directory))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that it
;; returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(should
(string-match name (substring-no-properties (buffer-string))))
;; If we don't sleep for a while, this test fails on
;; MS-Windows.
(if (eq system-type 'windows-nt)
(sleep-for 0.5))
(ert-with-temp-directory tmpdir
:prefix "auto-revert-test-parent"
(ert-with-temp-file tmpfile
:prefix (expand-file-name "auto-revert-test" tmpdir)
(let* ((name (file-name-nondirectory tmpfile))
(times '(30))
buf)
(unwind-protect
(progn
(setq buf (dired-noselect tmpdir))
(with-current-buffer buf
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
(auto-revert-mode 1)
(should auto-revert-mode)
(should
(string-match-p
(rx bow (literal name) eow)
(substring-no-properties (buffer-string))))
;; If we don't sleep for a while, this test fails on
;; MS-Windows.
(if (eq system-type 'windows-nt)
(sleep-for 0.5))
(ert-with-message-capture auto-revert--messages
;; Delete file.
(delete-file tmpfile)
(auto-revert--wait-for-revert buf))
(if (eq system-type 'windows-nt)
(sleep-for 1))
;; Check, that the buffer has been reverted.
(should-not
(string-match name (substring-no-properties (buffer-string))))
;; File stamps of remote files have an accuracy of 1
;; second. Wait a little bit.
(when (file-remote-p tmpfile)
(sleep-for (auto-revert--timeout)))
(ert-with-message-capture auto-revert--messages
;; Delete file.
(delete-file tmpfile)
(auto-revert--wait-for-revert buf))
(if (eq system-type 'windows-nt)
(sleep-for 1))
;; Check, that the buffer has been reverted.
(should-not
(string-match-p
(rx bow (literal name) eow)
(substring-no-properties (buffer-string))))
(ert-with-message-capture auto-revert--messages
;; Make dired buffer modified. Check, that the buffer has
;; been still reverted.
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
;; File stamps of remote files have an accuracy of 1
;; second. Wait a little bit.
(when (file-remote-p tmpfile)
(sleep-for (auto-revert--timeout)))
(ert-with-message-capture auto-revert--messages
;; Make dired buffer modified. Check, that the
;; buffer has been still reverted.
(set-buffer-modified-p t)
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should
(string-match-p
(rx bow (literal name) eow)
(substring-no-properties (buffer-string))))))
(auto-revert--wait-for-revert buf))
;; Check, that the buffer has been reverted.
(should
(string-match name (substring-no-properties (buffer-string))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))))
;; Exit.
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))))))))
(auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired
"Check remote autorevert for dired.")
@ -439,7 +496,7 @@ This expects `auto-revert--messages' to be bound by
(defun auto-revert-test--buffer-string (buffer)
"Contents of BUFFER as a string."
(with-current-buffer buffer
(buffer-string)))
(substring-no-properties (buffer-string))))
(defun auto-revert-test--wait-for (pred max-wait)
"Wait until PRED is true, or MAX-WAIT seconds elapsed."
@ -462,13 +519,15 @@ This expects `auto-revert--messages' to be bound by
'kill-buffer-hook
(lambda ()
(message
"%s killed\n%s" (current-buffer) (with-output-to-string (backtrace))))
"%S killed\n%s" (current-buffer) (with-output-to-string (backtrace))))
nil 'local))))
(ert-deftest auto-revert-test05-global-notify ()
"Test `global-auto-revert-mode' without polling."
(skip-unless (or file-notify--library
(file-remote-p temporary-file-directory)))
(file-notify-rm-all-watches)
(with-auto-revert-test
(ert-with-temp-file file-1
(ert-with-temp-file file-2
@ -484,8 +543,13 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-test--instrument-kill-buffer-hook buf-1)
(setq buf-2 (find-file-noselect file-2))
(auto-revert-test--instrument-kill-buffer-hook buf-2)
;; File stamps of remote files have an accuracy of 1
;; second. Wait a little bit.
(when (file-remote-p file-1)
(sleep-for (auto-revert--timeout)))
(auto-revert-test--write-file "1-a" file-1)
(should (equal (auto-revert-test--buffer-string buf-1) ""))
(should
(string-equal (auto-revert-test--buffer-string buf-1) ""))
(global-auto-revert-mode 1) ; Turn it on.
@ -494,15 +558,20 @@ This expects `auto-revert--messages' to be bound by
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-2))
;; Allow for some time to handle notification events.
(auto-revert-test--wait-for-buffer-text
buf-1 "1-a" (auto-revert--timeout))
;; buf-1 should have been reverted immediately when the mode
;; was enabled.
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(should
(string-equal (auto-revert-test--buffer-string buf-1) "1-a"))
;; Alter a file.
(auto-revert-test--write-file "2-a" file-2)
;; Allow for some time to handle notification events.
(auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1)
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
(should
(string-equal (auto-revert-test--buffer-string buf-2) "2-a"))
;; Visit a file, and modify it on disk.
(setq buf-3 (find-file-noselect file-3))
@ -517,11 +586,13 @@ This expects `auto-revert--messages' to be bound by
'auto-revert-notify-watch-descriptor buf-3))
(auto-revert-test--write-file "3-a" file-3)
(auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1)
(should (equal (auto-revert-test--buffer-string buf-3) "3-a"))
(should
(string-equal (auto-revert-test--buffer-string buf-3) "3-a"))
;; Delete a visited file, and re-create it with new contents.
(delete-file file-1)
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(should
(string-equal (auto-revert-test--buffer-string buf-1) "1-a"))
(auto-revert-test--write-file "1-b" file-1)
;; Since the file is deleted, it needs at least
;; `auto-revert-interval' to recognize the new file,
@ -531,10 +602,12 @@ This expects `auto-revert--messages' to be bound by
(should (buffer-local-value
'auto-revert-notify-watch-descriptor buf-1))
;; Write a buffer to a new file, then modify the new file on disk.
;; Write a buffer to a new file, then modify the new
;; file on disk.
(with-current-buffer buf-2
(write-file file-2b))
(should (equal (auto-revert-test--buffer-string buf-2) "2-a"))
(should
(string-equal (auto-revert-test--buffer-string buf-2) "2-a"))
(auto-revert-test--write-file "2-b" file-2b)
(auto-revert-test--wait-for-buffer-text
buf-2 "2-b" (auto-revert--timeout))
@ -557,6 +630,8 @@ This expects `auto-revert--messages' to be bound by
"Verify that notification follows `write-file' correctly."
(skip-unless (or file-notify--library
(file-remote-p temporary-file-directory)))
(file-notify-rm-all-watches)
(with-auto-revert-test
(ert-with-temp-file file-1
(let* ((auto-revert-use-notify t)
@ -574,10 +649,15 @@ This expects `auto-revert--messages' to be bound by
(insert "B")
(write-file file-2)
;; File stamps of remote files have an accuracy of 1
;; second. Wait a little bit.
(when (file-remote-p file-1)
(sleep-for (auto-revert--timeout)))
(auto-revert-test--write-file "C" file-2)
(auto-revert-test--wait-for-buffer-text
buf "C" (auto-revert--timeout))
(should (equal (buffer-string) "C"))))
(should
(string-equal (substring-no-properties (buffer-string)) "C"))))
;; Clean up.
(ignore-errors (kill-buffer buf))
@ -591,7 +671,9 @@ This expects `auto-revert--messages' to be bound by
"Check autorevert for several buffers visiting the same file."
(skip-unless (or file-notify--library
(file-remote-p temporary-file-directory)))
;; (with-auto-revert-test
(file-notify-rm-all-watches)
(with-auto-revert-test
(ert-with-temp-file tmpfile
(let ((auto-revert-use-notify t)
(times '(120 60 30 15))
@ -604,7 +686,9 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(push (find-file-noselect tmpfile) buffers)
(with-current-buffer (car buffers)
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
;; `buffer-stale--default-function' checks for
;; `verify-visited-file-modtime'. We must ensure that
;; it returns nil.
@ -622,7 +706,9 @@ This expects `auto-revert--messages' to be bound by
(setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
(if (string-suffix-p "-nil" (buffer-name buf))
(should-not auto-revert-mode)
(should auto-revert-mode))))
@ -632,7 +718,9 @@ This expects `auto-revert--messages' to be bound by
(auto-revert--wait-for-revert (car buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text"))))
(should
(string-equal
(substring-no-properties (buffer-string)) "another text"))))
;; Disabling autorevert in an indirect buffer does not
;; disable autorevert in the corresponding base buffer.
@ -677,7 +765,9 @@ This expects `auto-revert--messages' to be bound by
(dolist (buf buffers)
(with-current-buffer buf
(insert-file-contents tmpfile 'visit)
(should (string-equal (buffer-string) "any text"))
(should
(string-equal
(substring-no-properties (buffer-string)) "any text"))
(auto-revert-mode 1)
(should auto-revert-mode)))
@ -686,19 +776,23 @@ This expects `auto-revert--messages' to be bound by
(dolist (buf buffers)
(auto-revert--wait-for-revert buf)
(with-current-buffer buf
(should (string-equal (buffer-string) "another text")))))
(should
(string-equal
(substring-no-properties (buffer-string)) "another text")))))
;; Exit.
(ignore-errors
(dolist (buf buffers)
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf)))))));)
(kill-buffer buf))))))))
(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
"Check autorevert for several buffers visiting the same remote file.")
(ert-deftest auto-revert-test08-auto-revert-inhibit-auto-revert ()
"Check the power of `inhibit-auto-revert'."
(file-notify-rm-all-watches)
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(with-auto-revert-test
@ -715,14 +809,19 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-mode 1)
(should auto-revert-mode)
(auto-revert-tests--write-file "another text" tmpfile (pop times))
(auto-revert-tests--write-file
"another text" tmpfile (pop times))
;; Check, that the buffer hasn't been reverted.
(auto-revert--wait-for-revert buf)
(should-not (string-match "another text" (buffer-string))))
(should-not
(string-match-p
"another text" (substring-no-properties (buffer-string)))))
;; Check, that the buffer has been reverted.
(auto-revert--wait-for-revert buf)
(should (string-match "another text" (buffer-string))))))
(should
(string-match-p
"another text" (substring-no-properties (buffer-string)))))))
;; Exit.
(ignore-errors

26
test/lisp/filenotify-tests.el
View file

@ -33,11 +33,11 @@
;; remote host, set this environment variable to "/dev/null" or
;; whatever is appropriate on your system.
;; For the remote file-notify library, Tramp checks for the existence
;; of a respective command. The first command found is used. In
;; order to use a dedicated one, the environment variable
;; For the remote file-notify library, Tramp checks for the existence of
;; a respective command. The first command found is used. In order to
;; use a dedicated one, the environment variable
;; $REMOTE_FILE_NOTIFY_LIBRARY shall be set, possible values are
;; "inotifywait", "gio-monitor", "gvfs-monitor-dir", and "smb-notify".
;; "inotifywait", "gio", and "smb-notify".
;; Local file-notify libraries are auto-detected during Emacs
;; configuration. This can be changed with a respective configuration
@ -58,7 +58,7 @@
;; Filter suppressed remote file-notify libraries.
(when (stringp (getenv "REMOTE_FILE_NOTIFY_LIBRARY"))
(dolist (lib '("inotifywait" "gio-monitor" "gvfs-monitor-dir" "smb-notify"))
(dolist (lib '("inotifywait" "gio" "smb-notify"))
(unless (string-equal (getenv "REMOTE_FILE_NOTIFY_LIBRARY") lib)
(add-to-list 'tramp-connection-properties `(nil ,lib nil)))))
@ -238,9 +238,9 @@ remote host, or nil."
(defun file-notify--test-monitor ()
"The used monitor for the test, as a symbol.
This returns only for (local) gfilenotify or (remote) gio library;
otherwise it is nil. `file-notify--test-desc' must be a valid
watch descriptor."
This returns only for (local) gfilenotify, (remote) gio or (remote)
smb-notify libraries; otherwise it is nil. `file-notify--test-desc'
must be a valid watch descriptor."
;; We cache the result, because after `file-notify-rm-watch',
;; `gfile-monitor-name' does not return a proper result anymore.
;; But we still need this information. So far, we know the monitors
@ -277,7 +277,7 @@ watch descriptor."
(defmacro file-notify--deftest-remote (test docstring &optional unstable)
"Define ert `TEST-remote' for remote files.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
(declare (indent 1) (debug (symbolp stringp &optional form)))
`(ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
,docstring
:tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
@ -285,9 +285,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(ert-test (ert-get-test ',test))
vc-handled-backends)
(skip-unless (file-notify--test-remote-enabled))
;; These tests do not work for remote gio/GInotifyFileMonitor.
;; Needs further investigation.
(skip-when (string-equal (file-notify--test-library) "gio"))
(tramp-cleanup-connection
(tramp-dissect-file-name temporary-file-directory) t 'keep-password)
(file-notify--test-cleanup)
@ -623,7 +620,7 @@ just an indicator for comparison.
Don't wait longer than timeout seconds for the actions to be
delivered."
(declare (indent 1) (debug (form body)))
(declare (indent 1) (debug (form &rest body)))
`(let* ((actions (if (consp (car ,actions)) ,actions (list ,actions)))
(max-length
(apply
@ -1615,7 +1612,8 @@ the file watch."
"Check that file notification does not use too many resources."
:tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
;; This test is intended for kqueue only.
;; This test is intended for kqueue only. We cannot check for
;; GKqueueFileMonitor, because `file-notify--test-desc' is not set yet.
(skip-unless (string-equal (file-notify--test-library) "kqueue"))
(should

80
test/lisp/net/tramp-tests.el
View file

@ -45,8 +45,8 @@
;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
;; value less than 10 could help.
;; This test suite obeys the environment variables $EMACS_HYDRA_CI and
;; $EMACS_EMBA_CI, used on the Emacs CI/CD platforms.
;; This test suite obeys the environment variable $EMACS_EMBA_CI, used
;; on the Emacs CI/CD platforms.
;; The following test tags are used: `:expensive-test',
;; `:tramp-asynchronous-processes' and `:unstable'.
@ -60,6 +60,7 @@
(require 'dired-aux)
(require 'tramp)
(require 'ert-x)
(require 'filenotify)
(require 'tar-mode)
(require 'trace)
(require 'vc)
@ -121,11 +122,7 @@
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for remote file tests.")
;; This should happen on hydra only.
(when (getenv "EMACS_HYDRA_CI")
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))))
"Temporary directory for remote file tests.")))
;; Beautify batch mode.
(when noninteractive
@ -2436,8 +2433,7 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
(dolist (non-essential '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
;; We must clear `tramp-default-method'.
(let ((tramp-default-method
(file-remote-p ert-remote-temporary-file-directory 'method))
(host-port
@ -5222,7 +5218,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unwind-protect
(progn
;; We cannot use "/bin/true" and "/bin/false"; those paths
;; do not exist on hydra and on MS Windows.
;; do not exist on MS Windows.
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
@ -7665,7 +7661,6 @@ This requires restrictions of file name syntax."
(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-rclone-p)))
(skip-unless (not (or (eq system-type 'darwin) (tramp--test-macos-p))))
@ -7744,7 +7739,6 @@ This requires restrictions of file name syntax."
(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-scp-p)))
@ -7902,17 +7896,12 @@ process sentinels. They shall not disturb each other."
(cond
((ignore-errors
(string-to-number (getenv "REMOTE_PARALLEL_PROCESSES"))))
((getenv "EMACS_HYDRA_CI") 5)
(t 10)))
;; PuTTY-based methods can only share up to 10 connections.
(tramp-use-connection-share
(if (and (tramp--test-putty-p) (>= number-proc 10))
'suppress (bound-and-true-p tramp-use-connection-share)))
;; On hydra, timings are bad.
(timer-repeat
(cond
((getenv "EMACS_HYDRA_CI") 10)
(t 1)))
(timer-repeat 1)
;; This is when all timers start. We check inside the
;; timer function, that we don't exceed timeout.
(timer-start (current-time))
@ -8102,6 +8091,58 @@ process sentinels. They shall not disturb each other."
(delete-directory tmp-name)
(delete-file (concat tmp-name ".tar.gz"))))
;; More exhaustive tests are performed in filenotify-tests.el,
;; selector "remote".
(ert-deftest tramp-test46-file-notifications ()
"Check that Tramp handles file notifications."
(skip-unless (tramp--test-enabled))
(let* ((tmp-name (tramp--test-make-temp-name))
;(file-notify-debug t)
(desc1
(ignore-error file-notify-error
(file-notify-add-watch
tmp-name '(change attribute-change) #'ignore)))
(desc2
(ignore-error file-notify-error
(file-notify-add-watch
ert-remote-temporary-file-directory
'(change attribute-change) #'ignore))))
(skip-unless (and desc1 desc2))
(unwind-protect
(progn
(tramp--test-message "%S" desc1)
(should-not (file-exists-p tmp-name))
(should (file-notify-valid-p desc1))
(should (file-notify-valid-p desc2))
;; Create the file.
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
;; Modify.
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
;; Delete.
(delete-file tmp-name)
(should-not (file-exists-p tmp-name))
(while (read-event nil nil 0.1))
;; This has been stopped because the file was deleted.
(should-not (file-notify-valid-p desc1))
;; This is still valid.
(should (file-notify-valid-p desc2))
(file-notify-rm-watch desc2)
(should-not (file-notify-valid-p desc2)))
;; Cleanup.
(ignore-errors (delete-file tmp-name))
;; `file-notify-rm-all-watches' exists since Emacs 30.1.
;; We don't want to see compiler warnings for older Emacsen.
(when (fboundp 'file-notify-rm-all-watches)
(with-no-warnings (file-notify-rm-all-watches))))))
(ert-deftest tramp-test47-read-password ()
"Check Tramp password handling."
:tags '(:expensive-test)
@ -8656,6 +8697,9 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Check, why direct async processes do not work for
;; `tramp-test45-asynchronous-requests'.
;; Starting with Emacs 29, use `ert-with-temp-file' and
;; `ert-with-temp-directory'.
(provide 'tramp-tests)
;;; tramp-tests.el ends here