From 0247489fed0f70b2abf960de48bc4432381a581b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 20 Nov 2015 18:06:42 +0000 Subject: [PATCH] Rework file notifications, kqueue has problems with directory monitors * lisp/filenotify.el (file-notify-add-watch): Call the native add-watch function on the file, not on the dir. * src/kqueue.c (kqueue_compare_dir_list): Make also bookkeeping about already deleted entries. * test/automated/auto-revert-tests.el (auto-revert-test01-auto-revert-several-files): Do not call "cp -f" since this deletes the target file first. * test/automated/file-notify-tests.el (file-notify--test-event-test): Make stronger checks. (file-notify-test01-add-watch, file-notify-test02-events) (file-notify-test04-file-validity, file-notify-test05-dir-validity): Rewrite in order to call file monitors but directory monitors. (file-notify-test06-many-events): Ler rename work in both directions. --- lisp/filenotify.el | 6 +- src/kqueue.c | 48 +++-- test/automated/auto-revert-tests.el | 2 +- test/automated/file-notify-tests.el | 295 ++++++++++++++++------------ 4 files changed, 203 insertions(+), 148 deletions(-) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 5072bf414bf..0d7a2b914c6 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -236,7 +236,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq pending-event nil)) ;; Check for stopped. - ;;(message "file-notify-callback %S %S" file registered) + ;;(message "file-notify-callback %S %S %S" file file1 registered) (setq stopped (or @@ -342,7 +342,7 @@ FILE is the name of the file whose event is being reported." ;; A file name handler could exist even if there is no local ;; file notification support. (setq desc (funcall - handler 'file-notify-add-watch dir flags callback)) + handler 'file-notify-add-watch file flags callback)) ;; Check, whether Emacs has been compiled with file notification ;; support. @@ -379,7 +379,7 @@ FILE is the name of the file whose event is being reported." l-flags))) ;; Call low-level function. - (setq desc (funcall func dir l-flags 'file-notify-callback))) + (setq desc (funcall func file l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. (setq file (unless (file-directory-p file) (file-name-nondirectory file)) diff --git a/src/kqueue.c b/src/kqueue.c index ca0e3e7e1ca..1830040637e 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -111,11 +111,12 @@ static void kqueue_compare_dir_list (Lisp_Object watch_object) { - Lisp_Object dir, pending_events; + Lisp_Object dir, pending_dl, deleted_dl; Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl; dir = XCAR (XCDR (watch_object)); - pending_events = Qnil; + pending_dl = Qnil; + deleted_dl = Qnil; old_directory_files = Fnth (make_number (4), watch_object); old_dl = kqueue_directory_listing (old_directory_files); @@ -168,6 +169,7 @@ kqueue_compare_dir_list kqueue_generate_event (watch_object, Fcons (Qrename, Qnil), XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + deleted_dl = Fcons (new_entry, deleted_dl); } new_dl = Fdelq (new_entry, new_dl); goto the_end; @@ -179,24 +181,35 @@ kqueue_compare_dir_list new_entry = XCAR (dl1); if (strcmp (SSDATA (XCAR (XCDR (old_entry))), SSDATA (XCAR (XCDR (new_entry)))) == 0) { - pending_events = Fcons (new_entry, pending_events); + pending_dl = Fcons (new_entry, pending_dl); new_dl = Fdelq (new_entry, new_dl); goto the_end; } } - new_entry = assq_no_quit (XCAR (old_entry), pending_events); - if (NILP (new_entry)) + /* Check, whether this a pending file. */ + new_entry = assq_no_quit (XCAR (old_entry), pending_dl); + + if (NILP (new_entry)) { + /* Check, whether this is an already deleted file (by rename). */ + for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + deleted_dl = Fdelq (new_entry, deleted_dl); + goto the_end; + } + } /* The file has been deleted. */ kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil); - else { + + } else { /* The file has been renamed. */ kqueue_generate_event (watch_object, Fcons (Qrename, Qnil), XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); - new_dl = Fdelq (new_entry, new_dl); - pending_events = Fdelq (new_entry, pending_events); + pending_dl = Fdelq (new_entry, pending_dl); } the_end: @@ -226,8 +239,8 @@ kqueue_compare_dir_list new_dl = Fdelq (entry, new_dl); } - /* Parse through the resulting pending_events_list. */ - dl = pending_events; + /* Parse through the resulting pending_dl list. */ + dl = pending_dl; while (1) { Lisp_Object entry; if (NILP (dl)) @@ -239,18 +252,21 @@ kqueue_compare_dir_list (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); dl = XCDR (dl); - pending_events = Fdelq (entry, pending_events); + pending_dl = Fdelq (entry, pending_dl); } - /* At this point, old_dl, new_dl and pending_events shall be empty. - Let's make a check for this (might be removed once the code is - stable). */ + /* At this point, old_dl, new_dl and pending_dl shall be empty. + deleted_dl might not be empty when there was a rename to a + nonexisting file. Let's make a check for this (might be removed + once the code is stable). */ if (! NILP (old_dl)) report_file_error ("Old list not empty", old_dl); if (! NILP (new_dl)) report_file_error ("New list not empty", new_dl); - if (! NILP (pending_events)) - report_file_error ("Pending events not empty", new_dl); + if (! NILP (pending_dl)) + report_file_error ("Pending events list not empty", pending_dl); + // if (! NILP (deleted_dl)) + // report_file_error ("Deleted events list not empty", deleted_dl); /* Replace old directory listing with the new one. */ XSETCDR (Fnthcdr (make_number (3), watch_object), diff --git a/test/automated/auto-revert-tests.el b/test/automated/auto-revert-tests.el index 2745f106087..6f186973ee7 100644 --- a/test/automated/auto-revert-tests.el +++ b/test/automated/auto-revert-tests.el @@ -136,7 +136,7 @@ ;; 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 %s/* %s" cp tmpdir2 tmpdir1)) ;; Check, that the buffers have been reverted. (dolist (buf (list buf1 buf2)) diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 81fb42e13b1..7bacddd8855 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -196,12 +196,13 @@ remote host, or nil." (file-notify-add-watch temporary-file-directory '(change attribute-change) 'ignore))) (file-notify-rm-watch file-notify--test-desc) - ;; The file does not need to exist, just the upper directory. + (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 attribute-change) 'ignore))) (file-notify-rm-watch file-notify--test-desc) + (delete-file file-notify--test-tmpfile) ;; Check error handling. (should-error (file-notify-add-watch 1 2 3 4) @@ -242,16 +243,17 @@ is bound somewhere." (should (or (string-equal (file-notify--event-file-name file-notify--test-event) file-notify--test-tmpfile) - (string-equal (directory-file-name - (file-name-directory - (file-notify--event-file-name file-notify--test-event))) - file-notify--test-tmpfile))) + (string-equal (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. (when (eq (nth 1 file-notify--test-event) 'renamed) (should - (string-equal - (file-notify--event-file1-name file-notify--test-event) - file-notify--test-tmpfile1)))) + (or (string-equal (file-notify--event-file1-name file-notify--test-event) + file-notify--test-tmpfile1) + (string-equal (file-notify--event-file1-name file-notify--test-event) + temporary-file-directory))))) (defun file-notify--test-event-handler (event) "Run a test over FILE-NOTIFY--TEST-EVENT. @@ -306,103 +308,111 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; Under cygwin there are so bad timings that it doesn't make sense to test. (skip-unless (not (eq system-type 'cygwin))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-tmpfile1 (file-notify--test-make-temp-name)) - (unwind-protect (progn - ;; Check creation, change and deletion. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (file-notify--test-with-events '(created changed deleted) + ;; Check file change and deletion. + (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))) + (file-notify--test-with-events '(changed deleted) (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) + "another text" nil file-notify--test-tmpfile nil 'no-message) (delete-file file-notify--test-tmpfile)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc)) - ;; Check creation, change and deletion. There must be a - ;; `stopped' event when deleting the directory. It doesn't - ;; work for w32notify. + ;; Check file creation, change and deletion when watching a + ;; directory. There must be a `stopped' event when deleting + ;; the directory. It doesn't work for w32notify. (unless (string-equal (file-notify--test-library) "w32notify") - (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events + ;; There are two `deleted' events, for the file and + ;; for the directory. Except for kqueue. + (if (string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped) + '(created changed deleted deleted stopped)) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (delete-directory temporary-file-directory 'recursive)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc)))) + + ;; Check copy of files inside a directory. + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) (file-notify--test-with-events - ;; There are two `deleted' events, for the file and for - ;; the directory. Except for kqueue. - (if (string-equal (file-notify--test-library) "kqueue") - '(created changed deleted stopped) - '(created changed deleted deleted stopped)) + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + (if (string-equal (file-notify--test-library) "w32notify") + '(created changed changed deleted) + '(created changed created changed deleted stopped)) (write-region - "any text" nil (expand-file-name "foo" file-notify--test-tmpfile) - nil 'no-message) + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) + ;; The next two events shall not be visible. + (read-event nil nil 0.1) + (set-file-modes file-notify--test-tmpfile 000) + (read-event nil nil 0.1) + (set-file-times file-notify--test-tmpfile '(0 0)) (read-event nil nil 0.1) - (delete-directory file-notify--test-tmpfile 'recursive)) + (delete-directory temporary-file-directory 'recursive)) ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. (let (file-notify--test-events) (file-notify-rm-watch file-notify--test-desc))) - ;; Check copy. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (should file-notify--test-desc) - (file-notify--test-with-events - ;; w32notify does not distinguish between `changed' and - ;; `attribute-changed'. - (if (string-equal (file-notify--test-library) "w32notify") - '(created changed changed deleted) - '(created changed deleted)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) - ;; The next two events shall not be visible. - (read-event nil nil 0.1) - (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil 0.1) - (set-file-times file-notify--test-tmpfile '(0 0)) - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile) - (read-event nil nil 0.1) - (delete-file file-notify--test-tmpfile1)) - ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. - (let (file-notify--test-events) - (file-notify-rm-watch file-notify--test-desc)) - - ;; Check rename. - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) - (should file-notify--test-desc) - (file-notify--test-with-events '(created changed renamed) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil 0.1) - (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) - (delete-file file-notify--test-tmpfile1)) - ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. - (let (file-notify--test-events) - (file-notify-rm-watch file-notify--test-desc)) + ;; Check rename of files inside a directory. + (let ((temporary-file-directory + (make-temp-file "file-notify-test-parent" t))) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) 'file-notify--test-event-handler))) + (file-notify--test-with-events '(created changed renamed) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (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) + (delete-directory temporary-file-directory 'recursive)) + ;; `file-notify-rm-watch' fires the `stopped' event. Suppress it. + (let (file-notify--test-events) + (file-notify-rm-watch file-notify--test-desc))) ;; Check attribute change. It doesn't work for kqueue and w32notify. (unless (or (string-equal (file-notify--test-library) "kqueue") (string-equal (file-notify--test-library) "w32notify")) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(attribute-change) 'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(attribute-change) 'file-notify--test-event-handler))) (file-notify--test-with-events (if (file-remote-p temporary-file-directory) ;; In the remote case, `write-region' raises also an @@ -533,23 +543,41 @@ Don't wait longer than timeout seconds for the events to be delivered." (unwind-protect (progn - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) - (file-notify--test-with-events '(created changed deleted) + (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)) + ;; After calling `file-notify-rm-watch', the descriptor is not + ;; valid anymore. + (file-notify-rm-watch file-notify--test-desc) + (should-not (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))) + (file-notify--test-with-events '(changed deleted) (should (file-notify-valid-p file-notify--test-desc)) (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) + "another text" nil file-notify--test-tmpfile nil 'no-message) (read-event nil nil 0.1) (delete-file file-notify--test-tmpfile)) - ;; After deleting the file, the descriptor is still valid. - (should (file-notify-valid-p file-notify--test-desc)) - ;; After removing the watch, the descriptor must not be valid - ;; anymore. - (file-notify-rm-watch file-notify--test-desc) - (should-not (file-notify-valid-p file-notify--test-desc))) + ;; After deleting the file, the descriptor is not valid anymore. + (should-not (file-notify-valid-p file-notify--test-desc)) + (file-notify-rm-watch file-notify--test-desc)) ;; Cleanup. (file-notify--test-cleanup)) @@ -560,11 +588,12 @@ Don't wait longer than timeout seconds for the events to be delivered." (unless (string-equal (file-notify--test-library) "w32notify") (let ((temporary-file-directory (make-temp-file "file-notify-test-parent" t))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (should + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-desc + (file-notify-add-watch + temporary-file-directory + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events ;; There are two `deleted' events, for the file and for ;; the directory. Except for kqueue. @@ -595,10 +624,11 @@ Don't wait longer than timeout seconds for the events to be delivered." (setq file-notify--test-tmpfile (file-name-as-directory (file-notify--test-make-temp-name))) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (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)) ;; After removing the watch, the descriptor must not be valid ;; anymore. @@ -619,10 +649,11 @@ Don't wait longer than timeout seconds for the events to be delivered." (setq file-notify--test-tmpfile (file-name-as-directory (file-notify--test-make-temp-name))) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler)) + (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)) ;; After deleting the directory, the descriptor must not be ;; valid anymore. @@ -645,31 +676,39 @@ Don't wait longer than timeout seconds for the events to be delivered." (skip-unless (not (eq system-type 'cygwin))) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (make-directory file-notify--test-tmpfile) - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) 'file-notify--test-event-handler))) (unwind-protect (let ((n 1000) - x-file-list y-file-list + source-file-list target-file-list (default-directory file-notify--test-tmpfile)) (dotimes (i n) - (push (expand-file-name (format "x%d" i)) x-file-list) - (push (expand-file-name (format "y%d" i)) y-file-list)) + ;; It matters which direction we rename, at least for + ;; kqueue. This backend parses directories in alphabetic + ;; order (x%d before y%d). So we rename both directions. + (if (zerop (mod i 2)) + (progn + (push (expand-file-name (format "x%d" i)) source-file-list) + (push (expand-file-name (format "y%d" i)) target-file-list)) + (push (expand-file-name (format "y%d" i)) source-file-list) + (push (expand-file-name (format "x%d" i)) target-file-list))) (file-notify--test-with-events (make-list (+ n n) 'created) - (let ((x-file-list x-file-list) - (y-file-list y-file-list)) - (while (and x-file-list y-file-list) - (write-region "" nil (pop x-file-list) nil 'no-message) + (let ((source-file-list source-file-list) + (target-file-list target-file-list)) + (while (and source-file-list target-file-list) + (write-region "" nil (pop source-file-list) nil 'no-message) (read-event nil nil 0.1) - (write-region "" nil (pop y-file-list) nil 'no-message)))) + (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-events (make-list n 'renamed) - (let ((x-file-list x-file-list) - (y-file-list y-file-list)) - (while (and x-file-list y-file-list) - (rename-file (pop x-file-list) (pop y-file-list) t)))) + (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)))) (file-notify--test-with-events (make-list n 'deleted) - (dolist (file y-file-list) + (dolist (file target-file-list) (delete-file file)))) (file-notify--test-cleanup))) -- 2.39.2