From: Po Lu via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: "Mattias Engdegård" <mattias.engdegard@gmail.com>
Cc: 65143@debbugs.gnu.org
Subject: bug#65143: dired-aux-tests and kmacro-tests failures on master
Date: Tue, 08 Aug 2023 17:42:53 +0800 [thread overview]
Message-ID: <87leelzx7m.fsf@yahoo.com> (raw)
In-Reply-To: <34C2C701-56AF-4132-A005-BEFDAB30F041@gmail.com> ("Mattias Engdegård"'s message of "Tue, 8 Aug 2023 11:26:38 +0200")
Mattias Engdegård <mattias.engdegard@gmail.com> writes:
> Currently (eeda9eff1a) on master:
>
> FAILED dired-test-bug30624
> FAILED kmacro-tests-step-edit-append
> FAILED kmacro-tests-step-edit-replace
>
> from dired-aux-tests and macro-tests respectively.
>
> Most likely suspects are the recent Android merge and the unprompted delete-file changes, but I really have no idea.
Does this change fix the Dired test?
I suspect the test itself is wrong; the doc string of
dired-do-create-files mentions nothing about its return value, which the
test asserts against:
(dired-mark-files-regexp "bug30624_file")
(should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil))) <===============
(delete-directory target-dir 'recursive)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 3e8b4c3c8fc..825e25c09ed 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2480,87 +2480,88 @@ dired-do-create-files
For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
- (let* ((fn-list (dired-get-marked-files nil arg nil nil t))
- (rfn-list (mapcar #'dired-make-relative fn-list))
- (dired-one-file ; fluid variable inside dired-create-files
- (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
- (target-dir (dired-dwim-target-directory))
- (default (and dired-one-file
- (not dired-dwim-target) ; Bug#25609
- (expand-file-name (file-name-nondirectory (car fn-list))
- target-dir)))
- (defaults (dired-dwim-target-defaults fn-list target-dir))
- (target (expand-file-name ; fluid variable inside dired-create-files
- (minibuffer-with-setup-hook
- (lambda ()
- (setq-local minibuffer-default-add-function nil)
- (setq minibuffer-default defaults))
- (dired-mark-read-file-name
- (format "%s %%s %s: "
- (if dired-one-file op1 operation)
- (if (memq op-symbol '(symlink hardlink))
- ;; Linking operations create links
- ;; from the prompted file name; the
- ;; other operations copy (etc) to the
- ;; prompted file name.
- "from" "to"))
- target-dir op-symbol arg rfn-list default))))
- (into-dir
- (progn
- (when
- (or
- (not dired-one-file)
- (and dired-create-destination-dirs-on-trailing-dirsep
- (directory-name-p target)))
- (dired-maybe-create-dirs target))
- (cond ((null how-to)
- ;; Allow users to change the letter case of
- ;; a directory on a case-insensitive
- ;; filesystem. If we don't test these
- ;; conditions up front, file-directory-p
- ;; below will return t on a case-insensitive
- ;; filesystem, and Emacs will try to move
- ;; foo -> foo/foo, which fails.
- (if (and (file-name-case-insensitive-p (car fn-list))
- (eq op-symbol 'move)
- dired-one-file
- (string= (downcase
- (expand-file-name (car fn-list)))
- (downcase
- (expand-file-name target)))
- (not (string=
- (file-name-nondirectory (car fn-list))
- (file-name-nondirectory target))))
- nil
- (file-directory-p target)))
- ((eq how-to t) nil)
- (t (funcall how-to target))))))
- (if (and (consp into-dir) (functionp (car into-dir)))
- (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
- (if (not (or dired-one-file into-dir))
- (error "Marked %s: target must be a directory: %s" operation target))
- (if (and (not (file-directory-p (car fn-list)))
- (not (file-directory-p target))
- (directory-name-p target))
- (error "%s: Target directory does not exist: %s" operation target))
- ;; rename-file bombs when moving directories unless we do this:
- (or into-dir (setq target (directory-file-name target)))
- (prog1
- (dired-create-files
- file-creator operation fn-list
- (if into-dir ; target is a directory
- ;; This function uses fluid variable target when called
- ;; inside dired-create-files:
- (lambda (from)
- (expand-file-name (file-name-nondirectory from) target))
- (lambda (_from) target))
- marker-char)
- (when (or (eq dired-do-revert-buffer t)
- (and (functionp dired-do-revert-buffer)
- (funcall dired-do-revert-buffer target)))
- (dired-fun-in-all-buffers (file-name-directory target) nil
- #'revert-buffer)))))
- (dired-post-do-command))
+ (prog1
+ (let* ((fn-list (dired-get-marked-files nil arg nil nil t))
+ (rfn-list (mapcar #'dired-make-relative fn-list))
+ (dired-one-file ; fluid variable inside dired-create-files
+ (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
+ (target-dir (dired-dwim-target-directory))
+ (default (and dired-one-file
+ (not dired-dwim-target) ; Bug#25609
+ (expand-file-name (file-name-nondirectory (car fn-list))
+ target-dir)))
+ (defaults (dired-dwim-target-defaults fn-list target-dir))
+ (target (expand-file-name ; fluid variable inside dired-create-files
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-default-add-function nil)
+ (setq minibuffer-default defaults))
+ (dired-mark-read-file-name
+ (format "%s %%s %s: "
+ (if dired-one-file op1 operation)
+ (if (memq op-symbol '(symlink hardlink))
+ ;; Linking operations create links
+ ;; from the prompted file name; the
+ ;; other operations copy (etc) to the
+ ;; prompted file name.
+ "from" "to"))
+ target-dir op-symbol arg rfn-list default))))
+ (into-dir
+ (progn
+ (when
+ (or
+ (not dired-one-file)
+ (and dired-create-destination-dirs-on-trailing-dirsep
+ (directory-name-p target)))
+ (dired-maybe-create-dirs target))
+ (cond ((null how-to)
+ ;; Allow users to change the letter case of
+ ;; a directory on a case-insensitive
+ ;; filesystem. If we don't test these
+ ;; conditions up front, file-directory-p
+ ;; below will return t on a case-insensitive
+ ;; filesystem, and Emacs will try to move
+ ;; foo -> foo/foo, which fails.
+ (if (and (file-name-case-insensitive-p (car fn-list))
+ (eq op-symbol 'move)
+ dired-one-file
+ (string= (downcase
+ (expand-file-name (car fn-list)))
+ (downcase
+ (expand-file-name target)))
+ (not (string=
+ (file-name-nondirectory (car fn-list))
+ (file-name-nondirectory target))))
+ nil
+ (file-directory-p target)))
+ ((eq how-to t) nil)
+ (t (funcall how-to target))))))
+ (if (and (consp into-dir) (functionp (car into-dir)))
+ (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
+ (if (not (or dired-one-file into-dir))
+ (error "Marked %s: target must be a directory: %s" operation target))
+ (if (and (not (file-directory-p (car fn-list)))
+ (not (file-directory-p target))
+ (directory-name-p target))
+ (error "%s: Target directory does not exist: %s" operation target))
+ ;; rename-file bombs when moving directories unless we do this:
+ (or into-dir (setq target (directory-file-name target)))
+ (prog1
+ (dired-create-files
+ file-creator operation fn-list
+ (if into-dir ; target is a directory
+ ;; This function uses fluid variable target when called
+ ;; inside dired-create-files:
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target))
+ (lambda (_from) target))
+ marker-char)
+ (when (or (eq dired-do-revert-buffer t)
+ (and (functionp dired-do-revert-buffer)
+ (funcall dired-do-revert-buffer target)))
+ (dired-fun-in-all-buffers (file-name-directory target) nil
+ #'revert-buffer)))))
+ (dired-post-do-command)))
;; Read arguments for a marked-files command that wants a file name,
;; perhaps popping up the list of marked files.
next prev parent reply other threads:[~2023-08-08 9:42 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-08-08 9:26 bug#65143: dired-aux-tests and kmacro-tests failures on master Mattias Engdegård
2023-08-08 9:42 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2023-08-08 10:32 ` Mattias Engdegård
2023-08-08 10:42 ` Mattias Engdegård
2023-09-15 12:28 ` Stefan Kangas
2023-09-15 12:29 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-09-15 12:34 ` Stefan Kangas
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=87leelzx7m.fsf@yahoo.com \
--to=bug-gnu-emacs@gnu.org \
--cc=65143@debbugs.gnu.org \
--cc=luangruo@yahoo.com \
--cc=mattias.engdegard@gmail.com \
/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.