[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master cf9891e: Fix some make-directory bugs
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master cf9891e: Fix some make-directory bugs |
Date: |
Sun, 10 Sep 2017 23:38:25 -0400 (EDT) |
branch: master
commit cf9891e14e48a93bca2065fdd7998f5f677786dc
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
Fix some make-directory bugs
* lisp/files.el (files--ensure-directory): New function.
(make-directory): Use it to avoid bugs when (make-directory FOO t)
is invoked on a non-directory, or on a directory hierarchy that
is being built by some other process while Emacs is running.
* test/lisp/files-tests.el (files-tests--make-directory): New test.
---
lisp/files.el | 31 ++++++++++++++++++++-----------
test/lisp/files-tests.el | 21 +++++++++++++++++++++
2 files changed, 41 insertions(+), 11 deletions(-)
diff --git a/lisp/files.el b/lisp/files.el
index 43aec81..85e649f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5320,6 +5320,14 @@ instance of such commands."
(rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
+(defun files--ensure-directory (dir)
+ "Make directory DIR if it is not already a directory. Return nil."
+ (condition-case err
+ (make-directory-internal dir)
+ (file-already-exists
+ (unless (file-directory-p dir)
+ (signal (car err) (cdr err))))))
+
(defun make-directory (dir &optional parents)
"Create the directory DIR and optionally any nonexistent parent dirs.
If DIR already exists as a directory, signal an error, unless
@@ -5348,18 +5356,19 @@ raised."
(if (not parents)
(make-directory-internal dir)
(let ((dir (directory-file-name (expand-file-name dir)))
- create-list)
- (while (and (not (file-exists-p dir))
- ;; If directory is its own parent, then we can't
- ;; keep looping forever
- (not (equal dir
- (directory-file-name
- (file-name-directory dir)))))
+ create-list parent)
+ (while (progn
+ (setq parent (directory-file-name
+ (file-name-directory dir)))
+ (condition-case err
+ (files--ensure-directory dir)
+ (file-missing
+ ;; Do not loop if root does not exist (Bug#2309).
+ (not (string= dir parent)))))
(setq create-list (cons dir create-list)
- dir (directory-file-name (file-name-directory dir))))
- (while create-list
- (make-directory-internal (car create-list))
- (setq create-list (cdr create-list))))))))
+ dir parent))
+ (dolist (dir create-list)
+ (files--ensure-directory dir)))))))
(defconst directory-files-no-dot-files-regexp
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index a2f2b74..b52965a 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -344,6 +344,27 @@ be invoked with the right arguments."
(cdr path-res)
(insert-directory-wildcard-in-dir-p (car path-res)))))))
+(ert-deftest files-tests--make-directory ()
+ (let* ((dir (make-temp-file "files-mkdir-test" t))
+ (dirname (file-name-as-directory dir))
+ (file (concat dirname "file"))
+ (subdir1 (concat dirname "subdir1"))
+ (subdir2 (concat dirname "subdir2"))
+ (a/b (concat dirname "a/b")))
+ (write-region "" nil file)
+ (should-error (make-directory "/"))
+ (should-not (make-directory "/" t))
+ (should-error (make-directory dir))
+ (should-not (make-directory dir t))
+ (should-error (make-directory dirname))
+ (should-not (make-directory dirname t))
+ (should-error (make-directory file))
+ (should-error (make-directory file t))
+ (should-not (make-directory subdir1))
+ (should-not (make-directory subdir2 t))
+ (should-error (make-directory a/b))
+ (should-not (make-directory a/b t))))
+
(provide 'files-tests)
;;; files-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master cf9891e: Fix some make-directory bugs,
Paul Eggert <=