From: Paul Eggert <eggert@cs.ucla.edu>
To: Eli Zaretskii <eliz@gnu.org>, Michael Albinus <michael.albinus@gmx.de>
Cc: thievol@posteo.net, 58919@debbugs.gnu.org
Subject: bug#58919: 28.2; dired-copy-file-recursive fails to overwrite directory
Date: Fri, 16 Dec 2022 15:22:16 -0800 [thread overview]
Message-ID: <fa1fc8c3-f12b-9094-853d-c4ec10b9163c@cs.ucla.edu> (raw)
In-Reply-To: <83zgbutdz5.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 630 bytes --]
On 12/11/22 02:46, Eli Zaretskii wrote:
> Paul, did you have an opportunity to come up with the patch you
> mentioned in this discussion? I'd like to solve this bug for Emacs
> 29, please.
I hacked on it for a bit and came up with the attached proposed patches
to the emacs-29 branch. I have not installed them.
These patches address the issues raised by Michael by passing only
single arguments to make-directory handlers. That way, we don't need to
worry about whether the handlers follow the new convention. At our
leisure, perhaps in Emacs 30, we can upgrade the make-directory handlers
to support the new convention.
[-- Attachment #2: 0001-Use-make-directory-handlers-uniformly.patch --]
[-- Type: text/x-patch, Size: 6565 bytes --]
From bfbb463c6e1b74c96211e454c80d8588f187dcfb Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:47 -0800
Subject: [PATCH 1/3] Use make-directory handlers uniformly
Formerly, the code supported both make-directory and
make-directory-internal handlers. This led to confusion and meant than
in a few cases (nnmaildir, ido) remote directories could not be used in
some cases. Fix this by using only make-directory handlers.
Perhaps there used to be a reason for why there were both
make-directory and make-directory-internal handlers, but whatever that
reason was, it seems to have vanished even before now.
There is no longer any need for make-directory-internal handlers, as
the few remaining callers that use make-directory-internal do so only
when there are no handlers. However, this change keeps the existing
make-directory-internal handlers for now, in case this code is ever
used in older Emacs versions that still call those handlers.
* lisp/gnus/nnmaildir.el (nnmaildir--mkdir):
* lisp/ido.el (ido-file-internal):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-directory):
Use make-directory, not make-directory-internal.
* lisp/net/tramp-smb.el (tramp-smb-handle-make-directory-internal):
Now obsolete.
* src/fileio.c (Fmake_directory_internal): Do not look for or
use a make-directory-internal handler.
* test/lisp/files-tests.el:
(files-tests-file-name-non-special-make-directory-internal):
Remove, as this test incorrectly assumes that make-directory-internal
must support handlers.
---
doc/lispref/files.texi | 2 --
etc/NEWS | 4 ++++
lisp/gnus/nnmaildir.el | 2 +-
lisp/ido.el | 2 +-
lisp/net/tramp-smb.el | 3 ++-
src/fileio.c | 5 -----
test/lisp/files-tests.el | 11 -----------
7 files changed, 8 insertions(+), 21 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 4b45d89f9d0..5bcbac6ceb8 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3378,7 +3378,6 @@ Magic File Names
@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-directory},
-@code{make-directory-internal},
@code{make-lock-file-name},
@code{make-nearby-temp-file},
@code{make-process},
@@ -3440,7 +3439,6 @@ Magic File Names
@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-direc@discretionary{}{}{}tory},
-@code{make-direc@discretionary{}{}{}tory-internal},
@code{make-lock-file-name},
@code{make-nearby-temp-file},
@code{make-process},
diff --git a/etc/NEWS b/etc/NEWS
index 157fe98c983..dbf1642206b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4477,6 +4477,10 @@ set is too big to transfer to Emacs every time a completion is
needed. The table uses new 'external' completion style exclusively
and cannot work with regular styles such as 'basic' or 'flex'.
++++
+** Magic file handlers for make-directory-internal are no longer needed.
+Instead, Emacs uses the already-existing make-directory handlers.
+
\f
* Changes in Emacs 29.1 on Non-Free Operating Systems
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index faa288934d1..3fb87f3a712 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -296,7 +296,7 @@ nnmaildir--unlink
(if (file-attributes file) (delete-file file))))
(defun nnmaildir--mkdir (dir)
(or (file-exists-p (file-name-as-directory dir))
- (make-directory-internal (directory-file-name dir))))
+ (make-directory (directory-file-name dir))))
(defun nnmaildir--mkfile (file)
(write-region "" nil file nil 'no-message))
(defun nnmaildir--delete-dir-files (dir ls)
diff --git a/lisp/ido.el b/lisp/ido.el
index 77e4dd447d8..92b4370cb45 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -2435,7 +2435,7 @@ ido-file-internal
filename))
(ido-record-command method dirname)
(ido-record-work-directory dirname)
- (make-directory-internal dirname)
+ (make-directory dirname)
(funcall method dirname))
(t
;; put make-directory command on history
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c720b33b5f2..24fff9bb495 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1186,12 +1186,13 @@ tramp-smb-handle-make-directory
(make-directory ldir parents))
;; Just do it.
(when (file-directory-p ldir)
- (make-directory-internal dir))
+ (make-directory dir))
(unless (file-directory-p dir)
(tramp-error v 'file-error "Couldn't make directory %s" dir)))))
(defun tramp-smb-handle-make-directory-internal (directory)
"Like `make-directory-internal' for Tramp files."
+ (declare (obsolete nil "29.1"))
(setq directory (directory-file-name (expand-file-name directory)))
(unless (file-name-absolute-p directory)
(setq directory (expand-file-name directory default-directory)))
diff --git a/src/fileio.c b/src/fileio.c
index 92335b639cd..835c42cc0a4 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2427,16 +2427,11 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
(Lisp_Object directory)
{
const char *dir;
- Lisp_Object handler;
Lisp_Object encoded_dir;
CHECK_STRING (directory);
directory = Fexpand_file_name (directory, Qnil);
- handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
- if (!NILP (handler))
- return call2 (handler, Qmake_directory_internal, directory);
-
encoded_dir = ENCODE_FILE (directory);
dir = SSDATA (encoded_dir);
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 682b5cdb449..efafb5583ac 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1038,17 +1038,6 @@ files-tests-file-name-non-special-make-directory
(let ((default-directory nospecial-dir))
(should-error (make-directory "dir")))))
-(ert-deftest files-tests-file-name-non-special-make-directory-internal ()
- (files-tests--with-temp-non-special (tmpdir nospecial-dir t)
- (let ((default-directory nospecial-dir))
- (make-directory-internal "dir")
- (should (file-directory-p "dir"))
- (delete-directory "dir")))
- (files-tests--with-temp-non-special-and-file-name-handler
- (tmpdir nospecial-dir t)
- (let ((default-directory nospecial-dir))
- (should-error (make-directory-internal "dir")))))
-
(ert-deftest files-tests-file-name-non-special-make-nearby-temp-file ()
(let* ((default-directory (file-name-quote temporary-file-directory))
(near-tmpfile (make-nearby-temp-file "file")))
--
2.38.1
[-- Attachment #3: 0002-make-directory-now-returns-t-if-dir-already-exists.patch --]
[-- Type: text/x-patch, Size: 6734 bytes --]
From b671e175372825c077ab4a1810e353845626c26a Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:48 -0800
Subject: [PATCH 2/3] make-directory now returns t if dir already exists
This new feature will help fix a copy-directory bug (Bug#58919).
Its implementation does not rely on make-directory handlers
supporting the new feature, as it no longer uses a make-directory
handler H in any way other than (funcall H DIR), thus using
only the intersection of the old and new behavior for handlers.
This will give us time to fix handlers at our leisure.
* lisp/files.el (files--ensure-directory): New arg MKDIR.
All uses changed.
(files--ensure-directory, make-directory):
Return non-nil if DIR is already a directory. All uses changed.
* test/lisp/files-tests.el (files-tests-make-directory):
Test new return-value convention.
---
doc/lispref/files.texi | 3 +++
etc/NEWS | 5 ++++
lisp/files.el | 58 +++++++++++++++++++++-------------------
test/lisp/files-tests.el | 6 ++---
4 files changed, 41 insertions(+), 31 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 5bcbac6ceb8..29d9e514c72 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3205,6 +3205,9 @@ Create/Delete Dirs
@var{parents} is non-@code{nil}, as is always the case in an
interactive call, that means to create the parent directories first,
if they don't already exist.
+As a function, @code{make-directory} returns non-@code{nil} if @var{dirname}
+already exists as a directory and @var{parents} is non-@code{nil},
+and returns @code{nil} if it successfully created @var{dirname}.
@code{mkdir} is an alias for this.
@end deffn
diff --git a/etc/NEWS b/etc/NEWS
index dbf1642206b..d59d61a9d25 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4481,6 +4481,11 @@ and cannot work with regular styles such as 'basic' or 'flex'.
** Magic file handlers for make-directory-internal are no longer needed.
Instead, Emacs uses the already-existing make-directory handlers.
++++
+** (make-directory DIR t) returns non-nil if DIR already exists.
+This can let a caller know whether it created DIR. Formerly,
+make-directory's return value was unspecified.
+
\f
* Changes in Emacs 29.1 on Non-Free Operating Systems
diff --git a/lisp/files.el b/lisp/files.el
index c74e7e808e4..235eacee704 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6193,18 +6193,17 @@ rename-uniquely
(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."
+(defun files--ensure-directory (mkdir dir)
+ "Use function MKDIR to make directory DIR if it is not already a directory.
+Return non-nil if DIR is already a directory."
(condition-case err
- (make-directory-internal dir)
+ (funcall mkdir dir)
(error
- (unless (file-directory-p dir)
- (signal (car err) (cdr err))))))
+ (or (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
-PARENTS is non-nil.
Interactively, the default choice of directory to create is the
current buffer's default directory. That is useful when you have
@@ -6214,8 +6213,9 @@ make-directory
non-nil, says whether to create parent directories that don't
exist. Interactively, this happens by default.
-If creating the directory or directories fail, an error will be
-raised."
+Return non-nil if PARENTS is non-nil and DIR already exists as a
+directory, and nil if DIR did not already exist but was created.
+Signal an error if unsuccessful."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
@@ -6223,25 +6223,27 @@ make-directory
;; If default-directory is a remote directory,
;; make sure we find its make-directory handler.
(setq dir (expand-file-name dir))
- (let ((handler (find-file-name-handler dir 'make-directory)))
- (if handler
- (funcall handler 'make-directory dir parents)
- (if (not parents)
- (make-directory-internal dir)
- (let ((dir (directory-file-name (expand-file-name dir)))
- create-list parent)
- (while (progn
- (setq parent (directory-file-name
- (file-name-directory dir)))
- (condition-case ()
- (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 parent))
- (dolist (dir create-list)
- (files--ensure-directory dir)))))))
+ (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory)))
+ #'(lambda (dir) (funcall handler 'make-directory dir))
+ #'make-directory-internal)))
+ (if (not parents)
+ (funcall mkdir dir)
+ (let ((dir (directory-file-name (expand-file-name dir)))
+ already-dir create-list parent)
+ (while (progn
+ (setq parent (directory-file-name
+ (file-name-directory dir)))
+ (condition-case ()
+ (ignore (setq already-dir
+ (files--ensure-directory mkdir dir)))
+ (error
+ ;; Do not loop if root does not exist (Bug#2309).
+ (not (string= dir parent)))))
+ (setq create-list (cons dir create-list)
+ dir parent))
+ (dolist (dir create-list)
+ (setq already-dir (files--ensure-directory mkdir dir)))
+ already-dir))))
(defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index efafb5583ac..b9fbeb8a4e0 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1261,11 +1261,11 @@ files-tests-make-directory
(a/b (concat dirname "a/b")))
(write-region "" nil file)
(should-error (make-directory "/"))
- (should-not (make-directory "/" t))
+ (should (make-directory "/" t))
(should-error (make-directory dir))
- (should-not (make-directory dir t))
+ (should (make-directory dir t))
(should-error (make-directory dirname))
- (should-not (make-directory dirname t))
+ (should (make-directory dirname t))
(should-error (make-directory file))
(should-error (make-directory file t))
(should-not (make-directory subdir1))
--
2.38.1
[-- Attachment #4: 0003-Fix-copy-directory-bug-when-dest-dir-exists.patch --]
[-- Type: text/x-patch, Size: 3944 bytes --]
From 5b6435e1e57ae0c20ce3078ac1fe97a7757c4ba7 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@penguin.cs.ucla.edu>
Date: Fri, 16 Dec 2022 14:55:48 -0800
Subject: [PATCH 3/3] Fix copy-directory bug when dest dir exists
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* lisp/files.el (copy-directory): Set ‘follow’ depending on
whether we made the directory, not based on a guess that is
sometimes wrong. When NEWNAME is a directory name and
COPY-CONTENTS is nil, do not object merely because the adjusted
NEWNAME is already a directory. (Bug#58919).
* test/lisp/files-tests.el (files-tests-copy-directory):
Test for the bug.
---
lisp/files.el | 19 ++++++++++++-------
test/lisp/files-tests.el | 9 ++++++++-
2 files changed, 20 insertions(+), 8 deletions(-)
diff --git a/lisp/files.el b/lisp/files.el
index 235eacee704..3cf7833ae02 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6437,7 +6437,7 @@ copy-directory
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory)))
- (follow parents))
+ follow)
(if handler
(funcall handler 'copy-directory directory
newname keep-time parents copy-contents)
@@ -6457,19 +6457,24 @@ copy-directory
t)
(make-symbolic-link target newname t)))
;; Else proceed to copy as a regular directory
- (cond ((not (directory-name-p newname))
+ ;; first by creating the destination directory if needed,
+ ;; preparing to follow any symlink to a directory we did not create.
+ (setq follow
+ (if (not (directory-name-p newname))
;; If NEWNAME is not a directory name, create it;
;; that is where we will copy the files of DIRECTORY.
- (make-directory newname parents))
+ (make-directory newname parents)
;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
;; create NEWNAME if it is not already a directory;
;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
- ((if copy-contents
- (or parents (not (file-directory-p newname)))
+ (unless copy-contents
(setq newname (concat newname
(file-name-nondirectory directory))))
- (make-directory (directory-file-name newname) parents))
- (t (setq follow t)))
+ (condition-case err
+ (make-directory (directory-file-name newname) parents)
+ (error
+ (or (file-directory-p newname)
+ (signal (car err) (cdr err)))))))
;; Copy recursively.
(dolist (file
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index b9fbeb8a4e0..011bfa67cc2 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1346,7 +1346,9 @@ files-tests-copy-directory
(dest (concat dirname "dest/new/directory/"))
(file (concat (file-name-as-directory source) "file"))
(source2 (concat dirname "source2"))
- (dest2 (concat dirname "dest/new2")))
+ (dest2 (concat dirname "dest/new2"))
+ (source3 (concat dirname "source3/d"))
+ (dest3 (concat dirname "dest3/d")))
(make-directory source)
(write-region "" nil file)
(copy-directory source dest t t t)
@@ -1354,6 +1356,11 @@ files-tests-copy-directory
(make-directory (concat (file-name-as-directory source2) "a") t)
(copy-directory source2 dest2)
(should (file-directory-p (concat (file-name-as-directory dest2) "a")))
+ (make-directory source3 t)
+ (write-region "x\n" nil (concat (file-name-as-directory source3) "file"))
+ (make-directory dest3 t)
+ (write-region "y\n" nil (concat (file-name-as-directory dest3) "file"))
+ (copy-directory source3 (file-name-directory dest3) t)
(delete-directory dir 'recursive))))
(ert-deftest files-tests-abbreviate-file-name-homedir ()
--
2.38.1
next prev parent reply other threads:[~2022-12-16 23:22 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-10-31 8:54 bug#58919: 28.2; dired-copy-file-recursive fails to overwrite directory Thierry Volpiatto
2022-10-31 13:01 ` Eli Zaretskii
2022-11-01 17:34 ` Thierry Volpiatto
2022-11-01 18:04 ` Paul Eggert
2022-11-01 18:09 ` Eli Zaretskii
2022-11-01 19:21 ` Michael Albinus
2022-12-11 10:46 ` Eli Zaretskii
2022-12-16 23:22 ` Paul Eggert [this message]
2022-12-17 8:04 ` Eli Zaretskii
2022-12-17 9:52 ` Michael Albinus
2022-12-17 10:40 ` Eli Zaretskii
2022-12-17 22:40 ` Paul Eggert
2022-12-18 19:35 ` Michael Albinus
2022-12-18 20:54 ` Paul Eggert
2022-12-23 10:26 ` Michael Albinus
2022-12-24 9:11 ` Paul Eggert
2022-12-24 10:13 ` Michael Albinus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=fa1fc8c3-f12b-9094-853d-c4ec10b9163c@cs.ucla.edu \
--to=eggert@cs.ucla.edu \
--cc=58919@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=michael.albinus@gmx.de \
--cc=thievol@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.