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:
parent
f4e0562a2c
commit
ecea3f2c83
1 changed files with 43 additions and 48 deletions
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue