GNU bug report logs -
#10489
24.0.92; dired-do-copy may create infinite directory hierarchy
Previous Next
Reported by: michael_heerdegen <at> web.de
Date: Thu, 12 Jan 2012 19:36:01 UTC
Severity: important
Tags: patch
Merged with 11130
Found in version 24.0.92
Done: Chong Yidong <cyd <at> gnu.org>
Bug is archived. No further changes may be made.
Full log
Message #178 received at 10489 <at> debbugs.gnu.org (full text, mbox):
Michael Albinus <michael.albinus <at> gmx.de> writes:
> Thierry Volpiatto <thierry.volpiatto <at> gmail.com> writes:
>
>> Thierry Volpiatto <thierry.volpiatto <at> gmail.com> writes:
>>
>>> Many examples given here, so if everybody is ok with The function given
>>> by Drew, we could commit the attached patch to fix this bug:
>> Note also that the bug is still here with this code
>> when copying on same system "/sudo::/foo" to "/foo"
>
> One could also add it to Tramp for Emacs 24.1. But this sounds like a
> new feature to me, and I would like to postpone it to Emacs 24.2. There
> must be robust testing, if we start to handle such use cases.
IMHO we should fix this bug for most use cases with a compare function
maybe not perfect in many points but ok for most basic usages.
The function shown by Drew and I put in last patch as you said isn't
sufficient and fail in many cases even on local filesystem:
(defun bmkp-same-file-p (file1 file2)
"Return non-nil if FILE1 and FILE2 name the same file.
If either name is not absolute, then it is expanded relative to
`default-directory' for the test."
(and (equal (file-remote-p file1) (file-remote-p file2))
(string= (file-truename (expand-file-name file1))
(file-truename (expand-file-name file2)))))
(bmkp-same-file-p "~/Test" "/home/thierry/Test/") => nil
That would be for Emacs24.1, and we could work on the real thing in
tramp for 24.2
Here is my last work on this based on precedent example i sent and your
last advices; it doesn't cover many use cases as you point before, test
user, method etc... but works for all the use cases below:
#+BEGIN_SRC emacs-lisp
(defun file-equal-p (name1 name2)
(if (or (file-remote-p name1)
(file-remote-p name2))
(let* ((n1 (file-name-as-directory
(expand-file-name name1)))
(n2 (file-name-as-directory
(expand-file-name name2)))
(rhost1 (file-remote-p n1 'host))
(rhost2 (file-remote-p n2 'host))
(lname1 (file-remote-p n1 'localname))
(lname2 (file-remote-p n2 'localname))
rem-n1 rem-n2)
(cond ((and rhost1 (not rhost2))
(setq rem-n1 (list (cons rhost1 (file-truename lname1))))
(setq rem-n2 (list (cons (system-name) (file-truename n2)))))
((and (not rhost1) rhost2)
(setq rem-n1 (list (cons (system-name) (file-truename n1))))
(setq rem-n2 (list (cons rhost2 (file-truename lname2)))))
((and rhost1 rhost2)
(setq rem-n1 (list (cons rhost1 (file-truename lname1))))
(setq rem-n2 (list (cons rhost2 (file-truename lname2))))))
(loop for (x1 . y1) in rem-n1
for (x2 . y2) in rem-n2
always (and (equal x1 x2)
(equal y1 y2))))
(string= (file-name-as-directory
(file-truename (expand-file-name name1)))
(file-name-as-directory
(file-truename (expand-file-name name2))))))
#+END_SRC
--8<---------------cut here---------------start------------->8---
(dont-compile
(when (fboundp 'expectations)
(expectations
(desc "Local file name comparison: Symlink<=>truefile")
(expect t
(file-equal-p "~/.emacs.el" "~/.emacs.d/emacs-config-laptop/.emacs.el"))
(desc "Local file name comparison")
(expect t
(file-equal-p "/home/thierry/Test" "~/Test"))
(expect t
(file-equal-p "/home/thierry/Test" "~/Test/"))
(expect nil
(file-equal-p "/home/thierry/Test" "/home/thierry/tmp/Test"))
(expect t
(file-equal-p "./save-scratch.el" "~/labo/tmp/save-scratch.el"))
(expect nil
(file-equal-p "/home/thierry/tmp" "/tmp"))
(expect nil
(file-equal-p "/home/thierry/test" "/home/thierry/Test"))
(desc "Sudo file against local")
(expect nil
(file-equal-p "/sudo::/home/thierry/Test" "/sudo::~/Test"))
(expect t
(file-equal-p "/sudo::/home/thierry/Test" "~/Test"))
(desc "Remote file name comparison with different methods")
(expect t
(file-equal-p "/ssh:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test"))
(desc "Remote file name with localfile")
(expect nil
(file-equal-p "/ssh:thievol:/home/thierry/Test" "/home/thierry/Test"))
(desc "Remote file name comparison with same methods same files")
(expect t
(file-equal-p "/scpc:thievol:/home/thierry/Test" "/scpc:thievol:/home/thierry/Test")))))
--8<---------------cut here---------------end--------------->8---
22 expectations, 0 failures, 0 errors
Expectations finished at Sun Jan 15 20:04:10 2012
--
Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997
This bug report was last modified 13 years and 58 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.