From 37b5e661d298cbfe51422cd515b6696a1cdaa868 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 12:56:00 -0700 Subject: [PATCH] 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. --- lisp/files.el | 20 +++++++++----------- test/lisp/files-tests.el | 11 +++++++++++ 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index c55c809..133fed9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5372,7 +5372,7 @@ make-directory (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 @@ copy-directory ;; 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 diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index ef216c3..3117ea6 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -393,5 +393,16 @@ files-tests--with-temp-file (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 -- 2.7.4