Additional fixes for file notification

* 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.

diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index ba76baca3b4ad1cc10528623e10db269fe066686..21046a85a7a5ac9d86b0f40554e95ed0d872e792 100644 (file)
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -27,6 +27,9 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(eval-when-compile
+  (require 'cl))
+

 (defconst file-notify--library
   (cond
    ((featurep 'inotify) 'inotify)
 (defconst file-notify--library
   (cond
    ((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'.
 If it is registered in `file-notify-descriptors', a stopped event is sent."
   (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
 DESCRIPTOR should be an object returned by `file-notify-add-watch'.
 If it is registered in `file-notify-descriptors', a stopped event is sent."
   (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)))
 
     (when (consp registered)
       ;; Send `stopped' event.
         (dir (car registered)))
 
     (when (consp registered)
       ;; Send `stopped' event.

-      (dolist (entry (cdr registered))
-       (funcall (cdr entry)
-                `(,descriptor stopped
-                  ,(or (and (stringp (car entry))
-                            (expand-file-name (car entry) dir))
-                       dir))))
+      (funcall
+       (cdr (assoc file (cdr registered)))
+       `(,descriptor stopped ,(if file (expand-file-name file dir) dir)))

 
       ;; Modify `file-notify-descriptors'.
       (if (not file)
 
       ;; Modify `file-notify-descriptors'.
       (if (not file)


@@ -99,6 +99,15 @@ Otherwise, signal a `file-notify-error'."
   "A pending file notification events for a future `renamed' action.
 It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
 
   "A pending file notification events for a future `renamed' action.
 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)
   "Return file name of file notification event, or nil."
   (directory-file-name
 (defun file-notify--event-file-name (event)
   "Return file name of file notification event, or nil."
   (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))
           (setq pending-event nil))
 
           (funcall (cadr pending-event) (car pending-event))
           (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.
        (when (and action
                   (or
        ;; Apply callback.
        (when (and action
                   (or


@@ -282,11 +271,15 @@ EVENT is the cadr of the event in `file-notify-handle-event'
                  ,action ,file ,file1))
            (funcall
             callback
                  ,action ,file ,file1))
            (funcall
             callback

-            `(,(file-notify--descriptor desc (car entry)) ,action ,file)))))
-
-      ;; Modify `file-notify-descriptors'.
-      (when stopped
-        (file-notify-rm-watch (file-notify--descriptor desc file))))))
+            `(,(file-notify--descriptor desc (car entry)) ,action ,file))))
+
+        ;; Send `stopped' event.
+        (when (and (memq action '(deleted renamed))
+                   ;; 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
 ;; for every `file-notify-add-watch', while `inotify' returns a unique
 
 ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
 ;; for every `file-notify-add-watch', while `inotify' returns a unique

diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el
index ac33d680a1071998a2d1d350083f1af40d23ffc2..a16de7fb0587e7e888d8e1d70d2087e9bdfc7577 100644 (file)
--- a/test/automated/file-notify-tests.el
+++ b/test/automated/file-notify-tests.el
@@ -256,19 +256,15 @@ is bound somewhere."
   (should (equal (car file-notify--test-event) file-notify--test-desc))
   ;; Check the file name.
   (should
   (should (equal (car file-notify--test-event) file-notify--test-desc))
   ;; Check the file name.
   (should

-   (or (string-equal (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)))
+   (string-prefix-p
+    (file-notify--event-watched-file file-notify--test-event)
+    (file-notify--event-file-name file-notify--test-event)))

   ;; Check the second file name if exists.
   (when (eq (nth 1 file-notify--test-event) 'renamed)
     (should
   ;; Check the second file name if exists.
   (when (eq (nth 1 file-notify--test-event) 'renamed)
     (should

-     (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)))))
+     (string-prefix-p
+      (file-notify--event-watched-file file-notify--test-event)
+      (file-notify--event-file1-name file-notify--test-event)))))

 
 (defun file-notify--test-event-handler (event)
   "Run a test over FILE-NOTIFY--TEST-EVENT.
 
 (defun file-notify--test-event-handler (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
 longer than timeout seconds for the events to be delivered."
   (declare (indent 1))
 events, which represent different possible results.  Don't wait
 longer than timeout seconds for the events to be delivered."
   (declare (indent 1))

-  (let ((outer (make-symbol "outer")))
-    `(let* ((,outer file-notify--test-events)
-            (events (if (consp (car ,events)) ,events (list ,events)))
-            (max-length (apply 'max (mapcar 'length events)))
-            create-lockfiles)
-       ;; Flush pending events.
-       (file-notify--wait-for-events
-        (file-notify--test-timeout)
-        (input-pending-p))
-       (let (file-notify--test-events)
-         ,@body
-         (file-notify--wait-for-events
-          ;; More events need more time.  Use some fudge factor.
-          (* (ceiling max-length 100) (file-notify--test-timeout))
-          (= max-length (length file-notify--test-events)))
-         ;; One of the possible results shall match.
-         (should (file-notify--test-with-events-check events))
-         (setq ,outer (append ,outer file-notify--test-events)))
-       (setq file-notify--test-events ,outer))))
+  `(let* ((events (if (consp (car ,events)) ,events (list ,events)))
+          (max-length (apply 'max (mapcar 'length events)))
+          create-lockfiles)
+     ;; Flush pending events.
+     (file-notify--wait-for-events
+      (file-notify--test-timeout)
+      (input-pending-p))
+     (setq file-notify--test-events nil
+           file-notify--test-results nil)
+     ,@body
+     (file-notify--wait-for-events
+      ;; More events need more time.  Use some fudge factor.
+      (* (ceiling max-length 100) (file-notify--test-timeout))
+      (= max-length (length file-notify--test-events)))
+     ;; Check the result sequence just to make sure that all events
+     ;; are as expected.
+     (dolist (result file-notify--test-results)
+       (when (ert-test-failed-p result)
+         (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 ()
   "Check file creation/change/removal notifications."
 
 (ert-deftest file-notify-test02-events ()
   "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)
             (read-event nil nil file-notify--test-read-event-timeout)
             (delete-file file-notify--test-tmpfile))
              "another text" nil file-notify--test-tmpfile nil 'no-message)
             (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)
-            (file-notify-rm-watch file-notify--test-desc)))
+          (file-notify-rm-watch file-notify--test-desc))

 
         ;; Check file change and deletion.
        (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
 
         ;; Check file change and deletion.
        (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)
           (read-event nil nil file-notify--test-read-event-timeout)
           (delete-file file-notify--test-tmpfile))
            "another text" nil file-notify--test-tmpfile nil 'no-message)
           (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)
-         (file-notify-rm-watch file-notify--test-desc))
+        (file-notify-rm-watch file-notify--test-desc)

 
         ;; Check file creation, change and deletion when watching a
         ;; directory.  There must be a `stopped' event when deleting
 
         ;; Check file creation, change and deletion when watching a
         ;; 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)
            (read-event nil nil file-notify--test-read-event-timeout)
            (delete-directory temporary-file-directory 'recursive))
             "any text" nil file-notify--test-tmpfile nil 'no-message)
            (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)
-           (file-notify-rm-watch file-notify--test-desc)))
+          (file-notify-rm-watch file-notify--test-desc))

 
         ;; Check copy of files inside a directory.
        (let ((temporary-file-directory
 
         ;; Check copy of files inside a 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))
            (read-event nil nil file-notify--test-read-event-timeout)
            (delete-directory temporary-file-directory 'recursive))
            (set-file-times file-notify--test-tmpfile '(0 0))
            (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)
-           (file-notify-rm-watch file-notify--test-desc)))
+          (file-notify-rm-watch file-notify--test-desc))

 
         ;; Check rename of files inside a directory.
        (let ((temporary-file-directory
 
         ;; Check rename of files inside a 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.
            (read-event nil nil file-notify--test-read-event-timeout)
            (delete-directory temporary-file-directory 'recursive))
            ;; After the rename, we won't get events anymore.
            (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)
-           (file-notify-rm-watch file-notify--test-desc)))
+          (file-notify-rm-watch file-notify--test-desc))

 
         ;; Check attribute change.  Does not work for cygwin.
        (unless (eq system-type 'cygwin)
 
         ;; Check attribute change.  Does not work for 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))
            (read-event nil nil file-notify--test-read-event-timeout)
            (delete-file file-notify--test-tmpfile))
            (set-file-times file-notify--test-tmpfile '(0 0))
            (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)
-           (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))))))
+          (file-notify-rm-watch file-notify--test-desc)))

 
     ;; Cleanup.
     (file-notify--test-cleanup)))
 
     ;; Cleanup.
     (file-notify--test-cleanup)))


@@ -832,7 +811,7 @@ longer than timeout seconds for the events to be delivered."
         (dotimes (i n)
          ;; It matters which direction we rename, at least for
          ;; kqueue.  This backend parses directories in alphabetic
         (dotimes (i n)
          ;; 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.
+         ;; order (x%d before y%d).  So we rename into both directions.

          (if (zerop (mod i 2))
              (progn
                (push (expand-file-name (format "x%d" i)) source-file-list)
          (if (zerop (mod i 2))
              (progn
                (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")
                   (file-remote-p temporary-file-directory))
               '(changed changed))
              ((or (string-equal (file-notify--test-library) "w32notify")
                   (file-remote-p temporary-file-directory))
               '(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)))
           ;; There shouldn't be any problem, because the file is kept.
           (with-temp-buffer
              (t '(changed)))
           ;; There shouldn't be any problem, because the file is kept.
           (with-temp-buffer


@@ -955,52 +939,116 @@ the file watch."
   :tags '(:expensive-test)
   (skip-unless (file-notify--test-local-enabled))
 
   :tags '(:expensive-test)
   (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
-        (setq file-notify--test-tmpfile
-              (make-temp-file "dir" t))
-        (setq file-notify--test-tmpfile1
-              (let ((temporary-file-directory file-notify--test-tmpfile))
-                (make-temp-file "file")))
-       (cl-flet ((dir-callback (event)
-                   (let ((file-notify--test-desc file-notify--test-desc1)
-                         (file-notify--test-tmpfile
-                          (file-notify--event-file-name event)))
-                     (file-notify--test-event-handler event)))
-                  (file-callback (event)
-                   (let ((file-notify--test-desc file-notify--test-desc2))
-                     (file-notify--test-event-handler event))))
-          (should
-           (setq file-notify--test-desc1
-                 (file-notify-add-watch
-                  file-notify--test-tmpfile
-                  '(change attribute-change) #'dir-callback)))
-          (should
-           (setq file-notify--test-desc2
-                 (file-notify-add-watch
-                  file-notify--test-tmpfile1
-                  '(change attribute-change) #'file-callback)))
-          (should (file-notify-valid-p file-notify--test-desc1))
-          (should (file-notify-valid-p file-notify--test-desc2))
-          (dotimes (i 100)
-            (read-event nil nil file-notify--test-read-event-timeout)
-            (if (< 0 (random))
-                (write-region
-                 "any text" nil file-notify--test-tmpfile1 t 'no-message)
-              (let ((temporary-file-directory file-notify--test-tmpfile))
-                (make-temp-file "fileX"))))
-          (should (file-notify-valid-p file-notify--test-desc1))
-          (should (file-notify-valid-p file-notify--test-desc2))
-          (delete-file file-notify--test-tmpfile1)
-          (delete-directory file-notify--test-tmpfile 'recursive))
+      (cl-flet (;; Directory monitor.
+                (dir-callback (event)
+                 (let ((file-notify--test-desc file-notify--test-desc1))
+                   (file-notify--test-event-handler event)))
+                ;; File monitor.
+                (file-callback (event)
+                 (let ((file-notify--test-desc file-notify--test-desc2))
+                   (file-notify--test-event-handler event))))
+        (should
+         (setq file-notify--test-desc1
+               (file-notify-add-watch
+                file-notify--test-tmpfile
+                '(change) #'dir-callback)))
+        (should
+         (setq file-notify--test-desc2
+               (file-notify-add-watch
+                file-notify--test-tmpfile1
+                '(change) #'file-callback)))
+        (should (file-notify-valid-p file-notify--test-desc1))
+        (should (file-notify-valid-p file-notify--test-desc2))
+        (should-not (equal file-notify--test-desc1 file-notify--test-desc2))
+        ;; gfilenotify raises one or two `changed' events randomly in
+        ;; the file monitor, no chance to test.
+        (unless (string-equal "gfilenotify" (file-notify--test-library))
+          (let ((n 100) events)
+            ;; Compute the expected events.
+            (dotimes (_i (/ n 2))
+              (setq events
+                    (append
+                     (append
+                      ;; Directory monitor and file monitor.
+                      (cond
+                       ;; In the remote case, there are two `changed'
+                       ;; events.
+                      ((file-remote-p temporary-file-directory)
+                        '(changed changed changed changed))
+                       ;; 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)))
+
+            ;; Run the test.
+            (file-notify--test-with-events events
+              (dotimes (i n)
+                (read-event nil nil file-notify--test-read-event-timeout)
+                (if (zerop (mod i 2))
+                    (write-region
+                     "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))

 
 

-        ;; 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))))))
+        ;; 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.
     (file-notify--test-cleanup)))
 
     ;; Cleanup.
     (file-notify--test-cleanup)))