diff options
| -rw-r--r-- | test/lisp/dired-tests.el | 25 | ||||
| -rw-r--r-- | test/lisp/vc/ediff-ptch-tests.el | 48 |
2 files changed, 49 insertions, 24 deletions
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 1ae47a92f83..79333705c59 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el | |||
| @@ -54,6 +54,7 @@ | |||
| 54 | (when (buffer-live-p buf) (kill-buffer buf))) | 54 | (when (buffer-live-p buf) (kill-buffer buf))) |
| 55 | (delete-directory dir 'recursive)))) | 55 | (delete-directory dir 'recursive)))) |
| 56 | 56 | ||
| 57 | (defvar dired-dwim-target) | ||
| 57 | (ert-deftest dired-test-bug25609 () | 58 | (ert-deftest dired-test-bug25609 () |
| 58 | "Test for http://debbugs.gnu.org/25609 ." | 59 | "Test for http://debbugs.gnu.org/25609 ." |
| 59 | (let* ((from (make-temp-file "foo" 'dir)) | 60 | (let* ((from (make-temp-file "foo" 'dir)) |
| @@ -67,20 +68,30 @@ | |||
| 67 | :override | 68 | :override |
| 68 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) | 69 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) |
| 69 | '((name . "advice-dired-query"))) | 70 | '((name . "advice-dired-query"))) |
| 70 | (advice-add 'completing-read ; Just return init. | 71 | (advice-add 'completing-read ; Don't prompt me: just return init. |
| 71 | :override | 72 | :override |
| 72 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) | 73 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) |
| 73 | init) | 74 | init) |
| 74 | '((name . "advice-completing-read"))) | 75 | '((name . "advice-completing-read"))) |
| 76 | (delete-other-windows) ; We don't want to display any other dired buffers. | ||
| 75 | (push (dired to) buffers) | 77 | (push (dired to) buffers) |
| 76 | (push (dired-other-window temporary-file-directory) buffers) | 78 | (push (dired-other-window temporary-file-directory) buffers) |
| 77 | (dired-goto-file from) | ||
| 78 | (dired-do-copy) | ||
| 79 | (dired-do-copy); Again. | ||
| 80 | (unwind-protect | 79 | (unwind-protect |
| 81 | (progn | 80 | (let ((ok-fn |
| 82 | (should (file-exists-p target)) | 81 | (lambda () |
| 83 | (should-not (file-exists-p nested))) | 82 | (let ((win-buffers (mapcar #'window-buffer (window-list)))) |
| 83 | (and (memq (car buffers) win-buffers) | ||
| 84 | (memq (cadr buffers) win-buffers)))))) | ||
| 85 | (dired-goto-file from) | ||
| 86 | ;; Right before `dired-do-copy' call, to reproduce the bug conditions, | ||
| 87 | ;; ensure we have windows displaying the two dired buffers. | ||
| 88 | (and (funcall ok-fn) (dired-do-copy)) | ||
| 89 | ;; Call `dired-do-copy' again: this must overwrite `target'; if the bug | ||
| 90 | ;; still exists, then it creates `nested' instead. | ||
| 91 | (when (funcall ok-fn) | ||
| 92 | (dired-do-copy) | ||
| 93 | (should (file-exists-p target)) | ||
| 94 | (should-not (file-exists-p nested)))) | ||
| 84 | (dolist (buf buffers) | 95 | (dolist (buf buffers) |
| 85 | (when (buffer-live-p buf) (kill-buffer buf))) | 96 | (when (buffer-live-p buf) (kill-buffer buf))) |
| 86 | (delete-directory from 'recursive) | 97 | (delete-directory from 'recursive) |
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index 387786ced06..6fbc1b0a8bd 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el | |||
| @@ -66,41 +66,55 @@ index 6a07f80..6e8e947 100644 | |||
| 66 | (write-region nil nil bar nil 'silent)) | 66 | (write-region nil nil bar nil 'silent)) |
| 67 | (call-process git-program nil `(:file ,patch) nil "diff") | 67 | (call-process git-program nil `(:file ,patch) nil "diff") |
| 68 | (call-process git-program nil nil nil "reset" "--hard" "HEAD") | 68 | (call-process git-program nil nil nil "reset" "--hard" "HEAD") |
| 69 | ;; Visit the diff file i.e., patch; extract from it the parts | ||
| 70 | ;; affecting just each of the files: store in patch-bar the part | ||
| 71 | ;; affecting 'bar', and in patch-qux the part affecting 'qux'. | ||
| 69 | (find-file patch) | 72 | (find-file patch) |
| 70 | (unwind-protect | 73 | (unwind-protect |
| 71 | (let* ((info | 74 | (let* ((info |
| 72 | (progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map)) | 75 | (progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map)) |
| 73 | (patch1 | 76 | (patch-bar |
| 74 | (buffer-substring-no-properties | 77 | (buffer-substring-no-properties |
| 75 | (car (nth 3 (car info))) | 78 | (car (nth 3 (car info))) |
| 76 | (car (nth 4 (car info))))) | 79 | (car (nth 4 (car info))))) |
| 77 | (patch2 | 80 | (patch-qux |
| 78 | (buffer-substring-no-properties | 81 | (buffer-substring-no-properties |
| 79 | (car (nth 3 (cadr info))) | 82 | (car (nth 3 (cadr info))) |
| 80 | (car (nth 4 (cadr info)))))) | 83 | (car (nth 4 (cadr info)))))) |
| 81 | ;; Apply both patches. | 84 | ;; Apply both patches. |
| 82 | (dolist (x (list (cons patch1 bar) (cons patch2 qux))) | 85 | (dolist (x (list (cons patch-bar bar) (cons patch-qux qux))) |
| 83 | (with-temp-buffer | 86 | (with-temp-buffer |
| 84 | (insert (car x)) | 87 | ;; Some windows variants require the option '--binary' |
| 85 | (call-process-region (point-min) | 88 | ;; in order to 'patch' create backup files. |
| 86 | (point-max) | 89 | (let ((opts (format "--backup%s" |
| 87 | ediff-patch-program | 90 | (if (memq system-type '(windows-nt ms-dos)) |
| 88 | nil nil nil | 91 | " --binary" "")))) |
| 89 | "-b" (cdr x)))) | 92 | (insert (car x)) |
| 90 | ;; Check backup files were saved correctly. | 93 | (call-process-region (point-min) |
| 94 | (point-max) | ||
| 95 | ediff-patch-program | ||
| 96 | nil nil nil | ||
| 97 | opts (cdr x))))) | ||
| 98 | ;; Check backup files were saved correctly; in Bug#26084 some | ||
| 99 | ;; of the backup files are overwritten with the actual content | ||
| 100 | ;; of the updated file. To ensure that the bug is fixed we just | ||
| 101 | ;; need to check that every backup file produced has different | ||
| 102 | ;; content that the current updated file. | ||
| 91 | (dolist (x (list qux bar)) | 103 | (dolist (x (list qux bar)) |
| 92 | (let ((backup | 104 | (let ((backup |
| 93 | (car | 105 | (car |
| 94 | (directory-files | 106 | (directory-files |
| 95 | tmpdir 'full | 107 | tmpdir 'full |
| 96 | (concat (file-name-nondirectory x) "."))))) | 108 | (concat (file-name-nondirectory x) "."))))) |
| 97 | (should-not | 109 | ;; Compare files only if the backup has being created. |
| 98 | (string= (with-temp-buffer | 110 | (when backup |
| 99 | (insert-file-contents x) | 111 | (should-not |
| 100 | (buffer-string)) | 112 | (string= (with-temp-buffer |
| 101 | (with-temp-buffer | 113 | (insert-file-contents x) |
| 102 | (insert-file-contents backup) | 114 | (buffer-string)) |
| 103 | (buffer-string)))))) | 115 | (with-temp-buffer |
| 116 | (insert-file-contents backup) | ||
| 117 | (buffer-string))))))) | ||
| 104 | (delete-directory tmpdir 'recursive) | 118 | (delete-directory tmpdir 'recursive) |
| 105 | (delete-file patch))))) | 119 | (delete-file patch))))) |
| 106 | 120 | ||