Re: bug in copy-directory

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

Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:

> Michael Albinus <michael.albinus@gmx.de> writes:
>
>> Chong Yidong <cyd@stupidchicken.com> writes:
>>
>>> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>>>
>>>> Ok thanks, i sent a patch to Chong.
>>>
>>> I've committed your patch, with a number of changes (e.g. renaming the
>>> new argument to `copy-as-subdir').  Please test it and see if everything
>>> behaves as you expect.  Thanks.
>>
>> Now it is even worse. Going to the initial test case:
>>
>> - Create directory /tmp/test
>> - Create directory /tmp/test/test
>> - Create file /tmp/test/a
>> - Create file /tmp/test/test/b
>> - Apply (copy-directory "/tmp/test" "~/")
>>
>> You get "~/a", "~/test" and "~/test/b".
> Now you have to do:
> (copy-directory "/tmp/test" "~/" nil nil t)
>
> And if you do M-x copy-directory, all work fine because last arg is
> always used in interactive calls.

If you want to be able to do:
(copy-directory "/tmp/test" "~/")
We will have to fallback to a function copy-directory1 used by dired and
a copy-directory function/command that ALWAYS use last arg of
copy-directory1.

Here are units-test for copy-directory:
(replace /home/thierry to /home/you)

;; Unit tests for copy-directory.
;; Download:
;; http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el
;; http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el
(require 'cl)
(require 'el-expectations)
(require 'el-mock)
(expectations
  (desc "Copy directory and overwrite")
  (expect '("/home/thierry/test/a" "/home/thierry/test/test" "/home/thierry/test/test/b")
    (delete-directory "~/test" t)
    (make-directory "/tmp/test/test" t)
    (with-current-buffer (find-file-noselect "/tmp/test/a")
      (insert "test1")
      (save-buffer))
    (with-current-buffer (find-file-noselect "/tmp/test/test/b")
      (insert "test2")
      (save-buffer))
    (copy-directory "/tmp/test" "~/" nil nil t)
    (copy-directory "/tmp/test" "~/" nil nil t)
  (let (result)
    (labels ((ls-R (dir)
               (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
                  for f in ls
                  if (file-directory-p f)
                  do (progn (push f result) (ls-R f))
                  else do (push f result))))
      (ls-R "~/test")
      (nreverse result)))))
(expectations
  (desc "Copy directory and overwrite from dired")
  (expect '("/home/thierry/test/a" "/home/thierry/test/test" "/home/thierry/test/test/b")
    (let ((A "/tmp/test")
          (B "/home/thierry/test"))
      (flet ((test-dired (flist dir)
               (dired-create-files 'dired-copy-file "copy" flist
                                   (if (file-directory-p dir)
                                       #'(lambda (from)
                                           (expand-file-name (anything-c-basename from) dir))
                                       #'(lambda (from) dir)))))

        (when (and (file-directory-p A)
                   (y-or-n-p (format "Delete directory %s? " A)))
          (delete-directory A t))
        (when (and (file-directory-p B)
                   (y-or-n-p (format "Delete directory %s? " B)))
          (delete-directory B t))
        (make-directory (concat (file-name-as-directory A) "test") t)
        (with-current-buffer (find-file-noselect "/tmp/test/a")
          (insert "test1")
          (save-buffer))
        (with-current-buffer (find-file-noselect "/tmp/test/test/b")
          (insert "test2")
          (save-buffer))
        ;; Create
        (test-dired (list A) "~/")
        ;; Overwrite
        (test-dired (list A) "~/")
        (let (result)
          (labels ((ls-R (dir)
                     (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
                        for f in ls
                        if (file-directory-p f)
                        do (progn (push f result) (ls-R f))
                        else do (push f result))))
            (ls-R B)
            (nreverse result)))))))
 
-- 
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997