procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Additional fixes for file notification

Browse source 
* lisp/filenotify.el (top): Require 'cl when compiling.
(file-notify--event-watched-file): New defun.
(file-notify--rm-descriptor, file-notify-callback):
Handle case of several monitors running in parallel.

* test/automated/file-notify-tests.el
(file-notify--test-event-test): Simplify test.
(file-notify--test-with-events): Get rid of outer definition.
Check also results of tests performed in callbacks.
(file-notify-test02-events): No wrapping when calling
`file-notify-rm-watch'.  No special checking for callback tests.
(file-notify-test07-backup): Adapt expected events for gfilenotify.
(file-notify-test08-watched-file-in-watched-dir): Improve.
This commit is contained in:
Michael Albinus 2016-02-22 18:52:37 +01:00
parent 6bd9d697fd
commit a9c48d5c9e
2 changed files with 172 additions and 131 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
lisp/filenotify.el
View file

@ -27,6 +27,9 @@
;;; Code: ;;; Code:
(eval-when-compile
(require 'cl))
(defconst file-notify--library (defconst file-notify--library
(cond (cond
((featurep 'inotify) 'inotify) ((featurep 'inotify) 'inotify)
@ -54,18 +57,15 @@ different files from the same directory are watched.")
DESCRIPTOR should be an object returned by `file-notify-add-watch'. DESCRIPTOR should be an object returned by `file-notify-add-watch'.
If it is registered in `file-notify-descriptors', a stopped event is sent." If it is registered in `file-notify-descriptors', a stopped event is sent."
(let* ((desc (if (consp descriptor) (car descriptor) descriptor)) (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
(file (if (consp descriptor) (cdr descriptor)))
(registered (gethash desc file-notify-descriptors)) (registered (gethash desc file-notify-descriptors))
(file (if (consp descriptor) (cdr descriptor) (caadr registered)))
(dir (car registered))) (dir (car registered)))
(when (consp registered) (when (consp registered)
;; Send `stopped' event. ;; Send `stopped' event.
(dolist (entry (cdr registered)) (funcall
(funcall (cdr entry) (cdr (assoc file (cdr registered)))
`(,descriptor stopped `(,descriptor stopped ,(if file (expand-file-name file dir) dir)))
,(or (and (stringp (car entry))
(expand-file-name (car entry) dir))
dir))))
;; Modify `file-notify-descriptors'. ;; Modify `file-notify-descriptors'.
(if (not file) (if (not file)
@ -99,6 +99,15 @@ Otherwise, signal a `file-notify-error'."
"A pending file notification events for a future `renamed' action. "A pending file notification events for a future `renamed' action.
It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).") It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
(defun file-notify--event-watched-file (event)
"Return file or directory being watched.
Could be different from the directory watched by the backend library."
(let* ((desc (if (consp (car event)) (caar event) (car event)))
(registered (gethash desc file-notify-descriptors))
(file (if (consp (car event)) (cdar event) (caadr registered)))
(dir (car registered)))
(if file (expand-file-name file dir) dir)))
(defun file-notify--event-file-name (event) (defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil." "Return file name of file notification event, or nil."
(directory-file-name (directory-file-name
@ -234,26 +243,6 @@ EVENT is the cadr of the event in `file-notify-handle-event'
(funcall (cadr pending-event) (car pending-event)) (funcall (cadr pending-event) (car pending-event))
(setq pending-event nil)) (setq pending-event nil))
;; Check for stopped.
(setq
stopped
(or
stopped
(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)))))))
;; Apply callback. ;; Apply callback.
(when (and action (when (and action
(or (or
@ -282,11 +271,15 @@ EVENT is the cadr of the event in `file-notify-handle-event'
,action ,file ,file1)) ,action ,file ,file1))
(funcall (funcall
callback callback
`(,(file-notify--descriptor desc (car entry)) ,action ,file))))) `(,(file-notify--descriptor desc (car entry)) ,action ,file))))
;; Modify `file-notify-descriptors'. ;; Send `stopped' event.
(when stopped (when (and (memq action '(deleted renamed))
(file-notify-rm-watch (file-notify--descriptor desc file)))))) ;; Not, when a file is backed up.
(not (and (stringp file1) (backup-file-name-p file1)))
;; Watched file or directory is concerned.
(string-equal file (file-notify--event-watched-file event)))
(file-notify-rm-watch (file-notify--descriptor desc (car entry))))))))
;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
;; for every `file-notify-add-watch', while `inotify' returns a unique ;; for every `file-notify-add-watch', while `inotify' returns a unique

248
test/automated/file-notify-tests.el
View file

@ -256,19 +256,15 @@ is bound somewhere."
(should (equal (car file-notify--test-event) file-notify--test-desc)) (should (equal (car file-notify--test-event) file-notify--test-desc))
;; Check the file name. ;; Check the file name.
(should (should
(or (string-equal (file-notify--event-file-name file-notify--test-event) (string-prefix-p
file-notify--test-tmpfile) (file-notify--event-watched-file file-notify--test-event)
(string-equal (file-notify--event-file-name file-notify--test-event) (file-notify--event-file-name file-notify--test-event)))
file-notify--test-tmpfile1)
(string-equal (file-notify--event-file-name file-notify--test-event)
temporary-file-directory)))
;; Check the second file name if exists. ;; Check the second file name if exists.
(when (eq (nth 1 file-notify--test-event) 'renamed) (when (eq (nth 1 file-notify--test-event) 'renamed)
(should (should
(or (string-equal (file-notify--event-file1-name file-notify--test-event) (string-prefix-p
file-notify--test-tmpfile1) (file-notify--event-watched-file file-notify--test-event)
(string-equal (file-notify--event-file1-name file-notify--test-event) (file-notify--event-file1-name file-notify--test-event)))))
temporary-file-directory)))))
(defun file-notify--test-event-handler (event) (defun file-notify--test-event-handler (event)
"Run a test over FILE-NOTIFY--TEST-EVENT. "Run a test over FILE-NOTIFY--TEST-EVENT.
@ -326,25 +322,28 @@ EVENTS is either a simple list of events, or a list of lists of
events, which represent different possible results. Don't wait events, which represent different possible results. Don't wait
longer than timeout seconds for the events to be delivered." longer than timeout seconds for the events to be delivered."
(declare (indent 1)) (declare (indent 1))
(let ((outer (make-symbol "outer"))) `(let* ((events (if (consp (car ,events)) ,events (list ,events)))
`(let* ((,outer file-notify--test-events) (max-length (apply 'max (mapcar 'length events)))
(events (if (consp (car ,events)) ,events (list ,events))) create-lockfiles)
(max-length (apply 'max (mapcar 'length events))) ;; Flush pending events.
create-lockfiles) (file-notify--wait-for-events
;; Flush pending events. (file-notify--test-timeout)
(file-notify--wait-for-events (input-pending-p))
(file-notify--test-timeout) (setq file-notify--test-events nil
(input-pending-p)) file-notify--test-results nil)
(let (file-notify--test-events) ,@body
,@body (file-notify--wait-for-events
(file-notify--wait-for-events ;; More events need more time. Use some fudge factor.
;; More events need more time. Use some fudge factor. (* (ceiling max-length 100) (file-notify--test-timeout))
(* (ceiling max-length 100) (file-notify--test-timeout)) (= max-length (length file-notify--test-events)))
(= max-length (length file-notify--test-events))) ;; Check the result sequence just to make sure that all events
;; One of the possible results shall match. ;; are as expected.
(should (file-notify--test-with-events-check events)) (dolist (result file-notify--test-results)
(setq ,outer (append ,outer file-notify--test-events))) (when (ert-test-failed-p result)
(setq file-notify--test-events ,outer)))) (ert-fail
(cadr (ert-test-result-with-condition-condition result)))))
;; One of the possible event sequences shall match.
(should (file-notify--test-with-events-check events))))
(ert-deftest file-notify-test02-events () (ert-deftest file-notify-test02-events ()
"Check file creation/change/removal notifications." "Check file creation/change/removal notifications."
@ -373,9 +372,7 @@ longer than timeout seconds for the events to be delivered."
"another text" nil file-notify--test-tmpfile nil 'no-message) "another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile)) (delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc))
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc)))
;; Check file change and deletion. ;; Check file change and deletion.
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
@ -405,9 +402,7 @@ longer than timeout seconds for the events to be delivered."
"another text" nil file-notify--test-tmpfile nil 'no-message) "another text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile)) (delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc)
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc))
;; Check file creation, change and deletion when watching a ;; Check file creation, change and deletion when watching a
;; directory. There must be a `stopped' event when deleting ;; directory. There must be a `stopped' event when deleting
@ -439,9 +434,7 @@ longer than timeout seconds for the events to be delivered."
"any text" nil file-notify--test-tmpfile nil 'no-message) "any text" nil file-notify--test-tmpfile nil 'no-message)
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive)) (delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc))
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc)))
;; Check copy of files inside a directory. ;; Check copy of files inside a directory.
(let ((temporary-file-directory (let ((temporary-file-directory
@ -481,9 +474,7 @@ longer than timeout seconds for the events to be delivered."
(set-file-times file-notify--test-tmpfile '(0 0)) (set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive)) (delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc))
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc)))
;; Check rename of files inside a directory. ;; Check rename of files inside a directory.
(let ((temporary-file-directory (let ((temporary-file-directory
@ -517,9 +508,7 @@ longer than timeout seconds for the events to be delivered."
;; After the rename, we won't get events anymore. ;; After the rename, we won't get events anymore.
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-directory temporary-file-directory 'recursive)) (delete-directory temporary-file-directory 'recursive))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc))
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc)))
;; Check attribute change. Does not work for cygwin. ;; Check attribute change. Does not work for cygwin.
(unless (eq system-type 'cygwin) (unless (eq system-type 'cygwin)
@ -552,17 +541,7 @@ longer than timeout seconds for the events to be delivered."
(set-file-times file-notify--test-tmpfile '(0 0)) (set-file-times file-notify--test-tmpfile '(0 0))
(read-event nil nil file-notify--test-read-event-timeout) (read-event nil nil file-notify--test-read-event-timeout)
(delete-file file-notify--test-tmpfile)) (delete-file file-notify--test-tmpfile))
;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (file-notify-rm-watch file-notify--test-desc)))
(let (file-notify--test-events)
(file-notify-rm-watch file-notify--test-desc)))
;; Check the global sequence just to make sure that all
;; results are as expected.
(should file-notify--test-results)
(dolist (result file-notify--test-results)
(when (ert-test-failed-p result)
(ert-fail
(cadr (ert-test-result-with-condition-condition result))))))
;; Cleanup. ;; Cleanup.
(file-notify--test-cleanup))) (file-notify--test-cleanup)))
@ -832,7 +811,7 @@ longer than timeout seconds for the events to be delivered."
(dotimes (i n) (dotimes (i n)
;; It matters which direction we rename, at least for ;; It matters which direction we rename, at least for
;; kqueue. This backend parses directories in alphabetic ;; kqueue. This backend parses directories in alphabetic
;; order (x%d before y%d). So we rename both directions. ;; order (x%d before y%d). So we rename into both directions.
(if (zerop (mod i 2)) (if (zerop (mod i 2))
(progn (progn
(push (expand-file-name (format "x%d" i)) source-file-list) (push (expand-file-name (format "x%d" i)) source-file-list)
@ -892,6 +871,11 @@ longer than timeout seconds for the events to be delivered."
((or (string-equal (file-notify--test-library) "w32notify") ((or (string-equal (file-notify--test-library) "w32notify")
(file-remote-p temporary-file-directory)) (file-remote-p temporary-file-directory))
'(changed changed)) '(changed changed))
;; gfilenotify raises one or two `changed' events
;; randomly, no chance to test. So we accept both cases.
((string-equal "gfilenotify" (file-notify--test-library))
'((changed)
(changed changed)))
(t '(changed))) (t '(changed)))
;; There shouldn't be any problem, because the file is kept. ;; There shouldn't be any problem, because the file is kept.
(with-temp-buffer (with-temp-buffer
@ -955,52 +939,116 @@ the file watch."
:tags '(:expensive-test) :tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled)) (skip-unless (file-notify--test-local-enabled))
;; A directory to be watched.
(should
(setq file-notify--test-tmpfile
(make-temp-file "file-notify-test-parent" t)))
;; A file to be watched.
(should
(setq file-notify--test-tmpfile1
(let ((temporary-file-directory file-notify--test-tmpfile))
(file-notify--test-make-temp-name))))
(write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message)
(unwind-protect (unwind-protect
(progn (cl-flet (;; Directory monitor.
(setq file-notify--test-tmpfile (dir-callback (event)
(make-temp-file "dir" t)) (let ((file-notify--test-desc file-notify--test-desc1))
(setq file-notify--test-tmpfile1 (file-notify--test-event-handler event)))
(let ((temporary-file-directory file-notify--test-tmpfile)) ;; File monitor.
(make-temp-file "file"))) (file-callback (event)
(cl-flet ((dir-callback (event) (let ((file-notify--test-desc file-notify--test-desc2))
(let ((file-notify--test-desc file-notify--test-desc1) (file-notify--test-event-handler event))))
(file-notify--test-tmpfile (should
(file-notify--event-file-name event))) (setq file-notify--test-desc1
(file-notify--test-event-handler event))) (file-notify-add-watch
(file-callback (event) file-notify--test-tmpfile
(let ((file-notify--test-desc file-notify--test-desc2)) '(change) #'dir-callback)))
(file-notify--test-event-handler event)))) (should
(should (setq file-notify--test-desc2
(setq file-notify--test-desc1 (file-notify-add-watch
(file-notify-add-watch file-notify--test-tmpfile1
file-notify--test-tmpfile '(change) #'file-callback)))
'(change attribute-change) #'dir-callback))) (should (file-notify-valid-p file-notify--test-desc1))
(should (should (file-notify-valid-p file-notify--test-desc2))
(setq file-notify--test-desc2 (should-not (equal file-notify--test-desc1 file-notify--test-desc2))
(file-notify-add-watch ;; gfilenotify raises one or two `changed' events randomly in
file-notify--test-tmpfile1 ;; the file monitor, no chance to test.
'(change attribute-change) #'file-callback))) (unless (string-equal "gfilenotify" (file-notify--test-library))
(should (file-notify-valid-p file-notify--test-desc1)) (let ((n 100) events)
(should (file-notify-valid-p file-notify--test-desc2)) ;; Compute the expected events.
(dotimes (i 100) (dotimes (_i (/ n 2))
(read-event nil nil file-notify--test-read-event-timeout) (setq events
(if (< 0 (random)) (append
(write-region (append
"any text" nil file-notify--test-tmpfile1 t 'no-message) ;; Directory monitor and file monitor.
(let ((temporary-file-directory file-notify--test-tmpfile)) (cond
(make-temp-file "fileX")))) ;; In the remote case, there are two `changed'
(should (file-notify-valid-p file-notify--test-desc1)) ;; events.
(should (file-notify-valid-p file-notify--test-desc2)) ((file-remote-p temporary-file-directory)
(delete-file file-notify--test-tmpfile1) '(changed changed changed changed))
(delete-directory file-notify--test-tmpfile 'recursive)) ;; The directory monitor in kqueue does not
;; raise any `changed' event. Just the file
;; monitor event is received.
((string-equal (file-notify--test-library) "kqueue")
'(changed))
;; Otherwise, both monitors report the
;; `changed' event.
(t '(changed changed)))
;; Just the directory monitor.
(cond
;; In kqueue, there is an additional `changed'
;; event. Why?
((string-equal (file-notify--test-library) "kqueue")
'(changed created changed))
(t '(created changed))))
events)))
;; Check the global sequence just to make sure that all ;; Run the test.
;; results are as expected. (file-notify--test-with-events events
(should file-notify--test-results) (dotimes (i n)
(dolist (result file-notify--test-results) (read-event nil nil file-notify--test-read-event-timeout)
(when (ert-test-failed-p result) (if (zerop (mod i 2))
(ert-fail (write-region
(cadr (ert-test-result-with-condition-condition result)))))) "any text" nil file-notify--test-tmpfile1 t 'no-message)
(let ((temporary-file-directory file-notify--test-tmpfile))
(write-region
"any text" nil
(file-notify--test-make-temp-name) nil 'no-message)))))))
;; If we delete the file, the directory monitor shall still be
;; active. We receive the `deleted' event from both the
;; directory and the file monitor. The `stopped' event is
;; from the file monitor. It's undecided in which order the
;; the directory and the file monitor are triggered.
(file-notify--test-with-events
'((deleted deleted stopped)
(deleted stopped deleted))
(delete-file file-notify--test-tmpfile1))
(should (file-notify-valid-p file-notify--test-desc1))
(should-not (file-notify-valid-p file-notify--test-desc2))
;; Now we delete the directory.
(file-notify--test-with-events
(cond
;; In kqueue, just one `deleted' event for the directory
;; is received.
((string-equal (file-notify--test-library) "kqueue")
'(deleted stopped))
(t (append
;; The directory monitor raises a `deleted' event for
;; every file contained in the directory, we must
;; count them.
(make-list
(length
(directory-files
file-notify--test-tmpfile nil
directory-files-no-dot-files-regexp 'nosort))
'deleted)
;; The events of the directory itself.
'(deleted stopped))))
(delete-directory file-notify--test-tmpfile 'recursive))
(should-not (file-notify-valid-p file-notify--test-desc1))
(should-not (file-notify-valid-p file-notify--test-desc2)))
;; Cleanup. ;; Cleanup.
(file-notify--test-cleanup))) (file-notify--test-cleanup)))