From d0fe28cb1d33daa059990d62556a8de20a385387 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 3 May 2019 17:18:13 +0200 Subject: [PATCH] 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. --- lisp/autorevert.el | 7 +- lisp/filenotify.el | 17 ++-- lisp/net/tramp-sh.el | 165 +++++++++++++++++----------------- test/lisp/autorevert-tests.el | 145 +++++++++++++++++++++++++++--- test/lisp/filenotify-tests.el | 8 +- 5 files changed, 237 insertions(+), 105 deletions(-) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index cdd8223fffd..7cd5e7ee8bf 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -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. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 4d22061138f..a6054c175f1 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -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) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index dc64726e211..37ff14a5eb2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 6e8219d238d..d98c11658fe 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -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") diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index a40dc720786..af2d0b33e08 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -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 -- 2.39.2