test/automated/file-notify-tests.el

   1 ;;; file-notify-tests.el --- Tests of file notifications
   2
   3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;; Some of the tests are intended to run over remote files.  Set
  23 ;; `file-notify-test-remote-temporary-file-directory' to a suitable
  24 ;; value.  It must NOT require an interactive password prompt, when
  25 ;; running the tests in batch mode.
  26
  27 ;; If you want to skip tests for remote files, set this variable to
  28 ;; `null-device'.
  29
  30 ;;; Code:
  31
  32 (require 'ert)
  33 (require 'filenotify)
  34
  35 ;; There is no default value on w32 systems, which could work out of the box.
  36 (defconst file-notify-test-remote-temporary-file-directory
  37   (if (eq system-type 'windows-nt) null-device "/ssh::/tmp")
  38   "Temporary directory for Tramp tests.")
  39
  40 (defvar file-notify--test-tmpfile nil)
  41 (defvar file-notify--test-tmpfile1 nil)
  42 (defvar file-notify--test-results nil)
  43 (defvar file-notify--test-event nil)
  44
  45 (require 'tramp)
  46 (require 'tramp-sh)
  47 (setq tramp-verbose 0
  48       tramp-message-show-message nil)
  49 (when noninteractive (defalias 'tramp-read-passwd 'ignore))
  50
  51 ;; We do not want to try and fail `file-notify-add-watch'.
  52 (defconst file-notify--test-local-enabled file-notify--library
  53   "Whether local file notification is enabled.")
  54
  55 ;; We need also a check on the remote side, w/o adding a file monitor.
  56 (defun file-notify--test-remote-enabled ()
  57   "Whether remote file notification is enabled."
  58   (ignore-errors
  59     (and (file-remote-p file-notify-test-remote-temporary-file-directory)
  60          (file-directory-p file-notify-test-remote-temporary-file-directory)
  61          (file-writable-p file-notify-test-remote-temporary-file-directory)
  62          ;; Extracted from tramp-sh-handle-file-notify-add-watch.
  63          ;; Even though the "remote" system is just ssh@localhost,
  64          ;; the PATH might not be the same as the "local" PATH.
  65          ;; Eg this seems to be the case on hydra.nixos.org.
  66          ;; Without this, tests fail with:
  67          ;; "No file notification program found on /ssh:localhost:"
  68          ;; Try to fix PATH instead?
  69          (with-parsed-tramp-file-name
  70              file-notify-test-remote-temporary-file-directory nil
  71              (or (tramp-get-remote-gvfs-monitor-dir v)
  72                  (tramp-get-remote-inotifywait v))))))
  73
  74 (defmacro file-notify--deftest-remote (test docstring)
  75   "Define ert `TEST-remote' for remote files."
  76   `(when (and (file-notify--test-remote-enabled) (ert-get-test ',test))
  77      ;; Define the test.
  78      (ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
  79        ,docstring
  80        (let* ((temporary-file-directory
  81                file-notify-test-remote-temporary-file-directory)
  82               (ert-test (ert-get-test ',test))
  83               (most-recent-result (ert-test-most-recent-result ert-test))
  84               result)
  85          (unwind-protect
  86              (progn
  87                (setq result
  88                      (condition-case err
  89                          (ert-run-test ert-test)
  90                        ((error quit)
  91                         (ert-fail err))))
  92                (when (ert-test-failed-p result)
  93                  (ert-fail
  94                   (cadr (ert-test-result-with-condition-condition result)))))
  95            ;; Reset status of TEST.
  96            (setf (ert-test-most-recent-result ert-test) most-recent-result))))))
  97
  98 (ert-deftest file-notify-test00-availability ()
  99   "Test availability of `file-notify'."
 100   (let (desc)
 101     ;; Check, that different valid parameters are accepted.
 102     (should (setq desc (file-notify-add-watch
 103                         temporary-file-directory '(change) 'ignore)))
 104     (file-notify-rm-watch desc)))
 105
 106 (file-notify--deftest-remote file-notify-test00-availability
 107   "Test availability of `file-notify' for remote files.")
 108
 109 (when file-notify--test-local-enabled
 110
 111   (ert-deftest file-notify-test01-add-watch ()
 112     "Check `file-notify-add-watch'."
 113     (let (desc)
 114       ;; Check, that different valid parameters are accepted.
 115       (should (setq desc (file-notify-add-watch
 116                           temporary-file-directory '(change) 'ignore)))
 117       (file-notify-rm-watch desc)
 118       (should (setq desc (file-notify-add-watch
 119                           temporary-file-directory
 120                           '(attribute-change) 'ignore)))
 121       (file-notify-rm-watch desc)
 122       (should (setq desc (file-notify-add-watch
 123                           temporary-file-directory
 124                           '(change attribute-change) 'ignore)))
 125       (file-notify-rm-watch desc)
 126
 127       ;; Check error handling.
 128       (should-error (file-notify-add-watch 1 2 3 4)
 129                     :type 'wrong-number-of-arguments)
 130       (should
 131        (equal (should-error (file-notify-add-watch 1 2 3))
 132               '(wrong-type-argument 1)))
 133       (should
 134        (equal (should-error (file-notify-add-watch
 135                              temporary-file-directory 2 3))
 136               '(wrong-type-argument 2)))
 137       (should
 138        (equal (should-error (file-notify-add-watch
 139                              temporary-file-directory '(change) 3))
 140               '(wrong-type-argument 3)))))
 141
 142   (file-notify--deftest-remote file-notify-test01-add-watch
 143     "Check `file-notify-add-watch' for remote files.")
 144   ) ;; file-notify--test-local-enabled
 145
 146 (defun file-notify--test-event-test ()
 147   "Ert test function to be called by `file-notify--test-event-handler'.
 148 We cannot pass arguments, so we assume that `file-notify--test-event'
 149 is bound somewhere."
 150   ;(message "Event %S" file-notify--test-event)
 151   ;; Check the file name.
 152   (should
 153    (string-equal (file-notify--event-file-name file-notify--test-event)
 154                  file-notify--test-tmpfile))
 155   ;; Check the second file name if exists.
 156   (when (eq (nth 1 file-notify--test-event) 'renamed)
 157     (should
 158      (string-equal
 159       (file-notify--event-file1-name file-notify--test-event)
 160       file-notify--test-tmpfile1))))
 161
 162 (defun file-notify--test-event-handler (file-notify--test-event)
 163   "Run a test over FILE-NOTIFY--TEST-EVENT.
 164 Save the result in `file-notify--test-results', for later analysis."
 165   (let ((result
 166          (ert-run-test (make-ert-test :body 'file-notify--test-event-test))))
 167     (setq file-notify--test-results
 168           (append file-notify--test-results `(,result)))))
 169
 170 (defun file-notify--test-make-temp-name ()
 171   "Create a temporary file name for test."
 172   (expand-file-name
 173    (make-temp-name "file-notify-test") temporary-file-directory))
 174
 175 (when file-notify--test-local-enabled
 176
 177   (ert-deftest file-notify-test02-events ()
 178     "Check file creation/removal notifications."
 179     (let (desc)
 180       (unwind-protect
 181           (progn
 182             (setq file-notify--test-results nil
 183                   file-notify--test-tmpfile (file-notify--test-make-temp-name)
 184                   file-notify--test-tmpfile1 (file-notify--test-make-temp-name)
 185                   desc
 186                   (file-notify-add-watch
 187                    file-notify--test-tmpfile
 188                    '(change) 'file-notify--test-event-handler))
 189
 190             ;; Check creation and removal.
 191             (write-region "any text" nil file-notify--test-tmpfile)
 192             (delete-file file-notify--test-tmpfile)
 193
 194             ;; Check copy and rename.
 195             (write-region "any text" nil file-notify--test-tmpfile)
 196             (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1)
 197             (delete-file file-notify--test-tmpfile)
 198             (delete-file file-notify--test-tmpfile1)
 199
 200             (write-region "any text" nil file-notify--test-tmpfile)
 201             (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1)
 202             (delete-file file-notify--test-tmpfile1))
 203
 204         ;; Wait for events, and exit.
 205         (sit-for 5 'nodisplay)
 206         (file-notify-rm-watch desc)
 207         (ignore-errors (delete-file file-notify--test-tmpfile))
 208         (ignore-errors (delete-file file-notify--test-tmpfile1))))
 209
 210     (dolist (result file-notify--test-results)
 211       ;(message "%s" (ert-test-result-messages result))
 212       (when (ert-test-failed-p result)
 213         (ert-fail (cadr (ert-test-result-with-condition-condition result))))))
 214
 215   (file-notify--deftest-remote file-notify-test02-events
 216     "Check file creation/removal notifications for remote files.")
 217   ) ;; file-notify--test-local-enabled
 218
 219 ;; autorevert runs only in interactive mode.
 220 (defvar auto-revert-remote-files)
 221 (setq auto-revert-remote-files t)
 222 (require 'autorevert)
 223 (when (and file-notify--test-local-enabled (null noninteractive))
 224
 225   (ert-deftest file-notify-test03-autorevert ()
 226     "Check autorevert via file notification.
 227 This test is skipped in batch mode."
 228     ;; `auto-revert-buffers' runs every 5".  And we must wait, until
 229     ;; the file has been reverted.
 230     (let ((timeout 10)
 231           buf)
 232       (unwind-protect
 233           (progn
 234             (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
 235
 236             (write-region "any text" nil file-notify--test-tmpfile)
 237             (setq buf (find-file-noselect file-notify--test-tmpfile))
 238             (with-current-buffer buf
 239               (should (string-equal (buffer-string) "any text"))
 240               (auto-revert-mode 1)
 241
 242               ;; `auto-revert-buffers' runs every 5".
 243               (with-timeout (timeout (ignore))
 244                 (while (null auto-revert-notify-watch-descriptor)
 245                   (sit-for 0.1 'nodisplay)))
 246
 247               ;; Check, that file notification has been used.
 248               (should auto-revert-mode)
 249               (should auto-revert-use-notify)
 250               (should auto-revert-notify-watch-descriptor)
 251
 252               ;; Modify file.  We wait for a second, in order to
 253               ;; have another timestamp.
 254               (sit-for 1)
 255               (shell-command
 256                (format "echo -n 'another text' >%s"
 257                        (or (file-remote-p file-notify--test-tmpfile 'localname)
 258                            file-notify--test-tmpfile)))
 259
 260               ;; Check, that the buffer has been reverted.
 261               (with-current-buffer (get-buffer-create "*Messages*")
 262                 (with-timeout (timeout (ignore))
 263                   (while
 264                       (null (string-match
 265                              (format "Reverting buffer `%s'." (buffer-name buf))
 266                              (buffer-string)))
 267                     (sit-for 0.1 'nodisplay))))
 268               (should (string-equal (buffer-string) "another text"))))
 269
 270         ;; Exit.
 271         (ignore-errors (kill-buffer buf))
 272         (ignore-errors (delete-file file-notify--test-tmpfile)))))
 273
 274   (file-notify--deftest-remote file-notify-test03-autorevert
 275     "Check autorevert via file notification for remote files.
 276 This test is skipped in batch mode.")
 277   ) ;; (and file-notify--test-local-enabled (null noninteractive))
 278
 279 (defun file-notify-test-all (&optional interactive)
 280   "Run all tests for \\[file-notify]."
 281   (interactive "p")
 282   (when file-notify--test-local-enabled
 283     (if interactive
 284         (ert-run-tests-interactively "^file-notify-")
 285       (ert-run-tests-batch "^file-notify-"))))
 286
 287 (provide 'file-notify-tests)
 288 ;;; file-notify-tests.el ends here