aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2022-01-10 22:40:55 -0500
committerStefan Monnier2022-01-10 22:40:55 -0500
commitecea3f2c8322ca43cbde9976fa6e658100cc2b99 (patch)
tree6130e535de860a8c8700fa03329017518b5895d0
parentf4e0562a2c3474d7d5acaa474367ad9fdc02073f (diff)
downloademacs-ecea3f2c8322ca43cbde9976fa6e658100cc2b99.tar.gz
emacs-ecea3f2c8322ca43cbde9976fa6e658100cc2b99.zip
(files-tests--with-buffer-offer-save): Turn it into a function
* test/lisp/files-tests.el (files-tests--with-buffer-offer-save): Turn it into a function. (files-tests-save-buffers-kill-emacs--asks-to-save-buffers) (files-tests-buffer-offer-save): Adjust calls accordingly
-rw-r--r--test/lisp/files-tests.el91
1 files changed, 43 insertions, 48 deletions
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 1b09cdb397e..57d1ef1682d 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1679,7 +1679,7 @@ PRED is nil."
1679 (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results) 1679 (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results)
1680 (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2)))) 1680 (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2))))
1681 1681
1682(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) 1682(defun files-tests--with-buffer-offer-save (buffers-offer fn-test args-results)
1683 "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. 1683 "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'.
1684 1684
1685This macro creates several non-file-visiting buffers in different 1685This macro creates several non-file-visiting buffers in different
@@ -1693,52 +1693,52 @@ FN-TEST is the function to test: either `save-some-buffers' or
1693`save-some-buffers-default-predicate' let-bound to a value 1693`save-some-buffers-default-predicate' let-bound to a value
1694specified inside ARGS-RESULTS. 1694specified inside ARGS-RESULTS.
1695 1695
1696FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION 1696During the call to FN-TEST,`read-event' is overridden with a function that
1697is a function symbol that this macro temporary binds to BINDING during 1697just returns `n' and `kill-emacs' is overriden to do nothing.
1698the FN-TEST call.
1699 1698
1700ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where 1699ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where
1701FN-ARGS are the arguments for FN-TEST; 1700FN-ARGS are the arguments for FN-TEST;
1702CALLERS-DIR specifies the value to let-bind 1701CALLERS-DIR specifies the value to let-bind
1703\`save-some-buffers-default-predicate'; 1702\`save-some-buffers-default-predicate';
1704 EXPECTED is the expected result of the test." 1703 EXPECTED is the expected result of the test."
1705 (declare (debug (form symbol form form))) 1704 (let* ((dir (make-temp-file "testdir" 'dir))
1706 (let ((dir (gensym "dir")) 1705 (inhibit-message t)
1707 (buffers (gensym "buffers"))) 1706 (use-dialog-box nil)
1708 `(let* ((,dir (make-temp-file "testdir" 'dir)) 1707 buffers)
1709 (inhibit-message t) 1708 (pcase-dolist (`(,bufsym ,offer-save) buffers-offer)
1710 (use-dialog-box nil) 1709 (let* ((buf (generate-new-buffer (symbol-name bufsym)))
1711 ,buffers) 1710 (subdir (expand-file-name
1712 (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer) 1711 (format "subdir-%s" (buffer-name buf))
1713 (let* ((buf (generate-new-buffer (symbol-name bufsym))) 1712 dir)))
1714 (subdir (expand-file-name 1713 (make-directory subdir 'parens)
1715 (format "subdir-%s" (buffer-name buf)) 1714 (push buf buffers)
1716 ,dir))) 1715 (with-current-buffer buf
1717 (make-directory subdir 'parens) 1716 (cd subdir)
1718 (push buf ,buffers) 1717 (setq buffer-offer-save offer-save)
1719 (with-current-buffer buf 1718 (insert "foobar\n"))))
1720 (cd subdir) 1719 (setq buffers (nreverse buffers))
1721 (setq buffer-offer-save offer-save) 1720 (let ((nb-saved-buffers 0))
1722 (insert "foobar\n")))) 1721 (unwind-protect
1723 (setq ,buffers (nreverse ,buffers)) 1722 (pcase-dolist (`(,fn-test-args ,callers-dir ,expected)
1724 (let ((nb-saved-buffers 0)) 1723 args-results)
1725 (unwind-protect 1724 (setq nb-saved-buffers 0)
1726 (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) 1725 (with-current-buffer (car buffers)
1727 ,args-results) 1726 (cl-letf
1728 (setq nb-saved-buffers 0) 1727 (((symbol-function 'read-event)
1729 (with-current-buffer (car ,buffers) 1728 ;; Increase counter and answer 'n' when prompted
1730 (cl-letf 1729 ;; to save a buffer.
1731 (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair))) 1730 (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
1732 fn-binders) 1731 ;; Do not kill Emacs.
1733 (save-some-buffers-default-predicate callers-dir)) 1732 ((symbol-function 'kill-emacs) #'ignore)
1734 (apply #',fn-test fn-test-args) 1733 (save-some-buffers-default-predicate callers-dir))
1735 (should (equal nb-saved-buffers expected))))) 1734 (apply fn-test fn-test-args)
1736 ;; Clean up. 1735 (should (equal nb-saved-buffers expected)))))
1737 (dolist (buf ,buffers) 1736 ;; Clean up.
1738 (with-current-buffer buf 1737 (dolist (buf buffers)
1739 (set-buffer-modified-p nil) 1738 (with-current-buffer buf
1740 (kill-buffer buf))) 1739 (set-buffer-modified-p nil)
1741 (delete-directory ,dir 'recursive)))))) 1740 (kill-buffer buf)))
1741 (delete-directory dir 'recursive)))))
1742 1742
1743(defmacro files-tests-with-all-permutations (permutation list &rest body) 1743(defmacro files-tests-with-all-permutations (permutation list &rest body)
1744 "Execute BODY forms for all permutations of LIST. 1744 "Execute BODY forms for all permutations of LIST.
@@ -1790,9 +1790,7 @@ PRED is nil."
1790 (args-res `(((nil ,pred) ,callers-dir ,res)))) 1790 (args-res `(((nil ,pred) ,callers-dir ,res))))
1791 (files-tests--with-buffer-offer-save 1791 (files-tests--with-buffer-offer-save
1792 buffers-offer 1792 buffers-offer
1793 save-some-buffers 1793 #'save-some-buffers
1794 ;; Increase counter and answer 'n' when prompted to save a buffer.
1795 (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)))
1796 args-res))))))) 1794 args-res)))))))
1797 1795
1798(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers () 1796(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers ()
@@ -1807,10 +1805,7 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil."
1807 buffers-offer-init 1805 buffers-offer-init
1808 (files-tests--with-buffer-offer-save 1806 (files-tests--with-buffer-offer-save
1809 buffers-offer 1807 buffers-offer
1810 save-buffers-kill-emacs 1808 #'save-buffers-kill-emacs
1811 ;; Increase counter and answer 'n' when prompted to save a buffer.
1812 (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
1813 ('kill-emacs . #'ignore)) ; Do not kill Emacs.
1814 `((nil nil ,nb-might-save) 1809 `((nil nil ,nb-might-save)
1815 ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored. 1810 ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored.
1816 (nil save-some-buffers-root ,nb-might-save)))))) 1811 (nil save-some-buffers-root ,nb-might-save))))))