diff options
| author | Paul Eggert <eggert@cs.ucla.edu> | 2017-09-10 20:37:17 -0700 |
|---|---|---|
| committer | Paul Eggert <eggert@cs.ucla.edu> | 2017-09-10 20:38:19 -0700 |
| commit | cf9891e14e48a93bca2065fdd7998f5f677786dc (patch) | |
| tree | a4d310f7868b010342634c45f36964af33c91af7 /lisp/files.el | |
| parent | 01c885f21f343045783eb9ad1ff5f9b83d6cd789 (diff) | |
| download | emacs-cf9891e14e48a93bca2065fdd7998f5f677786dc.tar.gz | |
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.
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/lisp/files.el b/lisp/files.el index 43aec8173d9..85e649fbb59 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 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" |