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.
This commit is contained in:
Michael Albinus
parent
67fcd5addc
commit
d5a10aefee
3 changed files with 116 additions and 36 deletions
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue