Commit d5a10aef authored by Michael Albinus's avatar Michael Albinus

Fix Bug#22557

* lisp/filenotify.el (file-notify-callback): Do not send a
`stopped' event in case of backup by renaming.  (Bug#22557)

* test/automated/Makefile.in: Use $(SELECTOR_EXPENSIVE) for
all targets but check and check-maybe.

* test/automated/file-notify-tests.el
(file-notify--test-read-event-timeout): New defconst.
(file-notify--deftest-remote, file-notify--wait-for-events)
(file-notify-test02-events)
(file-notify-test04-file-validity)
(file-notify-test06-many-events): Use it.
(file-notify--test-cleanup): Make it more robust.  Delete also
backup file.
(file-notify-test07-backup): New test.
parent 67fcd5ad
......@@ -242,10 +242,14 @@ EVENT is the cadr of the event in `file-notify-handle-event'
(and
(memq action '(deleted renamed))
(= (length (cdr registered)) 1)
;; Not, when a file is backed up.
(not (and (stringp file1) (backup-file-name-p file1)))
(or
;; Watched file or directory is concerned.
(string-equal
(file-name-nondirectory file)
(file-name-nondirectory (car registered)))
;; File inside a watched directory is concerned.
(string-equal
(file-name-nondirectory file)
(car (cadr registered)))))))
......
......@@ -89,10 +89,14 @@ WRITE_LOG = > $@ 2>&1 || { stat=ERROR; cat $@; }; echo $$stat: $@
## Beware: it approximates 'no-byte-compile', so watch out for false-positives!
SELECTOR_DEFAULT = (quote (not (tag :expensive-test)))
SELECTOR_EXPENSIVE = nil
ifndef SELECTOR
ifdef SELECTOR
SELECTOR_ACTUAL=$(SELECTOR)
else ifeq ($(MAKECMDGOALS),check)
SELECTOR_ACTUAL=$(SELECTOR_DEFAULT)
else ifeq ($(MAKECMDGOALS),check-maybe)
SELECTOR_ACTUAL=$(SELECTOR_DEFAULT)
else
SELECTOR_ACTUAL=$(SELECTOR)
SELECTOR_ACTUAL=$(SELECTOR_EXPENSIVE)
endif
......
......@@ -62,6 +62,10 @@
(defvar file-notify--test-event nil)
(defvar file-notify--test-events nil)
(defconst file-notify--test-read-event-timeout 0.02
"Timeout for `read-event' calls.
It is different for local and remote file notification libraries.")
(defun file-notify--test-timeout ()
"Timeout to wait for arriving events, in seconds."
(cond
......@@ -74,19 +78,20 @@
"Cleanup after a test."
(file-notify-rm-watch file-notify--test-desc)
(when (and file-notify--test-tmpfile
(file-exists-p file-notify--test-tmpfile))
(ignore-errors
(delete-file (file-newest-backup file-notify--test-tmpfile)))
(ignore-errors
(if (file-directory-p file-notify--test-tmpfile)
(delete-directory file-notify--test-tmpfile 'recursive)
(delete-file file-notify--test-tmpfile)))
(when (and file-notify--test-tmpfile1
(file-exists-p file-notify--test-tmpfile1))
(ignore-errors
(if (file-directory-p file-notify--test-tmpfile1)
(delete-directory file-notify--test-tmpfile1 'recursive)
(delete-file file-notify--test-tmpfile1)))
(when (file-remote-p temporary-file-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password))
(ignore-errors
(when (file-remote-p temporary-file-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name temporary-file-directory) nil 'keep-password)))
(setq file-notify--test-tmpfile nil
file-notify--test-tmpfile1 nil
......@@ -155,6 +160,7 @@ remote host, or nil."
:tags '(:expensive-test)
(let* ((temporary-file-directory
file-notify-test-remote-temporary-file-directory)
(file-notify--test-read-event-timeout 0.1)
(ert-test (ert-get-test ',test)))
(skip-unless (file-notify--test-remote-enabled))
(tramp-cleanup-connection
......@@ -285,7 +291,7 @@ and the event to `file-notify--test-events'."
TIMEOUT is the maximum time to wait for, in seconds."
`(with-timeout (,timeout (ignore))
(while (null ,until)
(read-event nil nil 0.1))))
(read-event nil nil file-notify--test-read-event-timeout))))
(defmacro file-notify--test-with-events (events &rest body)
"Run BODY collecting events and then compare with EVENTS.
......@@ -342,7 +348,7 @@ longer than timeout seconds for the events to be delivered."
(t '(created changed deleted stopped)))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -371,10 +377,10 @@ longer than timeout seconds for the events to be delivered."
'((changed deleted stopped)
(changed changed deleted stopped)))
(t '(changed changed deleted stopped)))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -405,10 +411,10 @@ longer than timeout seconds for the events to be delivered."
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
(t '(created changed deleted deleted stopped)))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -440,17 +446,17 @@ longer than timeout seconds for the events to be delivered."
'(created changed created changed deleted stopped))
(t '(created changed created changed
deleted deleted deleted stopped)))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; The next two events shall not be visible.
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(set-file-modes file-notify--test-tmpfile 000)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -480,13 +486,13 @@ longer than timeout seconds for the events to be delivered."
((string-equal (file-notify--test-library) "kqueue")
'(created changed renamed deleted stopped))
(t '(created changed renamed deleted deleted stopped)))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
;; After the rename, we won't get events anymore.
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -514,14 +520,14 @@ longer than timeout seconds for the events to be delivered."
(file-remote-p temporary-file-directory))
'(attribute-changed attribute-changed attribute-changed))
(t '(attribute-changed attribute-changed)))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(set-file-modes file-notify--test-tmpfile 000)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it.
(let (file-notify--test-events)
......@@ -678,10 +684,10 @@ longer than timeout seconds for the events to be delivered."
(changed changed deleted stopped)))
(t '(changed changed deleted stopped)))
(should (file-notify-valid-p file-notify--test-desc))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile))
;; After deleting the file, the descriptor is not valid anymore.
(should-not (file-notify-valid-p file-notify--test-desc))
......@@ -713,10 +719,10 @@ longer than timeout seconds for the events to be delivered."
'(created changed deleted stopped))
(t '(created changed deleted deleted stopped)))
(should (file-notify-valid-p file-notify--test-desc))
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory t))
;; After deleting the parent directory, the descriptor must
;; not be valid anymore.
......@@ -814,9 +820,9 @@ longer than timeout seconds for the events to be delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region "" nil (pop source-file-list) nil 'no-message)
(read-event nil nil 0.1)
(read-event nil nil file-notify--test-read-event-timeout)
(write-region "" nil (pop target-file-list) nil 'no-message))))
(file-notify--test-with-events
(cond
......@@ -829,16 +835,82 @@ longer than timeout seconds for the events to be delivered."
(let ((source-file-list source-file-list)
(target-file-list target-file-list))
(while (and source-file-list target-file-list)
(rename-file (pop source-file-list) (pop target-file-list) t)
(read-event nil nil 0.02))))
(read-event nil nil file-notify--test-read-event-timeout)
(rename-file (pop source-file-list) (pop target-file-list) t))))
(file-notify--test-with-events (make-list n 'deleted)
(dolist (file target-file-list)
(prog1 (delete-file file) (read-event nil nil 0.02)))))
(read-event nil nil file-notify--test-read-event-timeout)
(delete-file file) file-notify--test-read-event-timeout)))
;; Cleanup.
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test06-many-events
"Check that events are not dropped for remote directories.")
(ert-deftest file-notify-test07-backup ()
"Check that backup keeps file supervision."
(skip-unless (file-notify--test-local-enabled))
(unwind-protect
(progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-events '(changed)
;; There shouldn't be any problem, because the file is kept.
(with-temp-buffer
(let ((buffer-file-name file-notify--test-tmpfile)
(make-backup-files t)
(backup-by-copying t)
(kept-new-versions 1)
(delete-old-versions t))
(insert "another text")
(save-buffer))))
;; After saving the buffer, the descriptor is still valid.
(should (file-notify-valid-p file-notify--test-desc))
(delete-file file-notify--test-tmpfile))
;; Cleanup.
(file-notify--test-cleanup))
(unwind-protect
(progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
(setq file-notify--test-desc
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-events '(renamed created changed)
;; The file is renamed when creating a backup. It shall
;; still be watched.
(with-temp-buffer
(let ((buffer-file-name file-notify--test-tmpfile)
(make-backup-files t)
(backup-by-copying nil)
(backup-by-copying-when-mismatch nil)
(kept-new-versions 1)
(delete-old-versions t))
(insert "another text")
(save-buffer))))
;; After saving the buffer, the descriptor is still valid.
(should (file-notify-valid-p file-notify--test-desc))
(delete-file file-notify--test-tmpfile))
;; Cleanup.
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test07-backup
"Check that backup keeps file supervision for remote files.")
(defun file-notify-test-all (&optional interactive)
"Run all tests for \\[file-notify]."
(interactive "p")
......
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