From 7bf54d01159eb09bae3c9cd86f2af0812d9afdf6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 22 Jan 2016 19:56:09 +0100 Subject: [PATCH] Backport kqueue integration from master * configure.ac (--with-file-notification): Add kqueue. (top): Remove special test for "${HAVE_NS}" and ${with_file_notification}, this is handled inside gfilenotify tests. Add kqueue tests. Use NOTIFY_CFLAGS and NOTIFY_LIBS instead of library specific variables. Add error message for gfile on Nextstep. * doc/lispref/os.texi (File Notifications): Add kqueue as backend. Fix some glitches in the example. * etc/NEWS: Mention kqueue. * lisp/filenotify.el (file-notify--library) (file-notify-descriptors, file-notify-callback) (file-notify-add-watch, file-notify-rm-watch) (file-notify-valid-p): Add kqueue support. (file-notify--rm-descriptor): Remove WHAT arg. * src/Makefile.in: Use NOTIFY_CFLAGS and NOTIFY_LIBS. * src/emacs.c (main): Call globals_of_kqueue and syms_of_kqueue. * src/inotify.c (inotifyevent_to_event): Extract file name from watch_object if the event doesn't provide it. (Finotify_add_watch): Add file name to watch_object. * src/keyboard.c (make_lispy_event): Check also for HAVE_KQUEUE. * src/kqueue.c: New file. * src/lisp.h: Declare extern globals_of_kqueue and syms_of_kqueue. * test/automated/file-notify-tests.el (file-notify--test-expected-events): Remove. (file-notify--test-cleanup): Do not set that variable. (file-notify--test-timeout) Use different timeouts for different libraries. (file-notify--test-library): New defun. (file-notify--test-event-test): Make stronger checks. (file-notify--test-with-events): EVENTS can also be a list of lists. Flush outstanding events before running the body. Make timeout heuristically depend on the number of events. (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-test02-events, file-notify-test04-file-validity): Do not skip cygwin tests. Add additional test for file creation. Adapt expected result for different backends. (file-notify-test03-autorevert): Some of the tests don't work for w32notify. (file-notify-test06-many-events): New test. --- configure.ac | 61 ++- doc/lispref/os.texi | 41 +- etc/NEWS | 7 + lisp/filenotify.el | 101 +++-- src/Makefile.in | 11 +- src/emacs.c | 16 +- src/inotify.c | 9 +- src/keyboard.c | 4 +- src/kqueue.c | 521 +++++++++++++++++++++++++ src/lisp.h | 16 +- test/automated/file-notify-tests.el | 585 +++++++++++++++++++--------- 11 files changed, 1092 insertions(+), 280 deletions(-) create mode 100644 src/kqueue.c diff --git a/configure.ac b/configure.ac index b5e6b77c713..76193fae6dd 100644 --- a/configure.ac +++ b/configure.ac @@ -356,17 +356,18 @@ OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) OPTION_DEFAULT_OFF([modules],[compile with dynamic modules support]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], - [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])], + [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], [ case "${withval}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; - g | gf | gfi | gfil | gfile ) val=gfile ;; i | in | ino | inot | inoti | inotif | inotify ) val=inotify ;; + k | kq | kqu | kque | kqueu | kqueue ) val=kqueue ;; + g | gf | gfi | gfil | gfile ) val=gfile ;; w | w3 | w32 ) val=w32 ;; * ) AC_MSG_ERROR(['--with-file-notification=$withval' is invalid; -this option's value should be 'yes', 'no', 'gfile', 'inotify' or 'w32'. +this option's value should be 'yes', 'no', 'inotify', 'kqueue', 'gfile' or 'w32'. 'yes' is a synonym for 'w32' on MS-Windows, for 'no' on Nextstep, -otherwise for the first of 'inotify' or 'gfile' that is usable.]) +otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.]) ;; esac with_file_notification=$val @@ -2712,12 +2713,6 @@ AC_SUBST(LIBGNUTLS_CFLAGS) NOTIFY_OBJ= NOTIFY_SUMMARY=no -dnl FIXME? Don't auto-detect on NS, but do allow someone to specify -dnl a particular library. This doesn't make much sense? -if test "${HAVE_NS}" = yes && test ${with_file_notification} = yes; then - with_file_notification=no -fi - dnl MS Windows native file monitor is available for mingw32 only. case $with_file_notification,$opsys in w32,cygwin) @@ -2748,16 +2743,44 @@ case $with_file_notification,$NOTIFY_OBJ in fi ;; esac +dnl kqueue is available on BSD-like systems. +case $with_file_notification,$NOTIFY_OBJ in + kqueue,* | yes,) + EMACS_CHECK_MODULES([KQUEUE], [libkqueue]) + if test "$HAVE_KQUEUE" = "yes"; then + AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.]) + CPPFLAGS="$CPPFLAGS -I/usr/include/kqueue" + NOTIFY_CFLAGS=$KQUEUE_CFLAGS + NOTIFY_LIBS=$KQUEUE_LIBS + NOTIFY_OBJ=kqueue.o + NOTIFY_SUMMARY="yes -lkqueue" + else + AC_SEARCH_LIBS(kqueue, []) + if test "$ac_cv_search_kqueue" != no; then + AC_DEFINE(HAVE_KQUEUE, 1, [Define to 1 to use kqueue.]) + NOTIFY_OBJ=kqueue.o + NOTIFY_SUMMARY="yes (kqueue)" + fi + fi ;; +esac + dnl g_file_monitor exists since glib 2.18. G_FILE_MONITOR_EVENT_MOVED dnl has been added in glib 2.24. It has been tested under dnl GNU/Linux only. case $with_file_notification,$NOTIFY_OBJ in gfile,* | yes,) - EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24]) - if test "$HAVE_GFILENOTIFY" = "yes"; then - AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) - NOTIFY_OBJ=gfilenotify.o - NOTIFY_SUMMARY="yes -lgio (gfile)" + if test "${HAVE_NS}" = yes; then + AC_MSG_ERROR(['--with-file-notification=gfile' is not supported in NextStep builds. +Consider kqueue instead.]) + else + EMACS_CHECK_MODULES([GFILENOTIFY], [gio-2.0 >= 2.24]) + if test "$HAVE_GFILENOTIFY" = "yes"; then + AC_DEFINE(HAVE_GFILENOTIFY, 1, [Define to 1 if using GFile.]) + NOTIFY_CFLAGS=$GFILENOTIFY_CFLAGS + NOTIFY_LIBS=$GFILENOTIFY_LIBS + NOTIFY_OBJ=gfilenotify.o + NOTIFY_SUMMARY="yes -lgio (gfile)" + fi fi ;; esac @@ -2769,9 +2792,9 @@ esac if test -n "$NOTIFY_OBJ"; then AC_DEFINE(USE_FILE_NOTIFY, 1, [Define to 1 if using file notifications.]) fi +AC_SUBST(NOTIFY_CFLAGS) +AC_SUBST(NOTIFY_LIBS) AC_SUBST(NOTIFY_OBJ) -AC_SUBST(GFILENOTIFY_CFLAGS) -AC_SUBST(GFILENOTIFY_LIBS) dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. @@ -4141,8 +4164,8 @@ OLDCFLAGS="$CFLAGS" OLDLIBS="$LIBS" CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS" LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS" -CFLAGS="$CFLAGS $GFILENOTIFY_CFLAGS $CAIRO_CFLAGS" -LIBS="$LIBS $GFILENOTIFY_LIBS $CAIRO_LIBS" +CFLAGS="$CFLAGS $NOTIFY_CFLAGS $CAIRO_CFLAGS" +LIBS="$LIBS $NOTIFY_LIBS $CAIRO_LIBS" AC_MSG_CHECKING([whether GLib is linked in]) AC_LINK_IFELSE([AC_LANG_PROGRAM( [[#include diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7206cd4ef86..8e3720eb947 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2653,9 +2653,9 @@ This function removes the tray notification given by its unique Several operating systems support watching of filesystems for changes of files. If configured properly, Emacs links a respective library -like @file{gfilenotify}, @file{inotify}, or @file{w32notify} -statically. These libraries enable watching of filesystems on the -local machine. +like @file{inotify}, @file{kqueue}, @file{gfilenotify}, or +@file{w32notify} statically. These libraries enable watching of +filesystems on the local machine. It is also possible to watch filesystems on remote machines, @pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} @@ -2726,7 +2726,8 @@ watching @var{file} has been stopped Note that the @file{w32notify} library does not report @code{attribute-changed} events. When some file's attribute, like permissions or modification time, has changed, this library reports a -@code{changed} event. +@code{changed} event. Likewise, the @file{kqueue} library does not +report reliably file attribute changes when watching a directory. The @code{stopped} event reports, that watching the file has been stopped. This could be because @code{file-notify-rm-watch} was called @@ -2765,7 +2766,7 @@ being reported. For example: @group (write-region "bla" nil "/tmp/foo") @result{} Event (35025468 created "/tmp/.#foo") - Event (35025468 changed "/tmp/foo") [2 times] + Event (35025468 changed "/tmp/foo") Event (35025468 deleted "/tmp/.#foo") @end group @@ -2811,14 +2812,14 @@ also makes it invalid. @example @group (make-directory "/tmp/foo") - @result{} nil + @result{} Event (35025468 created "/tmp/foo") @end group @group (setq desc (file-notify-add-watch "/tmp/foo" '(change) 'my-notify-callback)) - @result{} 35025468 + @result{} 11359632 @end group @group @@ -2828,32 +2829,34 @@ also makes it invalid. @group (write-region "bla" nil "/tmp/foo/bla") - @result{} Event (35025468 created "/tmp/foo/.#bla") - Event (35025468 created "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/.#bla") + @result{} Event (11359632 created "/tmp/foo/.#bla") + Event (11359632 created "/tmp/foo/bla") + Event (11359632 changed "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo/.#bla") @end group @group ;; Deleting a file in the directory doesn't invalidate the watch. (delete-file "/tmp/foo/bla") - @result{} Event (35025468 deleted "/tmp/foo/bla") + @result{} Event (11359632 deleted "/tmp/foo/bla") @end group @group (write-region "bla" nil "/tmp/foo/bla") - @result{} Event (35025468 created "/tmp/foo/.#bla") - Event (35025468 created "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/bla") - Event (35025468 changed "/tmp/foo/.#bla") + @result{} Event (11359632 created "/tmp/foo/.#bla") + Event (11359632 created "/tmp/foo/bla") + Event (11359632 changed "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo/.#bla") @end group @group ;; Deleting the directory invalidates the watch. +;; Events arrive for different watch descriptors. (delete-directory "/tmp/foo" 'recursive) - @result{} Event (35025468 deleted "/tmp/foo/bla") - Event (35025468 deleted "/tmp/foo") - Event (35025468 stopped "/tmp/foo") + @result{} Event (35025468 deleted "/tmp/foo") + Event (11359632 deleted "/tmp/foo/bla") + Event (11359632 deleted "/tmp/foo") + Event (11359632 stopped "/tmp/foo") @end group @group diff --git a/etc/NEWS b/etc/NEWS index 06b32ce9ccc..4e47c5882f9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -63,6 +63,10 @@ If gnustep-config is not available, the old heuristics are used. ** 'configure' now prefers inotify to gfile for file notification, unless gfile is explicitly requested via --with-file-notification='gfile'. +--- +** 'configure' detects the kqueue file notification library on *BSD +and Mac OS X machines. + --- ** The configure option '--with-pkg-config-prog' has been removed. Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to. @@ -1120,6 +1124,9 @@ notifications, if Emacs is compiled with file notification support. ** File Notifications ++++ +*** The kqueue library is integrated for *BSD and Mac OS X machines. + +++ *** The new event `stopped' signals, that a file notification watch is not active any longer. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index ebf4dd277c8..faa801ee6e7 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -22,15 +22,16 @@ ;;; Commentary ;; This package is an abstraction layer from the different low-level -;; file notification packages `gfilenotify', `inotify' and +;; file notification packages `inotify', `kqueue', `gfilenotify' and ;; `w32notify'. ;;; Code: (defconst file-notify--library (cond - ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'inotify) 'inotify) + ((featurep 'kqueue) 'kqueue) + ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'w32notify) 'w32notify)) "Non-nil when Emacs has been compiled with file notification support. The value is the name of the low-level file notification package @@ -40,25 +41,24 @@ could use another implementation.") (defvar file-notify-descriptors (make-hash-table :test 'equal) "Hash table for registered file notification descriptors. A key in this hash table is the descriptor as returned from -`gfilenotify', `inotify', `w32notify' or a file name handler. -The value in the hash table is a list +`inotify', `kqueue', `gfilenotify', `w32notify' or a file name +handler. The value in the hash table is a list (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...) Several values for a given DIR happen only for `inotify', when different files from the same directory are watched.") -(defun file-notify--rm-descriptor (descriptor &optional what) +(defun file-notify--rm-descriptor (descriptor) "Remove DESCRIPTOR from `file-notify-descriptors'. DESCRIPTOR should be an object returned by `file-notify-add-watch'. -If it is registered in `file-notify-descriptors', a stopped event is sent. -WHAT is a file or directory name to be removed, needed just for `inotify'." +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)) (dir (car registered))) - (when (and (consp registered) (or (null what) (string-equal dir what))) + (when (consp registered) ;; Send `stopped' event. (dolist (entry (cdr registered)) (funcall (cdr entry) @@ -76,7 +76,8 @@ WHAT is a file or directory name to be removed, needed just for `inotify'." (remhash desc file-notify-descriptors) (puthash desc registered file-notify-descriptors)))))) -;; This function is used by `gfilenotify', `inotify' and `w32notify' events. +;; This function is used by `inotify', `kqueue', `gfilenotify' and +;; `w32notify' events. ;;;###autoload (defun file-notify-handle-event (event) "Handle file system monitoring event. @@ -159,7 +160,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (setq actions nil)) ;; Loop over actions. In fact, more than one action happens only - ;; for `inotify'. + ;; for `inotify' and `kqueue'. (dolist (action actions) ;; Send pending event, if it doesn't match. @@ -184,19 +185,17 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Map action. We ignore all events which cannot be mapped. (setq action (cond - ;; gfilenotify. - ((memq action '(attribute-changed changed created deleted)) + ((memq action + '(attribute-changed changed created deleted renamed)) action) - ((eq action 'moved) + ((memq action '(moved rename)) (setq file1 (file-notify--event-file1-name event)) 'renamed) - - ;; inotify, w32notify. ((eq action 'ignored) (setq stopped t actions nil)) - ((eq action 'attrib) 'attribute-changed) + ((memq action '(attrib link)) 'attribute-changed) ((memq action '(create added)) 'created) - ((memq action '(modify modified)) 'changed) + ((memq action '(modify modified write)) 'changed) ((memq action '(delete delete-self move-self removed)) 'deleted) ;; Make the event pending. ((memq action '(moved-from renamed-from)) @@ -236,7 +235,6 @@ 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) (setq stopped (or @@ -244,10 +242,13 @@ EVENT is the cadr of the event in `file-notify-handle-event' (and (memq action '(deleted renamed)) (= (length (cdr registered)) 1) - (string-equal - (file-name-nondirectory file) - (or (file-name-nondirectory (car registered)) - (car (cadr registered))))))) + (or + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory (car registered))) + (string-equal + (file-name-nondirectory file) + (car (cadr registered))))))) ;; Apply callback. (when (and action @@ -258,10 +259,17 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; File matches. (string-equal (nth 0 entry) (file-name-nondirectory file)) + ;; Directory matches. + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory (car registered))) ;; File1 matches. (and (stringp file1) (string-equal (nth 0 entry) (file-name-nondirectory file1))))) + ;;(message + ;;"file-notify-callback %S %S %S %S %S" + ;;(file-notify--descriptor desc file) action file file1 registered) (if file1 (funcall callback @@ -272,11 +280,10 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Modify `file-notify-descriptors'. (when stopped - (file-notify--rm-descriptor - (file-notify--descriptor desc file) file))))) + (file-notify-rm-watch (file-notify--descriptor desc file)))))) -;; `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 ;; descriptor per inode only. (defun file-notify-add-watch (file flags callback) "Add a watch for filesystem events pertaining to FILE. @@ -329,7 +336,7 @@ FILE is the name of the file whose event is being reported." (if (file-directory-p file) file (file-name-directory file)))) - desc func l-flags registered) + desc func l-flags registered entry) (unless (file-directory-p dir) (signal 'file-notify-error `("Directory does not exist" ,dir))) @@ -338,7 +345,12 @@ 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 + ;; kqueue does not report file changes in + ;; directory monitor. So we must watch the file + ;; itself. + (if (eq file-notify--library 'kqueue) file dir) + flags callback)) ;; Check, whether Emacs has been compiled with file notification ;; support. @@ -349,8 +361,9 @@ FILE is the name of the file whose event is being reported." ;; Determine low-level function to be called. (setq func (cond - ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'inotify) 'inotify-add-watch) + ((eq file-notify--library 'kqueue) 'kqueue-add-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) ;; Determine respective flags. @@ -362,30 +375,32 @@ FILE is the name of the file whose event is being reported." (cond ((eq file-notify--library 'inotify) '(create delete delete-self modify move-self move)) + ((eq file-notify--library 'kqueue) + '(create delete write extend rename)) ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) (push (cond ((eq file-notify--library 'inotify) 'attrib) + ((eq file-notify--library 'kqueue) 'attrib) ((eq file-notify--library 'w32notify) 'attributes)) l-flags))) ;; Call low-level function. - (setq desc (funcall func dir l-flags 'file-notify-callback))) + (setq desc (funcall + func (if (eq file-notify--library 'kqueue) file dir) + l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. - (setq registered (gethash desc file-notify-descriptors)) - (puthash - desc - `(,dir - (,(unless (file-directory-p file) (file-name-nondirectory file)) - . ,callback) - . ,(cdr registered)) - file-notify-descriptors) + (setq file (unless (file-directory-p file) (file-name-nondirectory file)) + desc (if (consp desc) (car desc) desc) + registered (gethash desc file-notify-descriptors) + entry `(,file . ,callback)) + (unless (member entry (cdr registered)) + (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors)) ;; Return descriptor. - (file-notify--descriptor - desc (unless (file-directory-p file) (file-name-nondirectory file))))) + (file-notify--descriptor desc file))) (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. @@ -410,8 +425,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'kqueue) 'kqueue-rm-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) desc)) (file-notify-error nil))) @@ -441,8 +457,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall handler 'file-notify-valid-p descriptor) (funcall (cond - ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'inotify) 'inotify-valid-p) + ((eq file-notify--library 'kqueue) 'kqueue-valid-p) + ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'w32notify) 'w32notify-valid-p)) desc)) t)))) diff --git a/src/Makefile.in b/src/Makefile.in index 4a52757fec6..fab10aeed47 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -163,12 +163,13 @@ SETTINGS_LIBS = @SETTINGS_LIBS@ ## gtkutil.o if USE_GTK, else empty. GTK_OBJ=@GTK_OBJ@ -## gfilenotify.o if HAVE_GFILENOTIFY. ## inotify.o if HAVE_INOTIFY. +## kqueue.o if HAVE_KQUEUE. +## gfilenotify.o if HAVE_GFILENOTIFY. ## w32notify.o if HAVE_W32NOTIFY. NOTIFY_OBJ = @NOTIFY_OBJ@ -GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ -GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ +NOTIFY_CFLAGS = @NOTIFY_CFLAGS@ +NOTIFY_LIBS = @NOTIFY_LIBS@ ## -ltermcap, or -lncurses, or -lcurses, or "". LIBS_TERMCAP=@LIBS_TERMCAP@ @@ -367,7 +368,7 @@ ALL_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(WEBKIT_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBGNUTLS_CFLAGS) $(GFILENOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ + $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -482,7 +483,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ - $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) + $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" diff --git a/src/emacs.c b/src/emacs.c index 6de0fffb904..ddaa82c1f64 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1360,6 +1360,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem tzset (); #endif /* MSDOS */ +#ifdef HAVE_KQUEUE + globals_of_kqueue (); +#endif + #ifdef HAVE_GFILENOTIFY globals_of_gfilenotify (); #endif @@ -1538,14 +1542,18 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_gnutls (); -#ifdef HAVE_GFILENOTIFY - syms_of_gfilenotify (); -#endif /* HAVE_GFILENOTIFY */ - #ifdef HAVE_INOTIFY syms_of_inotify (); #endif /* HAVE_INOTIFY */ +#ifdef HAVE_KQUEUE + syms_of_kqueue (); +#endif /* HAVE_KQUEUE */ + +#ifdef HAVE_GFILENOTIFY + syms_of_gfilenotify (); +#endif /* HAVE_GFILENOTIFY */ + #ifdef HAVE_DBUS syms_of_dbusbind (); #endif /* HAVE_DBUS */ diff --git a/src/inotify.c b/src/inotify.c index 47652ff35bd..e0619e584f7 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -46,8 +46,7 @@ along with GNU Emacs. If not, see . */ static int inotifyfd = -1; /* Assoc list of files being watched. - Format: - (watch-descriptor . callback) + Format: (watch-descriptor name callback) */ static Lisp_Object watch_list; @@ -106,12 +105,14 @@ inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev) name = make_unibyte_string (ev->name, min (len, ev->len)); name = DECODE_FILE (name); } + else + name = XCAR (XCDR (watch_object)); return list2 (list4 (make_watch_descriptor (ev->wd), mask_to_aspects (ev->mask), name, make_number (ev->cookie)), - XCDR (watch_object)); + Fnth (make_number (2), watch_object)); } /* This callback is called when the FD is available for read. The inotify @@ -325,7 +326,7 @@ is managed internally and there is no corresponding inotify_init. Use watch_list = Fdelete (watch_object, watch_list); /* Store watch object in watch list. */ - watch_object = Fcons (watch_descriptor, callback); + watch_object = list3 (watch_descriptor, encoded_file_name, callback); watch_list = Fcons (watch_object, watch_list); return watch_descriptor; diff --git a/src/keyboard.c b/src/keyboard.c index 58831f548ca..c93876effd9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5965,12 +5965,12 @@ make_lispy_event (struct input_event *event) #endif -#if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY +#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY case FILE_NOTIFY_EVENT: { return Fcons (Qfile_notify, event->arg); } -#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */ +#endif /* HAVE_INOTIFY || HAVE_KQUEUE || HAVE_GFILENOTIFY */ case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, diff --git a/src/kqueue.c b/src/kqueue.c new file mode 100644 index 00000000000..a69d06da3ae --- /dev/null +++ b/src/kqueue.c @@ -0,0 +1,521 @@ +/* Filesystem notifications support with kqueue API. + +Copyright (C) 2015-2016 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#ifdef HAVE_KQUEUE +#include +#include +#include +#include +#include +#include "lisp.h" +#include "keyboard.h" +#include "process.h" + + +/* File handle for kqueue. */ +static int kqueuefd = -1; + +/* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */ +static Lisp_Object watch_list; + +/* Generate a list from the directory_files_internal output. + Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */ +Lisp_Object +kqueue_directory_listing (Lisp_Object directory_files) +{ + Lisp_Object dl, result = Qnil; + + for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) { + /* We ignore "." and "..". */ + if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) || + (strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0)) + continue; + + result = Fcons + (list5 (/* inode. */ + Fnth (make_number (11), XCAR (dl)), + /* filename. */ + XCAR (XCAR (dl)), + /* last modification time. */ + Fnth (make_number (6), XCAR (dl)), + /* last status change time. */ + Fnth (make_number (7), XCAR (dl)), + /* size. */ + Fnth (make_number (8), XCAR (dl))), + result); + } + return result; +} + +/* Generate a file notification event. */ +static void +kqueue_generate_event +(Lisp_Object watch_object, Lisp_Object actions, + Lisp_Object file, Lisp_Object file1) +{ + Lisp_Object flags, action, entry; + struct input_event event; + + /* Check, whether all actions shall be monitored. */ + flags = Fnth (make_number (2), watch_object); + action = actions; + do { + if (NILP (action)) + break; + entry = XCAR (action); + if (NILP (Fmember (entry, flags))) { + action = XCDR (action); + actions = Fdelq (entry, actions); + } else + action = XCDR (action); + } while (1); + + /* Store it into the input event queue. */ + if (! NILP (actions)) { + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + event.frame_or_window = Qnil; + event.arg = list2 (Fcons (XCAR (watch_object), + Fcons (actions, + NILP (file1) + ? Fcons (file, Qnil) + : list2 (file, file1))), + Fnth (make_number (3), watch_object)); + kbd_buffer_store_event (&event); + } +} + +/* This compares two directory listings in case of a `write' event for + a directory. Generate resulting file notification events. The old + directory listing is retrieved from watch_object, it will be + replaced by the new directory listing at the end of this + function. */ +static void +kqueue_compare_dir_list +(Lisp_Object watch_object) +{ + 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_dl = Qnil; + deleted_dl = Qnil; + + old_directory_files = Fnth (make_number (4), watch_object); + old_dl = kqueue_directory_listing (old_directory_files); + + /* When the directory is not accessible anymore, it has been deleted. */ + if (NILP (Ffile_directory_p (dir))) { + kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil); + return; + } + new_directory_files = + directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + new_dl = kqueue_directory_listing (new_directory_files); + + /* Parse through the old list. */ + dl = old_dl; + while (1) { + Lisp_Object old_entry, new_entry, dl1; + if (NILP (dl)) + break; + + /* Search for an entry with the same inode. */ + old_entry = XCAR (dl); + new_entry = assq_no_quit (XCAR (old_entry), new_dl); + if (! NILP (Fequal (old_entry, new_entry))) { + /* Both entries are identical. Nothing to do. */ + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + + /* Both entries have the same inode. */ + if (! NILP (new_entry)) { + /* Both entries have the same file name. */ + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + /* Modification time has been changed, the file has been written. */ + if (NILP (Fequal (Fnth (make_number (2), old_entry), + Fnth (make_number (2), new_entry)))) + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil); + /* Status change time has been changed, the file attributes + have changed. */ + if (NILP (Fequal (Fnth (make_number (3), old_entry), + Fnth (make_number (3), new_entry)))) + kqueue_generate_event + (watch_object, Fcons (Qattrib, Qnil), + XCAR (XCDR (old_entry)), Qnil); + + } else { + /* The file has been renamed. */ + 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; + } + + /* Search, whether there is a file with the same name but another + inode. */ + for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) { + new_entry = XCAR (dl1); + if (strcmp (SSDATA (XCAR (XCDR (old_entry))), + SSDATA (XCAR (XCDR (new_entry)))) == 0) { + pending_dl = Fcons (new_entry, pending_dl); + new_dl = Fdelq (new_entry, new_dl); + goto the_end; + } + } + + /* 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 { + /* The file has been renamed. */ + kqueue_generate_event + (watch_object, Fcons (Qrename, Qnil), + XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry))); + pending_dl = Fdelq (new_entry, pending_dl); + } + + the_end: + dl = XCDR (dl); + old_dl = Fdelq (old_entry, old_dl); + } + + /* Parse through the resulting new list. */ + dl = new_dl; + while (1) { + Lisp_Object entry; + if (NILP (dl)) + break; + + /* A new file has appeared. */ + entry = XCAR (dl); + kqueue_generate_event + (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil); + + /* Check size of that file. */ + Lisp_Object size = Fnth (make_number (4), entry); + if (FLOATP (size) || (XINT (size) > 0)) + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); + + dl = XCDR (dl); + new_dl = Fdelq (entry, new_dl); + } + + /* Parse through the resulting pending_dl list. */ + dl = pending_dl; + while (1) { + Lisp_Object entry; + if (NILP (dl)) + break; + + /* A file is still pending. Assume it was a write. */ + entry = XCAR (dl); + kqueue_generate_event + (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil); + + dl = XCDR (dl); + pending_dl = Fdelq (entry, pending_dl); + } + + /* 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 + nonexistent 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_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), + Fcons (new_directory_files, Qnil)); + return; +} + +/* This is the callback function for arriving input on kqueuefd. It + shall create a Lisp event, and put it into the Emacs input queue. */ +static void +kqueue_callback (int fd, void *data) +{ + for (;;) { + struct kevent kev; + static const struct timespec nullts = { 0, 0 }; + Lisp_Object descriptor, watch_object, file, actions; + + /* Read one event. */ + int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts); + if (ret < 1) { + /* All events read. */ + return; + } + + /* Determine descriptor and file name. */ + descriptor = make_number (kev.ident); + watch_object = assq_no_quit (descriptor, watch_list); + if (CONSP (watch_object)) + file = XCAR (XCDR (watch_object)); + else + continue; + + /* Determine event actions. */ + actions = Qnil; + if (kev.fflags & NOTE_DELETE) + actions = Fcons (Qdelete, actions); + if (kev.fflags & NOTE_WRITE) { + /* Check, whether this is a directory event. */ + if (NILP (Fnth (make_number (4), watch_object))) + actions = Fcons (Qwrite, actions); + else + kqueue_compare_dir_list (watch_object); + } + if (kev.fflags & NOTE_EXTEND) + actions = Fcons (Qextend, actions); + if (kev.fflags & NOTE_ATTRIB) + actions = Fcons (Qattrib, actions); + if (kev.fflags & NOTE_LINK) + actions = Fcons (Qlink, actions); + /* It would be useful to know the target of the rename operation. + At this point, it is not possible. Happens only when the upper + directory is monitored. */ + if (kev.fflags & NOTE_RENAME) + actions = Fcons (Qrename, actions); + + /* Create the event. */ + if (! NILP (actions)) + kqueue_generate_event (watch_object, actions, file, Qnil); + + /* Cancel monitor if file or directory is deleted or renamed. */ + if (kev.fflags & (NOTE_DELETE | NOTE_RENAME)) + Fkqueue_rm_watch (descriptor); + } + return; +} + +DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0, + doc: /* Add a watch for filesystem events pertaining to FILE. + +This arranges for filesystem events pertaining to FILE to be reported +to Emacs. Use `kqueue-rm-watch' to cancel the watch. + +Returned value is a descriptor for the added watch. If the file cannot be +watched for some reason, this function signals a `file-notify-error' error. + +FLAGS is a list of events to be watched for. It can include the +following symbols: + + `create' -- FILE was created + `delete' -- FILE was deleted + `write' -- FILE has changed + `extend' -- FILE was extended + `attrib' -- a FILE attribute was changed + `link' -- a FILE's link count was changed + `rename' -- FILE was moved to FILE1 + +When any event happens, Emacs will call the CALLBACK function passing +it a single argument EVENT, which is of the form + + (DESCRIPTOR ACTIONS FILE [FILE1]) + +DESCRIPTOR is the same object as the one returned by this function. +ACTIONS is a list of events. + +FILE is the name of the file whose event is being reported. FILE1 +will be reported only in case of the `rename' event. This is possible +only when the upper directory of the renamed file is watched. */) + (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) +{ + Lisp_Object watch_object, dir_list; + int fd, oflags; + u_short fflags = 0; + struct kevent kev; + + /* Check parameters. */ + CHECK_STRING (file); + file = Fdirectory_file_name (Fexpand_file_name (file, Qnil)); + if (NILP (Ffile_exists_p (file))) + report_file_error ("File does not exist", file); + + CHECK_LIST (flags); + + if (! FUNCTIONP (callback)) + wrong_type_argument (Qinvalid_function, callback); + + if (kqueuefd < 0) + { + /* Create kqueue descriptor. */ + kqueuefd = kqueue (); + if (kqueuefd < 0) + report_file_notify_error ("File watching is not available", Qnil); + + /* Start monitoring for possible I/O. */ + add_read_fd (kqueuefd, kqueue_callback, NULL); + + watch_list = Qnil; + } + + /* Open file. */ + file = ENCODE_FILE (file); + oflags = O_NONBLOCK; +#if O_EVTONLY + oflags |= O_EVTONLY; +#else + oflags |= O_RDONLY; +#endif +#if O_SYMLINK + oflags |= O_SYMLINK; +#else + oflags |= O_NOFOLLOW; +#endif + fd = emacs_open (SSDATA (file), oflags, 0); + if (fd == -1) + report_file_error ("File cannot be opened", file); + + /* Assemble filter flags */ + if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE; + if (! NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE; + if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND; + if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB; + if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK; + if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME; + + /* Register event. */ + EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, + fflags, 0, NULL); + + if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) { + emacs_close (fd); + report_file_error ("Cannot watch file", file); + } + + /* Store watch object in watch list. */ + Lisp_Object watch_descriptor = make_number (fd); + if (NILP (Ffile_directory_p (file))) + watch_object = list4 (watch_descriptor, file, flags, callback); + else { + dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil); + watch_object = list5 (watch_descriptor, file, flags, callback, dir_list); + } + watch_list = Fcons (watch_object, watch_list); + + return watch_descriptor; +} + +DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0, + doc: /* Remove an existing WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */) + (Lisp_Object watch_descriptor) +{ + Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); + + if (! CONSP (watch_object)) + xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"), + watch_descriptor); + + eassert (INTEGERP (watch_descriptor)); + int fd = XINT (watch_descriptor); + if ( fd >= 0) + emacs_close (fd); + + /* Remove watch descriptor from watch list. */ + watch_list = Fdelq (watch_object, watch_list); + + if (NILP (watch_list) && (kqueuefd >= 0)) { + delete_read_fd (kqueuefd); + emacs_close (kqueuefd); + kqueuefd = -1; + } + + return Qt; +} + +DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0, + doc: /* "Check a watch specified by its WATCH-DESCRIPTOR. + +WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. + +A watch can become invalid if the file or directory it watches is +deleted, or if the watcher thread exits abnormally for any other +reason. Removing the watch by calling `kqueue-rm-watch' also makes it +invalid. */) + (Lisp_Object watch_descriptor) +{ + return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt; +} + + +void +globals_of_kqueue (void) +{ + watch_list = Qnil; +} + +void +syms_of_kqueue (void) +{ + defsubr (&Skqueue_add_watch); + defsubr (&Skqueue_rm_watch); + defsubr (&Skqueue_valid_p); + + /* Event types. */ + DEFSYM (Qcreate, "create"); + DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */ + DEFSYM (Qwrite, "write"); /* NOTE_WRITE */ + DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */ + DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */ + DEFSYM (Qlink, "link"); /* NOTE_LINK */ + DEFSYM (Qrename, "rename"); /* NOTE_RENAME */ + + staticpro (&watch_list); + + Fprovide (intern_c_string ("kqueue"), Qnil); +} + +#endif /* HAVE_KQUEUE */ + +/* PROBLEMS + * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837 + prevents tests on Ubuntu. */ diff --git a/src/lisp.h b/src/lisp.h index b0a8d75c439..8aa034e9e57 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4319,17 +4319,23 @@ extern void init_font (void); extern void syms_of_fontset (void); #endif +/* Defined in inotify.c */ +#ifdef HAVE_INOTIFY +extern void syms_of_inotify (void); +#endif + +/* Defined in kqueue.c */ +#ifdef HAVE_KQUEUE +extern void globals_of_kqueue (void); +extern void syms_of_kqueue (void); +#endif + /* Defined in gfilenotify.c */ #ifdef HAVE_GFILENOTIFY extern void globals_of_gfilenotify (void); extern void syms_of_gfilenotify (void); #endif -/* Defined in inotify.c */ -#ifdef HAVE_INOTIFY -extern void syms_of_inotify (void); -#endif - #ifdef HAVE_W32NOTIFY /* Defined on w32notify.c. */ extern void syms_of_w32notify (void); diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 7bf7b0b3d15..de64f5086d2 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -61,11 +61,14 @@ (defvar file-notify--test-results nil) (defvar file-notify--test-event nil) (defvar file-notify--test-events nil) -(defvar file-notify--test-expected-events nil) (defun file-notify--test-timeout () "Timeout to wait for arriving events, in seconds." - (if (file-remote-p temporary-file-directory) 6 3)) + (cond + ((file-remote-p temporary-file-directory) 6) + ((string-equal (file-notify--test-library) "w32notify") 20) + ((eq system-type 'cygwin) 10) + (t 3))) (defun file-notify--test-cleanup () "Cleanup after a test." @@ -89,8 +92,7 @@ file-notify--test-tmpfile1 nil file-notify--test-desc nil file-notify--test-results nil - file-notify--test-events nil - file-notify--test-expected-events nil) + file-notify--test-events nil) (when file-notify--test-event (error "file-notify--test-event should not be set but bound dynamically"))) @@ -133,6 +135,18 @@ being the result.") ;; Return result. (cdr file-notify--test-remote-enabled-checked)) +(defun file-notify--test-library () + "The used library for the test, as a string. +In the remote case, it is the process name which runs on the +remote host, or nil." + (if (null (file-remote-p temporary-file-directory)) + (symbol-name file-notify--library) + (and (consp file-notify--test-remote-enabled-checked) + (processp (cdr file-notify--test-remote-enabled-checked)) + (replace-regexp-in-string + "<[[:digit:]]+>\\'" "" + (process-name (cdr file-notify--test-remote-enabled-checked)))))) + (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." (declare (indent 1)) @@ -151,12 +165,7 @@ being the result.") "Test availability of `file-notify'." (skip-unless (file-notify--test-local-enabled)) ;; Report the native library which has been used. - (if (null (file-remote-p temporary-file-directory)) - (message "Local library: `%s'" file-notify--library) - (message "Remote command: `%s'" - (replace-regexp-in-string - "<[[:digit:]]+>\\'" "" - (process-name (cdr file-notify--test-remote-enabled-checked))))) + (message "Library: `%s'" (file-notify--test-library)) (should (setq file-notify--test-desc (file-notify-add-watch temporary-file-directory '(change) 'ignore))) @@ -190,12 +199,13 @@ being the result.") (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) @@ -236,16 +246,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. @@ -254,7 +265,7 @@ and the event to `file-notify--test-events'." (let* ((file-notify--test-event event) (result (ert-run-test (make-ert-test :body 'file-notify--test-event-test)))) - ;; Do not add temporary files, this would confuse the checks. + ;; Do not add lock files, this would confuse the checks. (unless (string-match (regexp-quote ".#") (file-notify--event-file-name file-notify--test-event)) @@ -278,137 +289,246 @@ TIMEOUT is the maximum time to wait for, in seconds." (defmacro file-notify--test-with-events (events &rest body) "Run BODY collecting events and then compare with EVENTS. -Don't wait longer than timeout seconds for the events to be delivered." +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)) - (setq file-notify--test-expected-events - (append file-notify--test-expected-events ,events)) + `(let* ((,outer file-notify--test-events) + (events (if (consp (car ,events)) ,events (list ,events))) + (max-length (apply 'max (mapcar 'length events))) + create-lockfiles result) + ;; 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 - (file-notify--test-timeout) - (= (length ,events) (length file-notify--test-events))) - (should (equal ,events (mapcar #'cadr file-notify--test-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 + (dolist (elt events result) + (setq result + (or result + (equal elt (mapcar #'cadr file-notify--test-events)))))) (setq ,outer (append ,outer file-notify--test-events))) (setq file-notify--test-events ,outer)))) (ert-deftest file-notify-test02-events () "Check file creation/change/removal notifications." (skip-unless (file-notify--test-local-enabled)) - ;; 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 creation, change and deletion. It doesn't work + ;; for cygwin and kqueue, because we don't use an implicit + ;; directory monitor (kqueue), or the timings are too bad (cygwin). + (unless (or (eq system-type 'cygwin) + (string-equal (file-notify--test-library) "kqueue")) + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (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 + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + (t '(created changed deleted stopped))) + (write-region + "another text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) + (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 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 + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; inotify and kqueue raise just one `changed' event. + ((or (string-equal "inotify" (file-notify--test-library)) + (string-equal "kqueue" (file-notify--test-library))) + '(changed deleted stopped)) + ;; 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 deleted stopped) + (changed changed deleted stopped))) + (t '(changed changed deleted stopped))) + (read-event nil nil 0.1) (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)) ;; `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. - (unless (eq file-notify--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)) + ;; Check file creation, change and deletion when watching a + ;; directory. There must be a `stopped' event when deleting + ;; the 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-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. - '(created changed deleted deleted stopped) + (cond + ;; w32notify does raise a `stopped' event when a + ;; watched directory is deleted. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(created changed deleted stopped)) + (t '(created changed deleted deleted stopped))) + (read-event nil nil 0.1) (write-region - "any text" nil (expand-file-name "foo" file-notify--test-tmpfile) - nil 'no-message) - (delete-directory file-notify--test-tmpfile 'recursive)) + "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. - (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 (eq file-notify--library 'w32notify) - '(created changed changed deleted) - '(created changed deleted)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) - ;; The next two events shall not be visible. - (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil 0.1) ; In order to distinguish the events. - (set-file-times file-notify--test-tmpfile '(0 0)) - (delete-file file-notify--test-tmpfile) - (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 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 + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed created changed changed changed changed + deleted deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are three `deleted' events, for two files and + ;; for the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(created changed created changed deleted stopped)) + (t '(created changed created changed + deleted deleted deleted stopped))) + (read-event nil nil 0.1) + (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-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 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) - (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) - ;; After the rename, we won't get events anymore. - (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 + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(created changed renamed deleted)) + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((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) + (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 w32notify. - (unless (eq file-notify--library 'w32notify) - (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 - ;; `attribute-changed' event. - '(attribute-changed attribute-changed attribute-changed) - '(attribute-changed attribute-changed)) - ;; We must use short delays between the operations. - ;; Otherwise, not all events arrive us in the remote case. - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (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)) + ;; Check attribute change. Does not work for cygwin. + (unless (eq system-type 'cygwin) + (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 + '(attribute-change) 'file-notify--test-event-handler))) + (file-notify--test-with-events + (cond + ;; w32notify does not distinguish between `changed' and + ;; `attribute-changed'. + ((string-equal (file-notify--test-library) "w32notify") + '(changed changed changed changed)) + ;; For kqueue and in the remote case, `write-region' + ;; raises also an `attribute-changed' event. + ((or (string-equal (file-notify--test-library) "kqueue") + (file-remote-p temporary-file-directory)) + '(attribute-changed attribute-changed attribute-changed)) + (t '(attribute-changed attribute-changed))) + (read-event nil nil 0.1) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (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)) ;; `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 again just to make sure that ;; `file-notify--test-events' has been set correctly. - (should (equal (mapcar #'cadr file-notify--test-events) - file-notify--test-expected-events)) (should file-notify--test-results) (dolist (result file-notify--test-results) (when (ert-test-failed-p result) @@ -476,28 +596,31 @@ Don't wait longer than timeout seconds for the events to be delivered." (should (string-match "another text" (buffer-string))) ;; Stop file notification. Autorevert shall still work via polling. - (file-notify-rm-watch auto-revert-notify-watch-descriptor) - (file-notify--wait-for-events - timeout (null auto-revert-use-notify)) - (should-not auto-revert-use-notify) - (should-not auto-revert-notify-watch-descriptor) - - ;; Modify file. We wait for two seconds, in order to have - ;; another timestamp. One second seems to be too short. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 2) - (write-region - "foo bla" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") + ;; It doesn't work for `w32notify'. + (unless (string-equal (file-notify--test-library) "w32notify") + (file-notify-rm-watch auto-revert-notify-watch-descriptor) (file-notify--wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "foo bla" (buffer-string))))) + timeout (null auto-revert-use-notify)) + (should-not auto-revert-use-notify) + (should-not auto-revert-notify-watch-descriptor) + + ;; Modify file. We wait for two seconds, in order to + ;; have another timestamp. One second seems to be too + ;; short. + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (sleep-for 2) + (write-region + "foo bla" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (with-current-buffer (get-buffer-create "*Messages*") + (file-notify--wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + (buffer-string)))) + (should (string-match "foo bla" (buffer-string)))))) ;; Cleanup. (with-current-buffer "*Messages*" (widen)) @@ -510,51 +633,94 @@ Don't wait longer than timeout seconds for the events to be delivered." (ert-deftest file-notify-test04-file-validity () "Check `file-notify-valid-p' for files." (skip-unless (file-notify--test-local-enabled)) - ;; Under cygwin there are so bad timings that it doesn't make sense to test. - (skip-unless (not (eq system-type 'cygwin))) (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 + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; inotify and kqueue raise just one `changed' event. + ((or (string-equal "inotify" (file-notify--test-library)) + (string-equal "kqueue" (file-notify--test-library))) + '(changed deleted stopped)) + ;; 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 deleted stopped) + (changed changed deleted stopped))) + (t '(changed changed deleted stopped))) (should (file-notify-valid-p file-notify--test-desc)) + (read-event nil nil 0.1) (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)) (unwind-protect - ;; The batch-mode operation of w32notify is fragile (there's no - ;; input threads to send the message to). - ;(unless (and noninteractive (eq file-notify--library 'w32notify)) - (unless (eq file-notify--library 'w32notify) - (let ((temporary-file-directory + ;; w32notify does not send a `stopped' event when deleting a + ;; directory. The test does not work, therefore. + (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)) - (file-notify--test-with-events '(created changed deleted stopped) - (should (file-notify-valid-p file-notify--test-desc)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) + (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 + (cond + ;; cygwin recognizes only `deleted' and `stopped' events. + ((eq system-type 'cygwin) + '(deleted stopped)) + ;; There are two `deleted' events, for the file and for + ;; the directory. Except for kqueue. + ((string-equal (file-notify--test-library) "kqueue") + '(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) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (read-event nil nil 0.1) (delete-directory temporary-file-directory t)) - ;; After deleting the parent directory, the descriptor must - ;; not be valid anymore. - (should-not (file-notify-valid-p file-notify--test-desc)))) + ;; After deleting the parent directory, the descriptor must + ;; not be valid anymore. + (should-not (file-notify-valid-p file-notify--test-desc)))) ;; Cleanup. (file-notify--test-cleanup))) @@ -571,10 +737,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. @@ -590,20 +757,22 @@ Don't wait longer than timeout seconds for the events to be delivered." (unwind-protect ;; The batch-mode operation of w32notify is fragile (there's no ;; input threads to send the message to). - (unless (and noninteractive (eq file-notify--library 'w32notify)) + (unless (and noninteractive + (string-equal (file-notify--test-library) "w32notify")) (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. (delete-directory file-notify--test-tmpfile t) (file-notify--wait-for-events - (file-notify--test-timeout) + (file-notify--test-timeout) (not (file-notify-valid-p file-notify--test-desc))) (should-not (file-notify-valid-p file-notify--test-desc))) @@ -613,6 +782,62 @@ Don't wait longer than timeout seconds for the events to be delivered." (file-notify--deftest-remote file-notify-test05-dir-validity "Check `file-notify-valid-p' via file notification for remote directories.") +(ert-deftest file-notify-test06-many-events () + "Check that events are not dropped." + :tags '(:expensive-test) + (skip-unless (file-notify--test-local-enabled)) + ;; Under cygwin events arrive in random order. Impossible to define a test. + (skip-unless (not (eq system-type 'cygwin))) + + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (make-directory file-notify--test-tmpfile) + (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) + source-file-list target-file-list + (default-directory file-notify--test-tmpfile)) + (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. + (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 ((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) + (write-region "" nil (pop source-file-list) nil 'no-message) + (read-event nil nil 0.1) + (write-region "" nil (pop target-file-list) nil 'no-message)))) + (file-notify--test-with-events + (cond + ;; w32notify fires both `deleted' and `renamed' events. + ((string-equal (file-notify--test-library) "w32notify") + (let (r) + (dotimes (_i n r) + (setq r (append '(deleted renamed) r))))) + (t (make-list n 'renamed))) + (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 target-file-list) + (delete-file file)))) + (file-notify--test-cleanup))) + +(file-notify--deftest-remote file-notify-test06-many-events + "Check that events are not dropped for remote directories.") + (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") @@ -623,7 +848,7 @@ Don't wait longer than timeout seconds for the events to be delivered." ;; TODO: ;; * For w32notify, no stopped events arrive when a directory is removed. -;; * Try to handle arriving events under cygwin reliably. +;; * Check, why cygwin recognizes only `deleted' and `stopped' events. (provide 'file-notify-tests) ;;; file-notify-tests.el ends here -- 2.39.2