Commit d0fe28cb authored by Michael Albinus's avatar Michael Albinus
Browse files

Add tests for remote files in auto-revert-tests

* lisp/autorevert.el (auto-revert-debug): New defvar.
(auto-revert-notify-handler): Write traces.

* lisp/filenotify.el (file-notify-debug): New defvar.
(file-notify-handle-event, file-notify-callback): Write traces.

* lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered):
Handle nil `vc-handled-backends'.

* test/lisp/autorevert-tests.el
(auto-revert-test-remote-temporary-file-directory): New defconst.
Handle also $REMOTE_FILE_NOTIFY_LIBRARY.
(auto-revert--test-enabled-remote-checked): New defvar.
(auto-revert--test-enabled-remote): New defun.
(auto-revert--wait-for-revert): Rewrite without timeout.
(auto-revert--deftest-remote): New defmacro.
(auto-revert-test01-auto-revert-several-files):
(auto-revert-test02-auto-revert-deleted-file): Adapt for remote files.
(auto-revert-test02-auto-revert-deleted-file):
Use `auto-revert-debug' for debug messages.
(auto-revert-test00-auto-revert-mode-remote)
(auto-revert-test01-auto-revert-several-files-mode-remote)
(auto-revert-test02-auto-revert-deleted-file-mode-remote)
(auto-revert-test03-auto-revert-tail-mode-mode-remote)
(auto-revert-test04-auto-revert-mode-dired-mode-remote): New tests.

