mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Fix copy-directory bug when dest dir exists

Browse source 
* 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.
This commit is contained in:
Paul Eggert 2022-12-17 12:15:30 -08:00 • committed by Paul Eggert
parent bef1edc9ca
commit 44c83b239d
2 changed files with 20 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

19
lisp/files.el
View file

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

9
test/lisp/files-tests.el
View file

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