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

Fix some make-directory bugs

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

31
lisp/files.el
View file

@ -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
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"

21
test/lisp/files-tests.el
View file

@ -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