procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix recently-introduced copy-directory bug

Browse source 
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.
This commit is contained in:
Paul Eggert 2017-09-17 12:56:00 -07:00
parent 6bbbc38b34
commit 37b5e661d2
2 changed files with 20 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lisp/files.el
View file

@ -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)
(file-missing
;; 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"
newname))
(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

11
test/lisp/files-tests.el
View 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