bug#10489: 24.0.92; dired-do-copy may create infinite directory hierarchy

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

Michael Albinus <michael.albinus@gmx.de> writes:

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Thierry Volpiatto <thierry.volpiatto@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