From 5b6435e1e57ae0c20ce3078ac1fe97a7757c4ba7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 16 Dec 2022 14:55:48 -0800 Subject: [PATCH 3/3] Fix copy-directory bug when dest dir exists MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 235eacee704..3cf7833ae02 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6437,7 +6437,7 @@ copy-directory ;; 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 @@ copy-directory 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 @@ files-tests-copy-directory (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 @@ files-tests-copy-directory (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 () -- 2.38.1