aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2017-09-17 12:56:00 -0700
committerPaul Eggert2017-09-17 13:06:54 -0700
commit37b5e661d298cbfe51422cd515b6696a1cdaa868 (patch)
treebd37e0f404e7061640f89de39b33968d8df29076
parent6bbbc38b3421723521f7cdd4fd617a4fc889aceb (diff)
downloademacs-37b5e661d298cbfe51422cd515b6696a1cdaa868.tar.gz
emacs-37b5e661d298cbfe51422cd515b6696a1cdaa868.zip
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.
-rw-r--r--lisp/files.el20
-rw-r--r--test/lisp/files-tests.el11
2 files changed, 20 insertions, 11 deletions
diff --git a/lisp/files.el b/lisp/files.el
index c55c8097c16..133fed90c34 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5372,7 +5372,7 @@ raised."
5372 (while (progn 5372 (while (progn
5373 (setq parent (directory-file-name 5373 (setq parent (directory-file-name
5374 (file-name-directory dir))) 5374 (file-name-directory dir)))
5375 (condition-case err 5375 (condition-case ()
5376 (files--ensure-directory dir) 5376 (files--ensure-directory dir)
5377 (file-missing 5377 (file-missing
5378 ;; Do not loop if root does not exist (Bug#2309). 5378 ;; Do not loop if root does not exist (Bug#2309).
@@ -5544,16 +5544,14 @@ into NEWNAME instead."
5544 ;; If NEWNAME is not a directory name, create it; 5544 ;; If NEWNAME is not a directory name, create it;
5545 ;; that is where we will copy the files of DIRECTORY. 5545 ;; that is where we will copy the files of DIRECTORY.
5546 (make-directory newname parents)) 5546 (make-directory newname parents))
5547 ;; If NEWNAME is a directory name and COPY-CONTENTS 5547 ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
5548 ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. 5548 ;; create NEWNAME if it is not already a directory;
5549 ((not copy-contents) 5549 ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
5550 (setq newname (concat newname 5550 ((if copy-contents
5551 (file-name-nondirectory directory))) 5551 (or parents (not (file-directory-p newname)))
5552 (and (file-exists-p newname) 5552 (setq newname (concat newname
5553 (not (file-directory-p newname)) 5553 (file-name-nondirectory directory))))
5554 (error "Cannot overwrite non-directory %s with a directory" 5554 (make-directory (directory-file-name newname) parents)))
5555 newname))
5556 (make-directory newname t)))
5557 5555
5558 ;; Copy recursively. 5556 ;; Copy recursively.
5559 (dolist (file 5557 (dolist (file
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index ef216c3f34a..3117ea697ec 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -393,5 +393,16 @@ name (Bug#28412)."
393 (should (null (save-buffer))) 393 (should (null (save-buffer)))
394 (should (eq (buffer-size) 1)))))) 394 (should (eq (buffer-size) 1))))))
395 395
396(ert-deftest files-tests--copy-directory ()
397 (let* ((dir (make-temp-file "files-mkdir-test" t))
398 (dirname (file-name-as-directory dir))
399 (source (concat dirname "source"))
400 (dest (concat dirname "dest/new/directory/"))
401 (file (concat (file-name-as-directory source) "file")))
402 (make-directory source)
403 (write-region "" nil file)
404 (copy-directory source dest t t t)
405 (should (file-exists-p (concat dest "file")))))
406
396(provide 'files-tests) 407(provide 'files-tests)
397;;; files-tests.el ends here 408;;; files-tests.el ends here