From: Paul Eggert <eggert@penguin.cs.ucla.edu>
Date: Sat, 17 Dec 2022 20:15:30 +0000 (-0800)
Subject: Fix copy-directory bug when dest dir exists
X-Git-Tag: emacs-29.0.90~1100
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=44c83b239d3cbb5c7675c8abd595fd3e33811ece;p=emacs.git

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.
---

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 ()