mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-22 18:35:09 +00:00
Fix 2 tests that fail in MS-Windows
https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00018.html * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084): Add comments to explain the test logic. Pass '--binary' option to 'patch' program in windows environments. Check explicitely that a backup is created before compare file contents. * test/lisp/dired-tests.el (dired-test-bug25609): Declare variable 'dired-dwim-target' right before the test. Add comments to explain the test logic. Ensure, before test the bug condition, that we are displaying the 2 dired buffers created in this test, and no other dired buffer is shown.
This commit is contained in:
Tino Calancha
parent
28e000435e
commit
db5d38ddb0
@ -54,6 +54,7 @@
|
||||
(when (buffer-live-p buf) (kill-buffer buf)))
|
||||
(delete-directory dir 'recursive))))
|
||||
|
||||
(defvar dired-dwim-target)
|
||||
(ert-deftest dired-test-bug25609 ()
|
||||
"Test for http://debbugs.gnu.org/25609 ."
|
||||
(let* ((from (make-temp-file "foo" 'dir))
|
||||
@ -67,20 +68,30 @@
|
||||
:override
|
||||
(lambda (_sym _prompt &rest _args) (setq dired-query t))
|
||||
'((name . "advice-dired-query")))
|
||||
(advice-add 'completing-read ; Just return init.
|
||||
(advice-add 'completing-read ; Don't prompt me: just return init.
|
||||
:override
|
||||
(lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap)
|
||||
init)
|
||||
'((name . "advice-completing-read")))
|
||||
(delete-other-windows) ; We don't want to display any other dired buffers.
|
||||
(push (dired to) buffers)
|
||||
(push (dired-other-window temporary-file-directory) buffers)
|
||||
(dired-goto-file from)
|
||||
(dired-do-copy)
|
||||
(dired-do-copy); Again.
|
||||
(unwind-protect
|
||||
(progn
|
||||
(should (file-exists-p target))
|
||||
(should-not (file-exists-p nested)))
|
||||
(let ((ok-fn
|
||||
(lambda ()
|
||||
(let ((win-buffers (mapcar #'window-buffer (window-list))))
|
||||
(and (memq (car buffers) win-buffers)
|
||||
(memq (cadr buffers) win-buffers))))))
|
||||
(dired-goto-file from)
|
||||
;; Right before `dired-do-copy' call, to reproduce the bug conditions,
|
||||
;; ensure we have windows displaying the two dired buffers.
|
||||
(and (funcall ok-fn) (dired-do-copy))
|
||||
;; Call `dired-do-copy' again: this must overwrite `target'; if the bug
|
||||
;; still exists, then it creates `nested' instead.
|
||||
(when (funcall ok-fn)
|
||||
(dired-do-copy)
|
||||
(should (file-exists-p target))
|
||||
(should-not (file-exists-p nested))))
|
||||
(dolist (buf buffers)
|
||||
(when (buffer-live-p buf) (kill-buffer buf)))
|
||||
(delete-directory from 'recursive)
|
||||
|
||||
@ -66,41 +66,55 @@ index 6a07f80..6e8e947 100644
|
||||
(write-region nil nil bar nil 'silent))
|
||||
(call-process git-program nil `(:file ,patch) nil "diff")
|
||||
(call-process git-program nil nil nil "reset" "--hard" "HEAD")
|
||||
;; Visit the diff file i.e., patch; extract from it the parts
|
||||
;; affecting just each of the files: store in patch-bar the part
|
||||
;; affecting 'bar', and in patch-qux the part affecting 'qux'.
|
||||
(find-file patch)
|
||||
(unwind-protect
|
||||
(let* ((info
|
||||
(progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map))
|
||||
(patch1
|
||||
(patch-bar
|
||||
(buffer-substring-no-properties
|
||||
(car (nth 3 (car info)))
|
||||
(car (nth 4 (car info)))))
|
||||
(patch2
|
||||
(patch-qux
|
||||
(buffer-substring-no-properties
|
||||
(car (nth 3 (cadr info)))
|
||||
(car (nth 4 (cadr info))))))
|
||||
;; Apply both patches.
|
||||
(dolist (x (list (cons patch1 bar) (cons patch2 qux)))
|
||||
(dolist (x (list (cons patch-bar bar) (cons patch-qux qux)))
|
||||
(with-temp-buffer
|
||||
(insert (car x))
|
||||
(call-process-region (point-min)
|
||||
(point-max)
|
||||
ediff-patch-program
|
||||
nil nil nil
|
||||
"-b" (cdr x))))
|
||||
;; Check backup files were saved correctly.
|
||||
;; Some windows variants require the option '--binary'
|
||||
;; in order to 'patch' create backup files.
|
||||
(let ((opts (format "--backup%s"
|
||||
(if (memq system-type '(windows-nt ms-dos))
|
||||
" --binary" ""))))
|
||||
(insert (car x))
|
||||
(call-process-region (point-min)
|
||||
(point-max)
|
||||
ediff-patch-program
|
||||
nil nil nil
|
||||
opts (cdr x)))))
|
||||
;; Check backup files were saved correctly; in Bug#26084 some
|
||||
;; of the backup files are overwritten with the actual content
|
||||
;; of the updated file. To ensure that the bug is fixed we just
|
||||
;; need to check that every backup file produced has different
|
||||
;; content that the current updated file.
|
||||
(dolist (x (list qux bar))
|
||||
(let ((backup
|
||||
(car
|
||||
(directory-files
|
||||
tmpdir 'full
|
||||
(concat (file-name-nondirectory x) ".")))))
|
||||
(should-not
|
||||
(string= (with-temp-buffer
|
||||
(insert-file-contents x)
|
||||
(buffer-string))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents backup)
|
||||
(buffer-string))))))
|
||||
;; Compare files only if the backup has being created.
|
||||
(when backup
|
||||
(should-not
|
||||
(string= (with-temp-buffer
|
||||
(insert-file-contents x)
|
||||
(buffer-string))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents backup)
|
||||
(buffer-string)))))))
|
||||
(delete-directory tmpdir 'recursive)
|
||||
(delete-file patch)))))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user