* 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.
;; 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.")
"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)
;; 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.
(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)
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))
(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)
;; 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)
;;; 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:
(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.")
(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
(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
;; 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))
(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."
(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)
;; 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
(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
(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
(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")
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)
(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
projects / emacs.git / commitdiff