* test/lisp/filenotify-tests.el (file-notify--test-event-handler):
Use `file-notify-debug' for debug messages.
parent 24a1d5a0
Pipeline #1543 failed with stage
in 54 minutes and 10 seconds
......@@ -126,8 +126,6 @@ Global Auto-Revert Mode does so in all buffers."
;; Variables:
;;; What's this?: ;; Autoload for the benefit of `make-mode-line-mouse-sensitive'.
;;; What's this?: ;;;###autoload
(defvar auto-revert-mode nil
"Non-nil when Auto-Revert Mode is active.
Never set this variable directly, use the command `auto-revert-mode' instead.")
......@@ -365,6 +363,9 @@ buffer.")
"Non-nil when file has been modified on the file system.
This has been reported by a file notification event.")
(defvar auto-revert-debug nil
"Use for debug messages.")
;; Functions:
(defun auto-revert-remove-current-buffer (&optional buffer)
......@@ -634,6 +635,8 @@ system.")
;; Since we watch a directory, a file name must be returned.
(cl-assert (stringp file))
(when (eq action 'renamed) (cl-assert (stringp file1)))
(when auto-revert-debug
(message "auto-revert-notify-handler %S" event))
(if (eq action 'stopped)
;; File notification has stopped. Continue with polling.
......
......@@ -30,6 +30,9 @@
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
(defvar file-notify-debug nil
"Use for debug messages.")
(defconst file-notify--library
(cond
((featurep 'inotify) 'inotify)
......@@ -93,7 +96,8 @@ If EVENT is a filewatch event, call its callback. It has the format
Otherwise, signal a `file-notify-error'."
(interactive "e")
;;(message "file-notify-handle-event %S" event)
(when file-notify-debug
(message "file-notify-handle-event %S" event))
(if (and (consp event)
(eq (car event) 'file-notify)
(>= (length event) 3))
......@@ -242,11 +246,12 @@ EVENT is the cadr of the event in `file-notify-handle-event'
(string-equal
(file-notify--watch-filename watch)
(file-name-nondirectory file1)))))
;;(message
;;"file-notify-callback %S %S %S %S %S %S %S"
;;desc action file file1 watch
;;(file-notify--event-watched-file event)
;;(file-notify--watch-directory watch))
(when file-notify-debug
(message
"file-notify-callback %S %S %S %S %S %S %S"
desc action file file1 watch
(file-notify--event-watched-file event)
(file-notify--watch-directory watch)))
(funcall (file-notify--watch-callback watch)
(if file1
`(,desc ,action ,file ,file1)
......
......@@ -3444,88 +3444,89 @@ the result will be a local, non-Tramp, file name."
;; any other remote command.
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-tramp-progress-reporter
v 3 (format-message "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
;; cannot reuse the old cache entries, therefore. In
;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
;; could also be a timestamp as `current-time' returns. This
;; means invalidate all cache entries with an older timestamp.
(let (tramp-vc-registered-file-names
(remote-file-name-inhibit-cache (current-time))
(file-name-handler-alist
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
(tramp-with-demoted-errors
v "Error in 1st pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
(when tramp-vc-registered-file-names
(tramp-maybe-send-script
v
(format tramp-vc-registered-read-file-names
(tramp-get-file-exists-command v)
(format "%s -r" (tramp-get-test-command v)))
"tramp_vc_registered_read_file_names")
(dolist
(elt
(ignore-errors
;; We cannot use `tramp-send-command-and-read',
;; because this does not cooperate well with
;; heredoc documents.
(tramp-send-command
v
(format
"tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
tramp-end-of-heredoc
(mapconcat #'tramp-shell-quote-argument
tramp-vc-registered-file-names
"\n")
tramp-end-of-heredoc))
(with-current-buffer (tramp-get-connection-buffer v)
;; Read the expression.
(goto-char (point-min))
(read (current-buffer)))))
(tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
(let ((vc-handled-backends vc-handled-backends)
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize process calls.
(when (and (memq 'Bzr vc-handled-backends)
(boundp 'vc-bzr-program)
(not (with-tramp-connection-property v vc-bzr-program
(tramp-find-executable
v vc-bzr-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
(when (and (memq 'Git vc-handled-backends)
(boundp 'vc-git-program)
(not (with-tramp-connection-property v vc-git-program
(tramp-find-executable
v vc-git-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
(when (and (memq 'Hg vc-handled-backends)
(boundp 'vc-hg-program)
(not (with-tramp-connection-property v vc-hg-program
(tramp-find-executable
v vc-hg-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
v "Error in 2nd pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file))))))))
(when vc-handled-backends
(with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-tramp-progress-reporter
v 3 (format-message "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
;; cannot reuse the old cache entries, therefore. In
;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
;; could also be a timestamp as `current-time' returns. This
;; means invalidate all cache entries with an older timestamp.
(let (tramp-vc-registered-file-names
(remote-file-name-inhibit-cache (current-time))
(file-name-handler-alist
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
(tramp-with-demoted-errors
v "Error in 1st pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
(when tramp-vc-registered-file-names
(tramp-maybe-send-script
v
(format tramp-vc-registered-read-file-names
(tramp-get-file-exists-command v)
(format "%s -r" (tramp-get-test-command v)))
"tramp_vc_registered_read_file_names")
(dolist
(elt
(ignore-errors
;; We cannot use `tramp-send-command-and-read',
;; because this does not cooperate well with
;; heredoc documents.
(tramp-send-command
v
(format
"tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
tramp-end-of-heredoc
(mapconcat #'tramp-shell-quote-argument
tramp-vc-registered-file-names
"\n")
tramp-end-of-heredoc))
(with-current-buffer (tramp-get-connection-buffer v)
;; Read the expression.
(goto-char (point-min))
(read (current-buffer)))))
(tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
(let ((vc-handled-backends vc-handled-backends)
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize process calls.
(when (and (memq 'Bzr vc-handled-backends)
(boundp 'vc-bzr-program)
(not (with-tramp-connection-property v vc-bzr-program
(tramp-find-executable
v vc-bzr-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
(when (and (memq 'Git vc-handled-backends)
(boundp 'vc-git-program)
(not (with-tramp-connection-property v vc-git-program
(tramp-find-executable
v vc-git-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
(when (and (memq 'Hg vc-handled-backends)
(boundp 'vc-hg-program)
(not (with-tramp-connection-property v vc-hg-program
(tramp-find-executable
v vc-hg-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
v "Error in 2nd pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file)))))))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args)
......
......@@ -19,6 +19,33 @@
;;; Commentary:
;; Some of the tests require access to a remote host files. Since
;; this could be problematic, a mock-up connection method "mock" is
;; used. Emulating a remote connection, it simply calls "sh -i".
;; Tramp's file name handlers still run, so this test is sufficient
;; except for connection establishing.
;; If you want to test a real Tramp connection, set
;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to
;; overwrite the default value. If you want to skip tests accessing a
;; 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
;; $REMOTE_FILE_NOTIFY_LIBRARY shall be set, possible values are
;; "inotifywait", "gio-monitor" and "gvfs-monitor-dir".
;; Local file-notify libraries are auto-detected during Emacs
;; configuration. This can be changed with a respective configuration
;; argument, like
;;
;; --with-file-notification=inotify
;; --with-file-notification=kqueue
;; --with-file-notification=gfile
;; --with-file-notification=w32
;; A whole test run can be performed calling the command `auto-revert-test-all'.
;;; Code:
......@@ -26,8 +53,14 @@
(require 'ert)
(require 'ert-x)
(require 'autorevert)
(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
auto-revert-stop-on-user-input nil)
(require 'tramp)
(setq auto-revert-debug nil
auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
auto-revert-stop-on-user-input nil
file-notify-debug nil
tramp-verbose 0
tramp-message-show-message nil)
(defconst auto-revert--timeout 10
"Time to wait for a message.")
......@@ -35,19 +68,88 @@
(defvar auto-revert--messages nil
"Used to collect messages issued during a section of a test.")
;; There is no default value on w32 systems, which could work out of the box.
(defconst auto-revert-test-remote-temporary-file-directory
(cond
((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
((eq system-type 'windows-nt) null-device)
(t (add-to-list
'tramp-methods
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
;; batch mode only, therefore. `temporary-file-directory' might
;; be quoted, so we unquote it just in case.
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" (file-name-unquote temporary-file-directory)))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
;; Filter suppressed remote file-notify libraries.
(when (stringp (getenv "REMOTE_FILE_NOTIFY_LIBRARY"))
(dolist (lib '("inotifywait" "gio-monitor" "gvfs-monitor-dir"))
(unless (string-equal (getenv "REMOTE_FILE_NOTIFY_LIBRARY") lib)
(add-to-list 'tramp-connection-properties `(nil ,lib nil)))))
(defvar auto-revert--test-enabled-remote-checked nil
"Cached result of `auto-revert--test-enabled-remote'.
If the function did run, the value is a cons cell, the `cdr'
being the result.")
(defun auto-revert--test-enabled-remote ()
"Whether remote file access is enabled."
(unless (consp auto-revert--test-enabled-remote-checked)
(setq
auto-revert--test-enabled-remote-checked
(cons
t (ignore-errors
(and
(file-remote-p auto-revert-test-remote-temporary-file-directory)
(file-directory-p auto-revert-test-remote-temporary-file-directory)
(file-writable-p
auto-revert-test-remote-temporary-file-directory))))))
;; Return result.
(cdr auto-revert--test-enabled-remote-checked))
(defun auto-revert--wait-for-revert (buffer)
"Wait until a message reports reversion of BUFFER.
This expects `auto-revert--messages' to be bound by
`ert-with-message-capture' before calling."
(with-timeout (auto-revert--timeout nil)
(while
(null (string-match
(format-message "Reverting buffer `%s'." (buffer-name buffer))
auto-revert--messages))
;; Remote files do not cooperate well with timers. So we count ourselves.
(let ((ct (current-time)))
(while (and (< (float-time (time-subtract (current-time) ct))
auto-revert--timeout)
(null (string-match
(format-message
"Reverting buffer `%s'\\." (buffer-name buffer))
auto-revert--messages)))
(if (with-current-buffer buffer auto-revert-use-notify)
(read-event nil nil 0.1)
(sleep-for 0.1)))))
(defmacro auto-revert--deftest-remote (test docstring)
"Define ert `TEST-remote' for remote files."
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
,docstring
:tags '(:expensive-test)
(let ((temporary-file-directory
auto-revert-test-remote-temporary-file-directory)
(auto-revert-remote-files t)
(ert-test (ert-get-test ',test))
vc-handled-backends)
(skip-unless (auto-revert--test-enabled-remote))
(tramp-cleanup-connection
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password)
(funcall (ert-test-body ert-test)))))
(ert-deftest auto-revert-test00-auto-revert-mode ()
"Check autorevert for a file."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
......@@ -93,13 +195,16 @@ This expects `auto-revert--messages' to be bound by
(kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
(auto-revert--deftest-remote auto-revert-test00-auto-revert-mode
"Check autorevert for a remote file.")
;; This is inspired by Bug#21841.
(ert-deftest auto-revert-test01-auto-revert-several-files ()
"Check autorevert for several files at once."
:tags '(:expensive-test)
(skip-unless (executable-find "cp"))
(skip-unless (executable-find "cp" (file-remote-p temporary-file-directory)))
(let* ((cp (executable-find "cp"))
(let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory)))
(tmpdir1 (make-temp-file "auto-revert-test" 'dir))
(tmpdir2 (make-temp-file "auto-revert-test" 'dir))
(tmpfile1
......@@ -139,7 +244,9 @@ This expects `auto-revert--messages' to be bound by
;; Strange, that `copy-directory' does not work as expected.
;; The following shell command is not portable on all
;; platforms, unfortunately.
(shell-command (format "%s -f %s/* %s" cp tmpdir2 tmpdir1))
(shell-command
(format "%s -f %s/* %s"
cp (file-local-name tmpdir2) (file-local-name tmpdir1)))
;; Check, that the buffers have been reverted.
(dolist (buf (list buf1 buf2))
......@@ -155,6 +262,9 @@ This expects `auto-revert--messages' to be bound by
(ignore-errors (delete-directory tmpdir1 'recursive))
(ignore-errors (delete-directory tmpdir2 'recursive)))))
(auto-revert--deftest-remote auto-revert-test01-auto-revert-several-files
"Check autorevert for several remote files at once.")
;; This is inspired by Bug#23276.
(ert-deftest auto-revert-test02-auto-revert-deleted-file ()
"Check autorevert for a deleted file."
......@@ -185,8 +295,8 @@ This expects `auto-revert--messages' to be bound by
(add-hook
'before-revert-hook
(lambda ()
;; Temporarily.
(message "%s deleted" buffer-file-name)
(when auto-revert-debug
(message "%s deleted" buffer-file-name))
(delete-file buffer-file-name))
nil t)
......@@ -199,7 +309,9 @@ This expects `auto-revert--messages' to be bound by
;; polling.
(should (string-match "any text" (buffer-string)))
;; With w32notify, the 'stopped' events are not sent.
;; Same for remote file name handlers. Why?
(or (eq file-notify--library 'w32notify)
(file-remote-p temporary-file-directory)
(should-not auto-revert-notify-watch-descriptor))
;; Once the file has been recreated, the buffer shall be
......@@ -231,6 +343,9 @@ This expects `auto-revert--messages' to be bound by
(kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
(auto-revert--deftest-remote auto-revert-test02-auto-revert-deleted-file
"Check autorevert for a deleted remote file.")
(ert-deftest auto-revert-test03-auto-revert-tail-mode ()
"Check autorevert tail mode."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
......@@ -266,6 +381,9 @@ This expects `auto-revert--messages' to be bound by
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
(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."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
......@@ -314,6 +432,9 @@ This expects `auto-revert--messages' to be bound by
(kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
(auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired
"Check remote autorevert for dired.")
(defun auto-revert-test-all (&optional interactive)
"Run all tests for \\[auto-revert]."
(interactive "p")
......
......@@ -195,7 +195,8 @@ Return nil when any other file notification watch is still active."
file-notify--test-events nil
file-notify--test-monitors nil))
(setq password-cache-expiry nil
(setq file-notify-debug nil
password-cache-expiry nil
tramp-verbose 0
tramp-message-show-message nil)
......@@ -515,8 +516,9 @@ and the event to `file-notify--test-events'."
(unless (string-match
(regexp-quote ".#")
(file-notify--event-file-name file-notify--test-event))
;;(message "file-notify--test-event-handler result: %s event: %S"
;;(null (ert-test-failed-p result)) file-notify--test-event)
(when file-notify-debug
(message "file-notify--test-event-handler result: %s event: %S"
(null (ert-test-failed-p result)) file-notify--test-event))
(setq file-notify--test-events
(append file-notify--test-events `(,file-notify--test-event))
file-notify--test-results
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment