Commit 37b5e661 authored by Paul Eggert's avatar Paul Eggert
Browse files

Fix recently-introduced copy-directory bug

Problem reported by Andrew Christianson (Bug#28451):
* lisp/files.el (copy-directory): If COPY-CONTENTS, make the
destination directory if it does not exist, even if it is a
directory name.  Simplify, and omit unnecessary test for an
already-existing non-directory target, since make-directory
diagnoses that for us now.
* test/lisp/files-tests.el (files-tests--copy-directory):
Test for this bug.
parent 6bbbc38b
......@@ -5372,7 +5372,7 @@ raised."
(while (progn
(setq parent (directory-file-name
(file-name-directory dir)))
(condition-case err
(condition-case ()
(files--ensure-directory dir)
;; Do not loop if root does not exist (Bug#2309).
......@@ -5544,16 +5544,14 @@ into NEWNAME instead."
;; If NEWNAME is not a directory name, create it;
;; that is where we will copy the files of DIRECTORY.
(make-directory newname parents))
;; If NEWNAME is a directory name and COPY-CONTENTS
;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
((not copy-contents)
(setq newname (concat newname
(file-name-nondirectory directory)))
(and (file-exists-p newname)
(not (file-directory-p newname))
(error "Cannot overwrite non-directory %s with a directory"
(make-directory newname t)))
;; 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)))
(setq newname (concat newname
(file-name-nondirectory directory))))
(make-directory (directory-file-name newname) parents)))
;; Copy recursively.
(dolist (file
......@@ -393,5 +393,16 @@ name (Bug#28412)."
(should (null (save-buffer)))
(should (eq (buffer-size) 1))))))
(ert-deftest files-tests--copy-directory ()
(let* ((dir (make-temp-file "files-mkdir-test" t))
(dirname (file-name-as-directory dir))
(source (concat dirname "source"))
(dest (concat dirname "dest/new/directory/"))
(file (concat (file-name-as-directory source) "file")))
(make-directory source)
(write-region "" nil file)
(copy-directory source dest t t t)
(should (file-exists-p (concat dest "file")))))
(provide 'files-tests)
;;; files-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment