Fix copy-directory bug when dest dir exists

* lisp/files.el (copy-directory): Set ‘follow’ depending on
whether we made the directory, not based on a guess that is
sometimes wrong.  When NEWNAME is a directory name and
COPY-CONTENTS is nil, do not object merely because the adjusted
NEWNAME is already a directory.  (Bug#58919).
* test/lisp/files-tests.el (files-tests-copy-directory):
Test for the bug.

2 files changed, 20 insertions, 8 deletions

diff --git a/lisp/files.el b/lisp/files.el
index 235eacee704..3cf7833ae02 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6437,7 +6437,7 @@ into NEWNAME instead."
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
                      (find-file-name-handler newname 'copy-directory)))
-        (follow parents))
+        follow)
     (if handler
         (funcall handler 'copy-directory directory
                  newname keep-time parents copy-contents)
@@ -6457,19 +6457,24 @@ into NEWNAME instead."
                                     t)
               (make-symbolic-link target newname t)))
         ;; Else proceed to copy as a regular directory
-        (cond ((not (directory-name-p newname))
+        ;; first by creating the destination directory if needed,
+        ;; preparing to follow any symlink to a directory we did not create.
+        (setq follow
+            (if (not (directory-name-p newname))
                ;; If NEWNAME is not a directory name, create it;
                ;; that is where we will copy the files of DIRECTORY.
-               (make-directory newname parents))
+               (make-directory newname parents)
               ;; 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)))
+              (unless copy-contents
                  (setq newname (concat newname
                                        (file-name-nondirectory directory))))
-               (make-directory (directory-file-name newname) parents))
-              (t (setq follow t)))
+              (condition-case err
+                  (make-directory (directory-file-name newname) parents)
+                (error
+                 (or (file-directory-p newname)
+                     (signal (car err) (cdr err)))))))
 
         ;; Copy recursively.
         (dolist (file
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index b9fbeb8a4e0..011bfa67cc2 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1346,7 +1346,9 @@ name (Bug#28412)."
            (dest (concat dirname "dest/new/directory/"))
            (file (concat (file-name-as-directory source) "file"))
            (source2 (concat dirname "source2"))
-           (dest2 (concat dirname "dest/new2")))
+           (dest2 (concat dirname "dest/new2"))
+           (source3 (concat dirname "source3/d"))
+           (dest3 (concat dirname "dest3/d")))
       (make-directory source)
       (write-region "" nil file)
       (copy-directory source dest t t t)
@@ -1354,6 +1356,11 @@ name (Bug#28412)."
       (make-directory (concat (file-name-as-directory source2) "a") t)
       (copy-directory source2 dest2)
       (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
+      (make-directory source3 t)
+      (write-region "x\n" nil (concat (file-name-as-directory source3) "file"))
+      (make-directory dest3 t)
+      (write-region "y\n" nil (concat (file-name-as-directory dest3) "file"))
+      (copy-directory source3 (file-name-directory dest3) t)
       (delete-directory dir 'recursive))))
 
 (ert-deftest files-tests-abbreviate-file-name-homedir ()