From: Lars Ingebrigtsen <larsi@gnus.org>
To: Filipp Gunbin <fgunbin@fastmail.fm>
Cc: 26028@debbugs.gnu.org, Arseny Sher <sher-ars@yandex.ru>,
Tino Calancha <tino.calancha@gmail.com>,
Michael Heerdegen <michael_heerdegen@web.de>,
Stefan Kangas <stefan@marxist.se>,
Kaushal Modi <kaushal.modi@gmail.com>
Subject: bug#26028: 26.0.50; epatch for multifile patches
Date: Thu, 24 Mar 2022 09:34:01 +0100 [thread overview]
Message-ID: <87ils3696u.fsf@gnus.org> (raw)
In-Reply-To: <8735s5dwcm.fsf@gnus.org> (Lars Ingebrigtsen's message of "Fri, 23 Jul 2021 14:54:17 +0200")
[-- Attachment #1: Type: text/plain, Size: 342 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Did you get any further here?
I forgot that the patch no longer applied. I've respun it now, but
somewhat unsure of how the changes to ediff-fixup-patch-map should be
adjusted to the patch.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ediff.patch --]
[-- Type: text/x-diff, Size: 14112 bytes --]
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 17654f80ec..db39368397 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -217,10 +217,10 @@ ediff-map-patch-buffer
;; (filename-from-1st-header-line . filename-from-2nd-line)
(setq possible-file-names
(cons (if (and beg1 end1)
- (buffer-substring beg1 end1)
+ (buffer-substring-no-properties beg1 end1)
null-device)
(if (and beg2 end2)
- (buffer-substring beg2 end2)
+ (buffer-substring-no-properties beg2 end2)
null-device)))
;; Remove file junk (Bug#26084).
(while (re-search-backward
@@ -285,31 +285,42 @@ ediff-fixup-patch-map
(or (file-name-directory (cdr proposed-file-names))
""))
)
- ;; If both base-dir1 and base-dir2 are relative and exist,
- ;; assume that
- ;; these dirs lead to the actual files starting at the present
- ;; directory. So, we don't strip these relative dirs from the
- ;; file names. This is a heuristic intended to improve guessing
(let ((default-directory (file-name-directory filename)))
- (unless (or (file-name-absolute-p base-dir1)
- (file-name-absolute-p base-dir2))
- (if (and (file-exists-p base-dir1)
- (file-exists-p base-dir2))
- (setq base-dir1 ""
- base-dir2 "")
- ;; Strip possible source/destination prefixes
- ;; such as a/ and b/ from dir names.
- (save-match-data
- (let ((m1 (when (string-match "^[^/]+/" base-dir1)
- (cons (substring base-dir1 0 (match-end 0))
- (substring base-dir1 (match-end 0)))))
- (m2 (when (string-match "^[^/]+/" base-dir2)
- (cons (substring base-dir2 0 (match-end 0))
- (substring base-dir2 (match-end 0))))))
- (when (and (file-exists-p (cdr m1))
- (file-exists-p (cdr m2)))
- (setq base-dir1 (car m1)
- base-dir2 (car m2))))))))
+ (cond
+ (multi-patch-p
+ ;; Git diffs appends 'a/' '/b' to the files.
+ (if (and (string-match-p "\\`a/" base-dir1)
+ (string-match-p "\\`b/" base-dir2))
+ (setq base-dir1 "a/" base-dir2 "b/")
+ (setq base-dir1 "" base-dir2 "")))
+ (t
+ ;; If both base-dir1 and base-dir2 are relative and
+ ;; exist, assume that these dirs lead to the actual
+ ;; files starting at the present directory. So, we
+ ;; don't strip these relative dirs from the file
+ ;; names. This is a heuristic intended to improve
+ ;; guessing
+ (unless (or (file-name-absolute-p base-dir1)
+ (file-name-absolute-p base-dir2))
+ (if (and (file-exists-p base-dir1)
+ (file-exists-p base-dir2))
+ (setq base-dir1 ""
+ base-dir2 "")
+ ;; Strip possible source/destination prefixes
+ ;; such as a/ and b/ from dir names.
+ (save-match-data
+ (let ((m1
+ (when (string-match "^[^/]+/" base-dir1)
+ (cons (substring base-dir1 0 (match-end 0))
+ (substring base-dir1 (match-end 0)))))
+ (m2
+ (when (string-match "^[^/]+/" base-dir2)
+ (cons (substring base-dir2 0 (match-end 0))
+ (substring base-dir2 (match-end 0))))))
+ (when (and (file-exists-p (cdr m1))
+ (file-exists-p (cdr m2)))
+ (setq base-dir1 (car m1)
+ base-dir2 (car m2))))))))))
(or (string= (car proposed-file-names) null-device)
(setcar proposed-file-names
(ediff-file-name-sans-prefix
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 840ab8cf51..e7ee36eb10 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -111,6 +111,7 @@ ediff-version
(require 'ediff-init)
(require 'ediff-mult) ; required because of the registry stuff
+(require 'diff-mode) ; diff-hunk-file-names
(defgroup ediff nil
"Comprehensive visual interface to `diff' and `patch'."
@@ -1412,6 +1413,7 @@ ediff-patch-default-directory
(declare-function ediff-dispatch-file-patching-job "ediff-ptch"
(patch-buf filename &optional startup-hooks))
+(defvar ediff-patch-map)
;;;###autoload
(defun ediff-patch-file (&optional arg patch-buf)
"Query for a file name, and then run Ediff by patching that file.
@@ -1433,11 +1435,26 @@ ediff-patch-file
(expand-file-name
(buffer-file-name patch-buf))))
(t default-directory)))
- (setq source-file
- (read-file-name
- "File to patch (directory, if multifile patch): "
- ;; use an explicit initial file
- source-dir nil nil (ediff-get-default-file-name)))
+ (let ((multi-patch-p (with-current-buffer patch-buf (cdr ediff-patch-map))))
+ (cond ((not multi-patch-p)
+ (let* ((files (with-current-buffer patch-buf
+ (diff-hunk-file-names 'old-first)))
+ (def (if (and (string-match "\\`a/" (car files))
+ (string-match "\\`b/" (cadr files)))
+ (expand-file-name
+ (substring-no-properties (car files) 2)
+ default-directory)
+ (car files))))
+ (setq source-file
+ (read-file-name
+ "Single file to patch: "
+ ;; use an explicit initial file
+ source-dir nil 'mustmatch def))))
+ (t ; multi-patch
+ (setq source-file
+ (read-file-name
+ "Directory to patch, use root project dir: "
+ source-dir)))))
(ediff-dispatch-file-patching-job patch-buf source-file)))
(declare-function ediff-patch-buffer-internal "ediff-ptch"
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 935046198f..7f143fe139 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -24,6 +24,8 @@
(require 'ert)
(require 'ert-x)
(require 'ediff-ptch)
+(require 'ediff-diff) ; For `ediff-diff-program'.
+(eval-when-compile (require 'cl-lib))
(ert-deftest ediff-ptch-test-bug25010 ()
"Test for https://debbugs.gnu.org/25010 ."
@@ -118,6 +120,151 @@ ediff-ptch-test-bug26084
(insert-file-contents backup)
(buffer-string))))))))))))
+(ert-deftest ediff-ptch-test-bug26028 ()
+ "Test for http://debbugs.gnu.org/26028 ."
+ (skip-unless (executable-find "git"))
+ (skip-unless (executable-find ediff-patch-program))
+ (skip-unless (executable-find ediff-diff-program))
+ (let ((git-program (executable-find "git"))
+ (default-dir default-directory)
+ tmpdir buffers)
+ ;;; Simple patch: old/src/hello.c /new/src/hello.c
+ (unwind-protect
+ (let* ((dir (make-temp-file "multipatch-test" t))
+ (file1 (expand-file-name "old/src/hello.c" dir))
+ (file2 (expand-file-name "new/src/hello.c" dir))
+ (patch (expand-file-name "tmp.patch" dir))
+ (default-directory (file-name-as-directory dir)))
+ (setq tmpdir dir)
+ (make-directory (expand-file-name "old/src/" dir) 'parents)
+ (make-directory (expand-file-name "new/src/" dir) 'parents)
+ (with-temp-buffer
+ (insert "void main() { }\n")
+ (write-region nil nil file1 nil 'silent)
+ (erase-buffer)
+ (insert "int main() { return 0; }\n")
+ (write-region nil nil file2 nil 'silent)
+ (erase-buffer)
+ (call-process ediff-diff-program nil t nil "-cr" "old" "new")
+ (write-region nil nil patch nil 'silent)
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (x) nil))
+ ((symbol-function 'ediff-prompt-for-patch-file)
+ (lambda (&rest x) (find-file-noselect patch)))
+ ((symbol-function 'read-file-name) (lambda (x1 x2 x3 x4 x5) x5))
+ ((symbol-function 'ediff-dispatch-file-patching-job)
+ (lambda (x y) y)))
+ (should (equal (file-relative-name file1) (epatch nil patch)))
+ (push (get-file-buffer patch) buffers))))
+ (when (file-exists-p tmpdir)
+ (setq default-directory default-dir)
+ (delete-directory tmpdir 'recursive))
+ (mapc (lambda (b)
+ (when (buffer-live-p b) (kill-buffer b)))
+ buffers)
+ (setq buffers nil))
+ ;;; Simple Git patch: proj/src/hello.c
+ (unwind-protect
+ (let* ((dir (make-temp-file "multipatch-test" t))
+ (rootdir (expand-file-name "proj/src/" dir))
+ (file (expand-file-name "hello.c" rootdir))
+ (patch (expand-file-name "tmp.patch" dir))
+ (default-directory (file-name-as-directory rootdir)))
+ (make-directory rootdir 'parents)
+ (setq tmpdir dir)
+ (with-temp-buffer
+ (insert "void main() { }\n")
+ (write-region nil nil file nil 'silent)
+ (call-process git-program nil nil nil "init")
+ (call-process git-program nil nil nil "add" ".")
+ (call-process git-program nil nil nil "commit" "-m" "test repository.")
+ (erase-buffer)
+ (insert "int main() { return 0; }\n")
+ (write-region nil nil file nil 'silent)
+ (call-process git-program nil `(:file ,patch) nil "diff")
+ (call-process git-program nil nil nil "reset" "--hard" "head")
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (x) nil))
+ ((symbol-function 'ediff-prompt-for-patch-file)
+ (lambda (&rest x) (find-file-noselect patch)))
+ ((symbol-function 'read-file-name) (lambda (&rest x) file))
+ ((symbol-function 'read-file-name) (lambda (x1 x2 x3 x4 x5) x5))
+ ((symbol-function 'ediff-dispatch-file-patching-job)
+ (lambda (x y) y)))
+ (should (equal file (epatch nil patch)))))
+ (push (get-file-buffer patch) buffers))
+ ;; clean up
+ (when (file-exists-p tmpdir)
+ (setq default-directory default-dir)
+ (delete-directory tmpdir 'recursive))
+ (mapc (lambda (b)
+ (when (buffer-live-p b) (kill-buffer b)))
+ buffers)
+ (setq buffers nil))
+ ;;; Git multipatch.
+ (unwind-protect
+ (let* ((dir (make-temp-file "multipatch-test" t))
+ (file1 (expand-file-name "proj/src/hello.c" dir))
+ (file2 (expand-file-name "proj/src/bye.c" dir))
+ (file3 (expand-file-name "proj/lisp/foo.el" dir))
+ (file4 (expand-file-name "proj/lisp/bar.el" dir))
+ (file5 (expand-file-name "proj/etc/news" dir))
+ (patch (expand-file-name "tmp.patch" dir))
+ (default-directory (expand-file-name "proj" dir)))
+ (setq tmpdir dir)
+ (dolist (d '("src" "lisp" "etc"))
+ (setq rootdir (expand-file-name (concat "proj/" d) dir))
+ (make-directory rootdir 'parents))
+ (with-temp-buffer
+ (insert "void main() { }\n")
+ (write-region nil nil file1 nil 'silent)
+ (write-region nil nil file2 nil 'silent)
+ (erase-buffer)
+ (insert "(defun foo () nil)\n")
+ (write-region nil nil file3 nil 'silent)
+ (erase-buffer)
+ (insert "(defun bar () nil)\n")
+ (write-region nil nil file4 nil 'silent)
+ (erase-buffer)
+ (insert "new functions 'foo' and 'bar'\n")
+ (write-region nil nil file5 nil 'silent)
+ (call-process git-program nil nil nil "init")
+ (call-process git-program nil nil nil "add" "src" "lisp" "etc")
+ (call-process git-program nil nil nil "commit" "-m" "test repository.");)
+ (erase-buffer)
+ (insert "int main() { return 0;}\n")
+ (write-region nil nil file1 nil 'silent)
+ (write-region nil nil file2 nil 'silent)
+ (erase-buffer)
+ (insert "(defun qux () nil)\n")
+ (write-region nil nil file3 nil 'silent)
+ (erase-buffer)
+ (insert "(defun quux () nil)\n")
+ (write-region nil nil file4 nil 'silent)
+ (erase-buffer)
+ (insert "new functions 'qux' and 'quux'\n")
+ (write-region nil nil file5 nil 'silent)
+ (call-process git-program nil `(:file ,patch) nil "diff")
+ (call-process git-program nil nil nil "reset" "--hard" "head"))
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (x) nil))
+ ((symbol-function 'ediff-get-patch-file) (lambda (&rest x) patch))
+ ((symbol-function 'read-file-name) (lambda (&rest x) patch)))
+ (epatch nil patch)
+ (with-current-buffer "*Ediff Session Group Panel*"
+ (push (get-file-buffer patch) buffers)
+ (should (= 5 (length (cdr ediff-meta-list))))
+ ;; don't ask confirmation to exit.
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (x) t)))
+ (ediff-quit-meta-buffer)))))
+ ;; clean up
+ (when (file-exists-p tmpdir)
+ (setq default-directory default-dir)
+ (delete-directory tmpdir 'recursive))
+ (when ediff-registry-buffer
+ (push ediff-registry-buffer buffers))
+ (mapc (lambda (b)
+ (when (buffer-live-p b) (kill-buffer b)))
+ buffers)
+ (setq buffers nil))))
+
(provide 'ediff-ptch-tests)
;;; ediff-ptch-tests.el ends here
prev parent reply other threads:[~2022-03-24 8:34 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-03-08 17:29 bug#26028: 26.0.50; epatch for multifile patches Arseny Sher
2017-03-08 19:17 ` Eli Zaretskii
2017-03-08 21:53 ` Arseny Sher
2017-03-09 1:41 ` Tino Calancha
2017-03-09 11:44 ` Arseny Sher
2017-05-23 11:26 ` Tino Calancha
2017-05-23 22:45 ` Michael Heerdegen
2017-05-24 0:46 ` Tino Calancha
2020-08-11 7:34 ` Stefan Kangas
2020-10-03 22:25 ` Michael Heerdegen
2021-05-10 12:02 ` Lars Ingebrigtsen
2021-05-12 9:27 ` Michael Heerdegen
2021-05-13 16:29 ` Filipp Gunbin
2021-05-16 13:57 ` Lars Ingebrigtsen
2021-07-23 12:54 ` Lars Ingebrigtsen
2022-03-24 8:34 ` Lars Ingebrigtsen [this message]
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87ils3696u.fsf@gnus.org \
--to=larsi@gnus.org \
--cc=26028@debbugs.gnu.org \
--cc=fgunbin@fastmail.fm \
--cc=kaushal.modi@gmail.com \
--cc=michael_heerdegen@web.de \
--cc=sher-ars@yandex.ru \
--cc=stefan@marxist.se \
--cc=tino.calancha@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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).