diff options
author | Tino Calancha <tino.calancha@gmail.com> | 2017-08-09 14:47:15 +0900 |
---|---|---|
committer | Tino Calancha <tino.calancha@gmail.com> | 2017-08-09 14:48:49 +0900 |
commit | da4438e14f1c55808937872b6d651a807404daa2 (patch) | |
tree | a7b3a8d1f8425b56071759d5b3507e1378afa585 /test/lisp/dired-tests.el | |
parent | 9ecbdeeaa845a75c63210057a8a554eedc9387bf (diff) | |
download | emacs-da4438e14f1c55808937872b6d651a807404daa2.tar.gz |
dired-delete-file: Dont't ask for empty dirs
* lisp/dired.el (dired--yes-no-all-quit-help): New defun.
(dired-delete-file): Use it. Dont't ask for empty dirs (Bug#27940).
* test/lisp/dired-tests.el (dired-test-with-temp-dirs):
New auxiliar macro.
(dired-test-bug27940): Add new test.
Diffstat (limited to 'test/lisp/dired-tests.el')
-rw-r--r-- | test/lisp/dired-tests.el | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 981afdd929e..3c460d0151e 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -358,5 +358,90 @@ (should (equal "subdir" (dired-get-filename 'local t)))) (delete-directory top-dir t)))) + +(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body) + "Helper macro for Bug#27940 test." + (declare (indent 1) (debug body)) + (let ((dir (make-symbol "dir")) + (ignore-funcs (make-symbol "ignore-funcs"))) + `(let* ((,dir (make-temp-file "bug27940" t)) + (dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts. + (inhibit-message t) + (default-directory ,dir)) + (dotimes (i 5) (make-directory (format "empty-dir-%d" i))) + (unless ,just-empty-dirs + (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents))) + (make-directory "zeta-empty-dir") + (unwind-protect + (progn + ,@body) + (delete-directory ,dir t) + (kill-buffer (current-buffer)))))) + +(ert-deftest dired-test-bug27940 () + "Test for http://debbugs.gnu.org/27940 ." + ;; If just empty dirs we shouln't be prompted. + (dired-test-with-temp-dirs + 'just-empty-dirs + (let (asked) + (advice-add 'dired--yes-no-all-quit-help + :override + (lambda (_) (setq asked t) "") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (progn + (should-not asked) + (should-not (dired-get-marked-files))) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + ;; Answer yes + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should-not (dired-get-marked-files)) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer no + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer all + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should-not (dired-get-marked-files)) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer quit + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (let ((inhibit-message t)) + (dired-do-delete nil)) + (unwind-protect + (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + + (provide 'dired-tests) ;; dired-tests.el ends here |