emacs-29 44c83b239d 3/4: Fix copy-directory bug when dest dir exists

[Paul Eggert]

branch: emacs-29
commit 44c83b239d3cbb5c7675c8abd595fd3e33811ece
Author: Paul Eggert <eggert@penguin.cs.ucla.edu>
Commit: Paul Eggert <eggert@cs.ucla.edu>

    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.
---
 lisp/files.el            | 19 ++++++++++++-------
 test/lisp/files-tests.el |  9 ++++++++-
 2 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 235eacee70..3cf7833ae0 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 b9fbeb8a4e..011bfa67cc 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 ()