1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00

(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
This commit is contained in:
Stefan Monnier 2022-01-10 22:40:55 -05:00
parent f4e0562a2c
commit ecea3f2c83

View file

@ -1679,7 +1679,7 @@ PRED is nil."
(pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results)
(files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2))))
(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results)
(defun files-tests--with-buffer-offer-save (buffers-offer fn-test args-results)
"Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'.
This 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
`save-some-buffers-default-predicate' let-bound to a value
specified inside ARGS-RESULTS.
FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION
is a function symbol that this macro temporary binds to BINDING during
the FN-TEST call.
During the call to FN-TEST,`read-event' is overridden with a function that
just returns `n' and `kill-emacs' is overriden to do nothing.
ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where
FN-ARGS are the arguments for FN-TEST;
CALLERS-DIR specifies the value to let-bind
\`save-some-buffers-default-predicate';
EXPECTED is the expected result of the test."
(declare (debug (form symbol form form)))
(let ((dir (gensym "dir"))
(buffers (gensym "buffers")))
`(let* ((,dir (make-temp-file "testdir" 'dir))
(inhibit-message t)
(use-dialog-box nil)
,buffers)
(pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer)
(let* ((buf (generate-new-buffer (symbol-name bufsym)))
(subdir (expand-file-name
(format "subdir-%s" (buffer-name buf))
,dir)))
(make-directory subdir 'parens)
(push buf ,buffers)
(with-current-buffer buf
(cd subdir)
(setq buffer-offer-save offer-save)
(insert "foobar\n"))))
(setq ,buffers (nreverse ,buffers))
(let ((nb-saved-buffers 0))
(unwind-protect
(pcase-dolist (`(,fn-test-args ,callers-dir ,expected)
,args-results)
(setq nb-saved-buffers 0)
(with-current-buffer (car ,buffers)
(cl-letf
(,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair)))
fn-binders)
(save-some-buffers-default-predicate callers-dir))
(apply #',fn-test fn-test-args)
(should (equal nb-saved-buffers expected)))))
;; Clean up.
(dolist (buf ,buffers)
(with-current-buffer buf
(set-buffer-modified-p nil)
(kill-buffer buf)))
(delete-directory ,dir 'recursive))))))
(let* ((dir (make-temp-file "testdir" 'dir))
(inhibit-message t)
(use-dialog-box nil)
buffers)
(pcase-dolist (`(,bufsym ,offer-save) buffers-offer)
(let* ((buf (generate-new-buffer (symbol-name bufsym)))
(subdir (expand-file-name
(format "subdir-%s" (buffer-name buf))
dir)))
(make-directory subdir 'parens)
(push buf buffers)
(with-current-buffer buf
(cd subdir)
(setq buffer-offer-save offer-save)
(insert "foobar\n"))))
(setq buffers (nreverse buffers))
(let ((nb-saved-buffers 0))
(unwind-protect
(pcase-dolist (`(,fn-test-args ,callers-dir ,expected)
args-results)
(setq nb-saved-buffers 0)
(with-current-buffer (car buffers)
(cl-letf
(((symbol-function 'read-event)
;; Increase counter and answer 'n' when prompted
;; to save a buffer.
(lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
;; Do not kill Emacs.
((symbol-function 'kill-emacs) #'ignore)
(save-some-buffers-default-predicate callers-dir))
(apply fn-test fn-test-args)
(should (equal nb-saved-buffers expected)))))
;; Clean up.
(dolist (buf buffers)
(with-current-buffer buf
(set-buffer-modified-p nil)
(kill-buffer buf)))
(delete-directory dir 'recursive)))))
(defmacro files-tests-with-all-permutations (permutation list &rest body)
"Execute BODY forms for all permutations of LIST.
@ -1790,9 +1790,7 @@ PRED is nil."
(args-res `(((nil ,pred) ,callers-dir ,res))))
(files-tests--with-buffer-offer-save
buffers-offer
save-some-buffers
;; Increase counter and answer 'n' when prompted to save a buffer.
(('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)))
#'save-some-buffers
args-res)))))))
(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."
buffers-offer-init
(files-tests--with-buffer-offer-save
buffers-offer
save-buffers-kill-emacs
;; Increase counter and answer 'n' when prompted to save a buffer.
(('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
('kill-emacs . #'ignore)) ; Do not kill Emacs.
#'save-buffers-kill-emacs
`((nil nil ,nb-might-save)
;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored.
(nil save-some-buffers-root ,nb-might-save))))))