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.

diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 1ae47a92f83dcaf614ed4d121f61baccbd189df4..79333705c5913cb4d4cce22adaeb6219292e52bb 100644 (file)
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -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)

diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 387786ced06e7d521c12f32f8675b57e2aadc9f1..6fbc1b0a8bdc78d1ec9cf7ada0b5b80a65eedffe 100644 (file)
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -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)))))