From 704fd2a7ae5087f4108cc7a821f856fcdac99eb4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 18 Oct 2016 09:36:03 -0700 Subject: [PATCH] delete-directory no longer errors when racing Problem reported by Glenn Morris for package-test.el (Bug#24714). * doc/lispref/files.texi (Create/Delete Dirs), etc/NEWS: Document this. * lisp/files.el (files--force): New function. (delete-directory): Use it to avoid error in this case. --- doc/lispref/files.texi | 3 +++ etc/NEWS | 5 +++++ lisp/files.el | 46 ++++++++++++++++++++++++++++-------------- 3 files changed, 39 insertions(+), 15 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 9af5ce967c2..62e0199f1ff 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2855,6 +2855,9 @@ This command deletes the directory named @var{dirname}. The function must use @code{delete-directory} for them. If @var{recursive} is @code{nil}, and the directory contains any files, @code{delete-directory} signals an error. +If recursive is non-@code{nil}, there is no error merely because the +directory or its files are deleted by some other process before +@code{delete-directory} gets to them. @code{delete-directory} only follows symbolic links at the level of parent directories. diff --git a/etc/NEWS b/etc/NEWS index 1fd2a00b3f9..c5245bcd18b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -619,6 +619,11 @@ collection). ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. ++++ +** The function 'delete-directory' no longer signals an error when +operating recursively and when some other process deletes the directory +or its files before 'delete-directory' gets to them. + ** Changes in Frame- and Window- Handling +++ diff --git a/lisp/files.el b/lisp/files.el index f481b9967c4..12c6c14d534 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5336,14 +5336,26 @@ raised." "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" "Regexp matching any file name except \".\" and \"..\".") +(defun files--force (no-such fn &rest args) + "Use NO-SUCH to affect behavior of function FN applied to list ARGS. +This acts like (apply FN ARGS) except it returns NO-SUCH if it is +non-nil and if FN fails due to a missing file or directory." + (condition-case err + (apply fn args) + (file-error + (or (pcase err (`(,_ ,_ "No such file or directory" . ,_) no-such)) + (signal (car err) (cdr err)))))) + (defun delete-directory (directory &optional recursive trash) "Delete the directory named DIRECTORY. Does not follow symlinks. -If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well. +If RECURSIVE is non-nil, delete files in DIRECTORY as well, with +no error if something else is simultaneously deleting them. TRASH non-nil means to trash the directory instead, provided `delete-by-moving-to-trash' is non-nil. -When called interactively, TRASH is t if no prefix argument is -given. With a prefix argument, TRASH is nil." +When called interactively, TRASH is nil if and only if a prefix +argument is given, and a further prompt asks the user for +RECURSIVE if DIRECTORY is nonempty." (interactive (let* ((trashing (and delete-by-moving-to-trash (null current-prefix-arg))) @@ -5381,18 +5393,22 @@ given. With a prefix argument, TRASH is nil." (move-file-to-trash directory))) ;; Otherwise, call ourselves recursively if needed. (t - (if (and recursive (not (file-symlink-p directory))) - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file recursive nil) - (delete-file file nil))) - ;; We do not want to delete "." and "..". - (directory-files - directory 'full directory-files-no-dot-files-regexp))) - (delete-directory-internal directory))))) + (when (or (not recursive) (file-symlink-p directory) + (let* ((files + (files--force t #'directory-files directory 'full + directory-files-no-dot-files-regexp)) + (directory-exists (listp files))) + (when directory-exists + (mapc (lambda (file) + ;; This test is equivalent to but more efficient + ;; than (and (file-directory-p fn) + ;; (not (file-symlink-p fn))). + (if (eq t (car (file-attributes file))) + (delete-directory file recursive) + (files--force t #'delete-file file))) + files)) + directory-exists)) + (files--force recursive #'delete-directory-internal directory)))))) (defun file-equal-p (file1 file2) "Return non-nil if files FILE1 and FILE2 name the same file. -- 2.39.5