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:
 
+(eval-when-compile
+  (require 'cl))
+
 (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))
-        (file (if (consp descriptor) (cdr descriptor)))
          (registered (gethash desc file-notify-descriptors))
+        (file (if (consp descriptor) (cdr descriptor) (caadr registered)))
         (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)
@@ -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).")
 
+(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
@@ -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))
 
-        ;; 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
@@ -282,11 +271,15 @@ EVENT is the cadr of the event in `file-notify-handle-event'
                  ,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

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
-   (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
-     (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.
@@ -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))
-  (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."
@@ -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))
-          ;; `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))
@@ -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))
-       ;; `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
@@ -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))
-         ;; `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
@@ -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))
-         ;; `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
@@ -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))
-         ;; `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)
@@ -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))
-         ;; `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)))
@@ -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
-         ;; 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)
@@ -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))
+             ;; 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
@@ -955,52 +939,116 @@ the file watch."
   :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
-      (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)))