Fix recently-introduced copy-directory bug

Problem reported by Andrew Christianson (Bug#28451):
* lisp/files.el (copy-directory): If COPY-CONTENTS, make the
destination directory if it does not exist, even if it is a
directory name.  Simplify, and omit unnecessary test for an
already-existing non-directory target, since make-directory
diagnoses that for us now.
* test/lisp/files-tests.el (files-tests--copy-directory):
Test for this bug.

diff --git a/lisp/files.el b/lisp/files.el
index c55c8097c16ed2df24da62c34f436ea714ff5c18..133fed90c34be28c056bc7ef4d956e4185f5315d 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5372,7 +5372,7 @@ raised."
          (while (progn
                   (setq parent (directory-file-name
                                 (file-name-directory dir)))
-                  (condition-case err
+                  (condition-case ()
                       (files--ensure-directory dir)
                     (file-missing
                      ;; Do not loop if root does not exist (Bug#2309).
@@ -5544,16 +5544,14 @@ into NEWNAME instead."
             ;; If NEWNAME is not a directory name, create it;
             ;; that is where we will copy the files of DIRECTORY.
             (make-directory newname parents))
-           ;; If NEWNAME is a directory name and COPY-CONTENTS
-           ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
-           ((not copy-contents)
-            (setq newname (concat newname
-                           (file-name-nondirectory directory)))
-            (and (file-exists-p newname)
-                 (not (file-directory-p newname))
-                 (error "Cannot overwrite non-directory %s with a directory"
-                        newname))
-            (make-directory newname t)))
+           ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
+           ;; create NEWNAME if it is not already a directory;
+           ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+           ((if copy-contents
+                (or parents (not (file-directory-p newname)))
+              (setq newname (concat newname
+                                    (file-name-nondirectory directory))))
+            (make-directory (directory-file-name newname) parents)))
 
       ;; Copy recursively.
       (dolist (file

diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index ef216c3f34a4089acc401abab36e671c52d1913f..3117ea697ec0fe3d1e2378faf87279dc480fbef1 100644 (file)
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -393,5 +393,16 @@ name (Bug#28412)."
         (should (null (save-buffer)))
         (should (eq (buffer-size) 1))))))
 
+(ert-deftest files-tests--copy-directory ()
+  (let* ((dir (make-temp-file "files-mkdir-test" t))
+        (dirname (file-name-as-directory dir))
+        (source (concat dirname "source"))
+        (dest (concat dirname "dest/new/directory/"))
+        (file (concat (file-name-as-directory source) "file")))
+    (make-directory source)
+    (write-region "" nil file)
+    (copy-directory source dest t t t)
+    (should (file-exists-p (concat dest "file")))))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here