From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.devel Subject: Re: [Emacs-diffs] master 11cf3e9: Implement a new function directory-files-recursively Date: Sun, 14 Dec 2014 09:48:55 +0100 Message-ID: <87vbler4zs.fsf@gmail.com> References: <20141209062121.9440.90058@vcs.savannah.gnu.org> <87ppbrpfx4.fsf@gmail.com> <87d27o80j8.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1418546966 12279 80.91.229.3 (14 Dec 2014 08:49:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 14 Dec 2014 08:49:26 +0000 (UTC) Cc: emacs-devel@gnu.org To: Lars Magne Ingebrigtsen Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Dec 14 09:49:19 2014 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Y04rd-0003xQ-Dp for ged-emacs-devel@m.gmane.org; Sun, 14 Dec 2014 09:49:17 +0100 Original-Received: from localhost ([::1]:35380 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y04rc-0000er-QS for ged-emacs-devel@m.gmane.org; Sun, 14 Dec 2014 03:49:16 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57724) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y04rS-0000dv-Qw for emacs-devel@gnu.org; Sun, 14 Dec 2014 03:49:13 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Y04rL-0003Dn-JZ for emacs-devel@gnu.org; Sun, 14 Dec 2014 03:49:06 -0500 Original-Received: from mail-wg0-x236.google.com ([2a00:1450:400c:c00::236]:53270) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y04rL-0003Dg-8z for emacs-devel@gnu.org; Sun, 14 Dec 2014 03:48:59 -0500 Original-Received: by mail-wg0-f54.google.com with SMTP id l2so12323258wgh.41 for ; Sun, 14 Dec 2014 00:48:58 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=references:from:to:cc:subject:in-reply-to:date:message-id :mime-version:content-type; bh=DB4vi5tiLidA/cm8MWMNqIoZUrXqRkls44Y5w9PNF3s=; b=K/kHXWPIGOAghp3VRNzX8H0BUr/fWhJ6LTEzXhgaTcTIOc8eT2gL8pOEYta54MdJl9 noCEu4iTZSvz4NN4R6XdH7JL0o7c4Gpt5R2ZlYisHR5Ifh5rsgK1mjPqLdmEBpgD5bOd P48gMlCBg4ccBmr1mscZp73E/6w0nHYF0m6Q4u96izsbuFIASg+ajTmQKFAbMSEdqVR7 bSi+5BICyyCe4K1DNFZhM2I+uSx26OE+orBOLjlez7saz1TZPxwxT4KGmXcYQOHSs759 KmukypNg/YS/pyWFzFTWDpNBfy/bw0NJj2zwHG7jUEJ1ZyO20j5iGBWUae3aIyqa8dt8 xd1g== X-Received: by 10.180.83.228 with SMTP id t4mr22500447wiy.28.1418546938379; Sun, 14 Dec 2014 00:48:58 -0800 (PST) Original-Received: from dell-14z (lbe83-2-78-243-104-167.fbx.proxad.net. [78.243.104.167]) by mx.google.com with ESMTPSA id j9sm8378706wjb.38.2014.12.14.00.48.57 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sun, 14 Dec 2014 00:48:57 -0800 (PST) In-reply-to: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c00::236 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:180057 Archived-At: Lars Magne Ingebrigtsen writes: > Thierry Volpiatto writes: > >> Also it seems the function is still inflooping even with the check of >> file-symlink-p (a bug of file-name-all-completions ?). > > Do you know what causes this loop? Some kind of symlink that > `file-name-all-completions' handles incorrectly or something? Ok I found the bug. To reproduce: mkdir -p ~/tmp/test/test1/test2/ touch ~/tmp/test/test1/test2/foo.txt ln -s ~/tmp/test/ ~/tmp/test/test (directory-files-recursively "~/tmp/test" "") => --8<---------------cut here---------------start------------->8--- Debugger entered--Lisp error: (file-error "Opening directory" "trop de niveaux de liens symboliques" "/home/thierry/tmp/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/") file-name-all-completions("" "/home/thierry/tmp/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/") (sort (file-name-all-completions "" dir) (quote string<)) (let ((--dolist-tail-- (sort (file-name-all-completions "" dir) (quote string<)))) (while --dolist-tail-- (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file (1- ...)) 47) (let ((path ...)) (if (file-symlink-p path) nil (setq result ...)) (if (and include-directories ...) (progn ...))) (if (string-match match file) (progn (setq files ...))))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (let ((result nil) (files nil)) (let ((--dolist-tail-- (sort (file-name-all-completions "" dir) (quote string<)))) (while --dolist-tail-- (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file ...) 47) (let (...) (if ... nil ...) (if ... ...)) (if (string-match match file) (progn ...)))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (nconc result (nreverse files))) directory-files-recursively("/home/thierry/tmp/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/test/" "" nil) (nconc result (directory-files-recursively path match include-directories)) (setq result (nconc result (directory-files-recursively path match include-directories))) (if (file-symlink-p path) nil (setq result (nconc result (directory-files-recursively path match include-directories)))) (let ((path (expand-file-name file dir))) (if (file-symlink-p path) nil (setq result (nconc result (directory-files-recursively path match include-directories)))) (if (and include-directories (string-match match (substring file 0 (1- (length file))))) (progn (setq result (nconc result (list path)))))) (if (= (aref file (1- (length file))) 47) (let ((path (expand-file-name file dir))) (if (file-symlink-p path) nil (setq result (nconc result (directory-files-recursively path match include-directories)))) (if (and include-directories (string-match match (substring file 0 (1- (length file))))) (progn (setq result (nconc result (list path)))))) (if (string-match match file) (progn (setq files (cons (expand-file-name file dir) files))))) (if (member file (quote ("./" "../"))) nil (if (= (aref file (1- (length file))) 47) (let ((path (expand-file-name file dir))) (if (file-symlink-p path) nil (setq result (nconc result (directory-files-recursively path match include-directories)))) (if (and include-directories (string-match match (substring file 0 (1- ...)))) (progn (setq result (nconc result (list path)))))) (if (string-match match file) (progn (setq files (cons (expand-file-name file dir) files)))))) (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file (1- (length file))) 47) (let ((path (expand-file-name file dir))) (if (file-symlink-p path) nil (setq result (nconc result (directory-files-recursively path match include-directories)))) (if (and include-directories (string-match match (substring file 0 ...))) (progn (setq result (nconc result ...))))) (if (string-match match file) (progn (setq files (cons (expand-file-name file dir) files)))))) (setq --dolist-tail-- (cdr --dolist-tail--))) (while --dolist-tail-- (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file (1- (length file))) 47) (let ((path (expand-file-name file dir))) (if (file-symlink-p path) nil (setq result (nconc result ...))) (if (and include-directories (string-match match ...)) (progn (setq result ...)))) (if (string-match match file) (progn (setq files (cons ... files)))))) (setq --dolist-tail-- (cdr --dolist-tail--)))) (let ((--dolist-tail-- (sort (file-name-all-completions "" dir) (quote string<)))) (while --dolist-tail-- (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file (1- ...)) 47) (let ((path ...)) (if (file-symlink-p path) nil (setq result ...)) (if (and include-directories ...) (progn ...))) (if (string-match match file) (progn (setq files ...))))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (let ((result nil) (files nil)) (let ((--dolist-tail-- (sort (file-name-all-completions "" dir) (quote string<)))) (while --dolist-tail-- (let ((file (car --dolist-tail--))) (if (member file (quote ("./" "../"))) nil (if (= (aref file ...) 47) (let (...) (if ... nil ...) (if ... ...)) (if (string-match match file) (progn ...)))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (nconc result (nreverse files))) --8<---------------cut here---------------end--------------->8--- Now patch directory-files-recursively: --8<---------------cut here---------------start------------->8--- diff --git a/lisp/files.el b/lisp/files.el index 40972d4..ae55b1f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -774,7 +774,7 @@ If INCLUDE-DIRECTORIES, also include directories that have matching names." (if (= (aref file (1- (length file))) ?/) (let ((path (expand-file-name file dir))) ;; Don't follow symlinks to other directories. - (unless (file-symlink-p path) + (unless (file-symlink-p (directory-file-name path)) (setq result (nconc result (directory-files-recursively path match include-directories)))) (when (and include-directories --8<---------------cut here---------------end--------------->8--- (directory-files-recursively "~/tmp/test" "") => ("/home/thierry/tmp/test/test1/test2/foo.txt") -- Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997