From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Andreas Politz Newsgroups: gmane.emacs.bugs Subject: bug#26126: 26.0.50; file-notify-rm-watch removes arbitrary watches Date: Sat, 25 Mar 2017 17:34:03 +0100 Message-ID: <87fui1fh8k.fsf@luca> References: <87r31x9ulw.fsf@luca> <87shmcney8.fsf@detlef> <87efxw7xvc.fsf@luca> <87mvcjophx.fsf@detlef> <87tw6rssoi.fsf@luca> <87pohfkmvh.fsf@detlef> <87lgs2sobr.fsf@luca> <87y3w2gywc.fsf@detlef> <8737e8excq.fsf@luca> <877f3el80j.fsf@luca> <83zig9c186.fsf@gnu.org> <87a889hgxb.fsf@luca> <83poh5bfuh.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1490459723 26055 195.159.176.226 (25 Mar 2017 16:35:23 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 25 Mar 2017 16:35:23 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 26126@debbugs.gnu.org, michael.albinus@gmx.de To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Mar 25 17:35:18 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1croel-0005ea-0f for geb-bug-gnu-emacs@m.gmane.org; Sat, 25 Mar 2017 17:35:11 +0100 Original-Received: from localhost ([::1]:37955 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1croeq-0002OK-S5 for geb-bug-gnu-emacs@m.gmane.org; Sat, 25 Mar 2017 12:35:16 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:52030) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1croeg-0002N6-Ju for bug-gnu-emacs@gnu.org; Sat, 25 Mar 2017 12:35:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1croec-0005h3-MW for bug-gnu-emacs@gnu.org; Sat, 25 Mar 2017 12:35:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:46315) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1croec-0005gk-JJ for bug-gnu-emacs@gnu.org; Sat, 25 Mar 2017 12:35:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1croec-0007HX-3p for bug-gnu-emacs@gnu.org; Sat, 25 Mar 2017 12:35:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Andreas Politz Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 25 Mar 2017 16:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 26126 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 26126-submit@debbugs.gnu.org id=B26126.149045966427913 (code B ref 26126); Sat, 25 Mar 2017 16:35:02 +0000 Original-Received: (at 26126) by debbugs.gnu.org; 25 Mar 2017 16:34:24 +0000 Original-Received: from localhost ([127.0.0.1]:44514 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1croe0-0007G9-29 for submit@debbugs.gnu.org; Sat, 25 Mar 2017 12:34:24 -0400 Original-Received: from gateway-a.fh-trier.de ([143.93.54.181]:40036) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1crody-0007Fn-78 for 26126@debbugs.gnu.org; Sat, 25 Mar 2017 12:34:22 -0400 X-Virus-Scanned: by Amavisd-new + McAfee uvscan + ClamAV [Rechenzentrum Hochschule Trier (RZ/HT)] Original-Received: from localhost (ip5f5bdecf.dynamic.kabel-deutschland.de [95.91.222.207]) (using TLSv1 with cipher AES256-SHA (256/256 bits)) (No client certificate requested) (Authenticated sender: politza) by gateway-a.fh-trier.de (Postfix) with ESMTPSA id AB9D0179B593; Sat, 25 Mar 2017 17:34:03 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha1; c=simple/simple; d=hochschule-trier.de; s=default; t=1490459644; bh=cBobyOS9FpBBtCFeQpvH7beBcoA=; h=From:To:Cc:Subject:References:Date:In-Reply-To:Message-ID: MIME-Version:Content-Type; b=ZoL7h7xWXdpcNbG6Bx8gnbe0PCY8XEadZMr2Dbi1RkQyy0044W83Px0fbx4q6n7DK QS0WusZqr1WPuO4WByfGK/Pknfjt4nBo4nmxD2p7aF9RDkZRmjtVNZ6ixoDU5uYgmU Avg/MQZgvt8ClpzYQlUsnvelpMTR/qi9QB+3wZRg= In-Reply-To: <83poh5bfuh.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 25 Mar 2017 17:17:42 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:130938 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: > That still leaves a lot of unclear entries there. maybe it isn't > important. Mmh. I attached the file which generated the table. >> >> Finally, I'm tempted to suggest to get rid of the flags argument of >> >> file-notify-add-watch. >> >> > The flags are there for the operations where the differences matter. >> >> When does it matter ? > > Why should we care? That's for the programmer to decide; we just give > them the tools. But this is not a restriction on the part of the programmer, as he can still filter out the events he's not interested in. >> Also: I think in the end we want to add a layer above filenotify.el, > That was the original plan, ... That's good to hear. -ap --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=check-filenotify.el Content-Transfer-Encoding: quoted-printable Content-Description: check-filenotify.el ;; -*- lexical-binding: t -*- (require 'cl-lib) (require 'filenotify) (require 'tramp) (require 'tramp-sh) (require 'seq) (defvar checkfn-tests nil) (defvar checkfn-rationalize-results t "Whether to map filenames to symbolic names.") (defvar checkfn-timeout 12 "Timeout for a single test.") (defvar checkfn-watch-flags '(changed attribute-change) "Flags used for `file-notify-add-watch'.") (defun checkfn-delete-files (filenames) (dolist (filename filenames) (when (and (stringp filename) (file-exists-p filename)) (if (file-directory-p filename) (delete-directory filename t) (delete-file filename))))) (defmacro checkfn-gather-events-let* (bindings &rest body) "Watch files bound in BINDINGS collecting all events. BINDINGS should bind variables to filenames. If BODY does not delete these filenames, this macro will do it. Return alist with elements (FILENAME . EVENTS)." (declare (indent 1) (debug ((&rest (symbolp form)) body))) (let ((watches (make-symbol "watches")) (results (make-symbol "results")) (filenames (make-symbol "filenames")) (filealist (make-symbol "filealist")) (done (make-symbol "done"))) `(let* (,@bindings (,filenames (list ,@(mapcar #'car bindings))) (,filealist (list ,@(mapcar (lambda (elt) `(cons ,(car elt) ',(car elt))) bindings))) (,results (mapcar #'list ,filenames)) (,done (mapcar #'list ,filenames)) (,watches (progn (mapcar (lambda (filename) (file-notify-add-watch filename checkfn-watch-flags (lambda (event) (when (eq (nth 1 event) 'stopped) (let ((elt (assoc filename ,done))) (setcdr elt t))) (let ((elt (assoc filename ,results))) (setcdr elt (append (cdr elt) (list (cdr ev= ent)))))))) ,filenames)))) (unwind-protect (progn (progn ,@body) (checkfn-delete-files ,filenames) (with-timeout (checkfn-timeout (dolist (elt ,results) (unless (cdr (assoc (car elt) ,done)) (setcdr elt (append (cdr elt) `((timedout ,checkfn-timeout)))))) (dolist (watch ,watches) (ignore-errors (file-notify-rm-watch watch)))) (while (memq nil (mapcar #'cdr ,done)) (read-event nil nil 0.1))) (if checkfn-rationalize-results (checkfn-gather-events-rationalize-results ,results ,filea= list) ,results)) (dolist (watch ,watches) (ignore-errors (file-notify-rm-watch watch))))))) (defun checkfn-gather-events-rationalize-results (results alist) (let ((nanons 0)) (cl-labels ((aget (key) (let ((elt (assoc key alist))) (if elt (cdr elt) (let ((anon (intern (format "anon-%d" (cl-incf nanons= ))))) (push (cons key anon) alist) anon))))) (mapcar (pcase-lambda (`(,filename . ,events)) (cons (aget filename) (mapcar (pcase-lambda (`(,action ,file . ,rest)) (if (eq action 'timedout) (list action file) (if rest `(,action ,(aget file) ,(aget (car rest))) `(,action ,(aget file))))) events))) results)))) (defmacro define-checkfn-test (name &optional documentation &rest body) (cl-check-type name symbol) (let ((fn (intern (format "checkfn-test-%s" name)))) `(progn (defun ,fn () ,documentation ,@body) (setq checkfn-tests (append (cl-remove ',name checkfn-tests :key #'car) (list (cons ',name ',fn)))) ',name))) (defun checkfn-chattr (filename) (cl-assert (file-exists-p filename)) (set-file-times filename (seconds-to-time (1+ (time-to-seconds (current-time)))))) (defun checkfn-create (filename &optional directory-p) (cl-assert (not (file-exists-p filename))) (if directory-p (make-directory filename) (with-temp-file filename))) (defun checkfn-make-file (&optional dir directory-p) (cl-check-type dir (or null string)) (let ((temporary-file-directory (or dir temporary-file-directory))) (make-temp-file "checkfn" directory-p))) (defun checkfn-make-name (&optional dir) (cl-check-type dir (or null string)) (make-temp-name (format "%s/checkfn" (directory-file-name (or dir temporary-file-directory))))) (defmacro checkfn-cleanup-files-let* (bindings &rest body) (declare (indent 1) (debug ((&rest (symbolp form)) body))) (let ((files (make-symbol "files"))) `(let* (,@bindings (,files (list ,@(mapcar #'car bindings)))) (unwind-protect (progn ,@body) (checkfn-delete-files ,files))))) ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ ;; | Regular Files ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ (define-checkfn-test file-create (if (eq (checkfn-backend) 'kqueue) 'skipped (checkfn-gather-events-let* ((file (checkfn-make-name))) (checkfn-create file)))) (define-checkfn-test file-read (checkfn-gather-events-let* ((file (checkfn-make-file))) (with-temp-buffer (insert-file-contents file)))) (define-checkfn-test file-write (checkfn-gather-events-let* ((file (checkfn-make-file))) (with-temp-file file (insert "XXX")))) (define-checkfn-test file-attrib (checkfn-gather-events-let* ((file (checkfn-make-file))) (checkfn-chattr file) (delete-file file))) (define-checkfn-test file-rename (checkfn-gather-events-let* ((dir (checkfn-make-file nil t)) (dir/src (checkfn-make-file dir)) (dir/dest (checkfn-make-file dir))) (rename-file dir/src dir/dest t))) ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ ;; | Directories ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ (define-checkfn-test dir-create (if (eq (checkfn-backend) 'kqueue) 'skipped (checkfn-gather-events-let* ((dir (checkfn-make-name))) (checkfn-create dir t)))) (define-checkfn-test dir-read (checkfn-gather-events-let* ((dir (checkfn-make-file nil t))) (directory-files dir))) (define-checkfn-test dir-create-file (checkfn-gather-events-let* ((dir (checkfn-make-file nil t)) (dir/file (checkfn-make-file dir))))) (define-checkfn-test dir-create-dir (checkfn-gather-events-let* ((dir (checkfn-make-file nil t)) (dir/dir (checkfn-make-file dir t))))) (define-checkfn-test dir-attrib (checkfn-gather-events-let* ((dir (checkfn-make-file nil t))) (checkfn-chattr dir))) (define-checkfn-test dir-rename (if (eq (checkfn-backend) 'kqueue) 'skipped (checkfn-gather-events-let* ((dir (checkfn-make-file nil t)) (dir/src (checkfn-make-file dir t)) (dir/dest (checkfn-make-name))) (rename-file dir/src dir/dest t)))) ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ ;; | Runner ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ (defun checkfn-backend (&optional filename) (unless filename (setq filename temporary-file-directory)) (let* ((watch (file-notify-add-watch filename '(change attribute-change) #'ignore))) (unwind-protect (cond ((processp watch) (intern (file-name-sans-extension (replace-regexp-in-string "<[[:digit:]]+>" "" (process-name watch))))) (t file-notify--library)) (ignore-errors (file-notify-rm-watch watch))))) (defun checkfn-run (&optional tests) (unless tests (setq tests checkfn-tests)) (let (results) (dolist (elt tests) (when (symbolp elt) (setq elt (assq elt checkfn-tests))) (cl-check-type elt cons) (cl-check-type (car elt) symbol) (cl-check-type (cdr elt) function) (message "Test: %s" (car elt)) (checkfn-cleanup-files-let* ((temporary-file-directory (checkfn-make-file nil t))) (pcase-let ((`(,name . ,fn) elt)) (push (cons name (condition-case err (funcall fn) (error (message "Error: %s" (error-message-string er= r)) 'failed))) results)))) (cons (checkfn-backend) (nreverse results)))) (defun checkfn-run-pp (&optional outfile tests) (let ((print-length nil) (print-level nil) (print-quoted t) (standard-output (if outfile (with-current-buffer (find-file-noselect outfile) (erase-buffer) (current-buffer)) standard-output))) (message "Backend: %s" (checkfn-backend)) (when outfile (message "Writing to `%s'" outfile)) (pp (checkfn-run tests)) (when outfile (with-current-buffer standard-output (save-buffer))))) (defmacro checkfn-with-tramp-mock-method (&rest body) `(let ((tramp-methods (cons '("mock" (tramp-login-program "sh") (tramp-login-args (("-i"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10)) tramp-methods))) ,@body)) (defun checkfn-gfilemonitor-run-pp (&optional outfile tests) (cl-letf (((symbol-function 'tramp-get-remote-inotifywait) #'ignore)) (checkfn-with-tramp-mock-method (let ((temporary-file-directory (concat "/mock::" temporary-file-directory)) (tramp-verbose 0)) (checkfn-run-pp outfile tests))))) (defun checkfn-inotifywait-run-pp (&optional outfile tests) (cl-letf (((symbol-function 'tramp-get-remote-gvfs-monitor-dir) #'ignore)) (checkfn-with-tramp-mock-method (let ((temporary-file-directory (concat "/mock::" temporary-file-directory)) (tramp-verbose 0)) (checkfn-run-pp outfile tests))))) (defun checkfn-run-batch (&optional outdir backend) (let ((outfile (expand-file-name (format "checkfn-%s-log.el" (or backend (checkfn-backend))) outdir))) (message "%S" backend) (pcase backend ('gfilemonitor (checkfn-gfilemonitor-run-pp outfile)) ('inotifywait (checkfn-inotifywait-run-pp outfile)) ((guard (or (null backend) (eq backend (checkfn-backend)))) (checkfn-run-pp outfile)) (_ (error "Backend not available: %s" backend))))) ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ ;; | Table ;; +=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D+ (defun checkfn-table-draw-test-result (test-results c1 c2 c3) (let ((name (caar test-results)) (actions (let ((watches (seq-some (lambda (elt) (and (consp elt) (mapcar #'car elt))) (mapcar #'cdr test-results)))) (mapcar (lambda (events) (if (not (consp events)) (mapcar (lambda (watch) (cons watch (list events))) (or watches (list ""))) events)) (mapcar #'cdr test-results))))) (princ name) (move-to-column c1 t) (apply #'cl-mapcar (lambda (&rest watches) (princ (caar watches)) (move-to-column (+ c1 c2) t) (let ((actions (mapcar #'cdr watches))) (while (not (seq-every-p #'null actions)) (let ((column (+ c1 c2))) (setq actions (mapcar (lambda (action) (prog1 (when action (if (consp (car action)) (dolist (action (car action)) (princ (cl-case action (attribute-changed 'attr-changed) (t action))) (princ " ")) (princ (car action))) (cdr action)) (cl-incf column c3) (move-to-column column t))) actions))) (terpri) (move-to-column (+ c1 c2) t)) (terpri) (move-to-column c1 t))) actions) (move-to-column 0 t))) (defun checkfn-make-table (&rest results) (setq results (mapcar (lambda (result) (if (stringp result) (with-temp-buffer (insert-file-contents result) (goto-char 1) (read (current-buffer))) result)) results)) (with-current-buffer (get-buffer-create "*checkfn-table*") (let* ((inhibit-read-only t) (standard-output (current-buffer)) (backends (mapcar #'car results)) (columns (list 16 12 32))) (cl-destructuring-bind (c1 c2 c3) columns (cl-labels ((hline () (princ (make-string (+ c1 c2 (* c3 (length backends))= ) ?-)) (terpri))) (erase-buffer) (setq-local truncate-lines t) (let ((column (+ c1 c2))) (move-to-column column t) (dolist (backend backends) (pp backend) (cl-incf column c3) (move-to-column column t)) (terpri)) (hline) (dotimes (n (length (cdr (car results)))) (checkfn-table-draw-test-result (checkfn-table-nth-test results n) c1 c2 c3) (hline)) (pop-to-buffer (current-buffer)) (goto-char (point-min)) (delete-other-windows)))))) --=-=-=--