mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-05-10 23:31:19 -07:00
; Tweak some ERC tests and related utilities
* test/lisp/erc/erc-scenarios-keep-place-indicator.el (erc-scenarios-keep-place-indicator--follow): Intersperse more `redisplay' calls to update the indicator's overlay. * test/lisp/erc/erc-tests.el (erc-tests--assert-printed-in-subprocess): Wrap CODE form in keyword sentinel. (erc--find-mode, erc--essential-hook-ordering): Use modified interface. (erc--find-group--real, erc--find-group/realistic): Rename former to latter and run in subprocess. (erc--update-modules/realistic): Redo to run in subprocess instead of mocking. * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-kill-related-buffers): Don't bother canceling `erc-server-flood-timer', even in an actual ERC buffer, since `erc-server-send-queue' first checks whether its BUFFER argument is still live before sending anything to the process. Also, don't bother collecting buffers only to immediately kill them. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--filter): Always clear remainder. Otherwise, partial emissions from the peer that aren't terminated by a newline will confuse subsequent processing. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--run-in-term): Look for a library called `erc-tests-compat', which ERC uses in its external CI to provide compatibility shims of definitions too obscure or unfit for inclusion in the Compat package on ELPA. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-kill-buffers): Also kill non-`erc-mode' buffers whose names match a scheme used by ERC for work buffers. Allow for the EXTRA-BUFFERS argument to possibly contain killed and null buffers.
This commit is contained in:
parent
a24ff52a79
commit
40b6f0180b
6 changed files with 100 additions and 69 deletions
|
|
@ -79,6 +79,7 @@
|
|||
(switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower
|
||||
(other-window 1)
|
||||
(switch-to-buffer "#spam") ; upper
|
||||
(redisplay)
|
||||
(erc-scenarios-common-say "one")
|
||||
(funcall expect 10 "Ay, the heads")
|
||||
|
||||
|
|
@ -94,6 +95,7 @@
|
|||
;; Lower window is still centered at start.
|
||||
(other-window 1)
|
||||
(switch-to-buffer "#chan")
|
||||
(redisplay)
|
||||
(save-excursion
|
||||
(goto-char (window-point))
|
||||
(should (looking-back (rx "<alice> tester, welcome!")))
|
||||
|
|
@ -107,8 +109,10 @@
|
|||
|
||||
(other-window 1) ; upper still at indicator, switches first
|
||||
(switch-to-buffer "#spam")
|
||||
(redisplay)
|
||||
(other-window 1)
|
||||
(switch-to-buffer "#spam") ; lower follows, speaks to sync
|
||||
(redisplay)
|
||||
(erc-scenarios-common-say "two")
|
||||
(funcall expect 10 "<bob> Cause they take")
|
||||
(goto-char (point-max))
|
||||
|
|
@ -116,6 +120,7 @@
|
|||
;; Upper switches back first, finds indicator gone.
|
||||
(other-window 1)
|
||||
(switch-to-buffer "#chan")
|
||||
(redisplay)
|
||||
(save-excursion
|
||||
(goto-char (window-point))
|
||||
(should (looking-back (rx "<bob> tester, welcome!")))
|
||||
|
|
|
|||
|
|
@ -3729,11 +3729,14 @@ keyword :result."
|
|||
(get-buffer-create
|
||||
(concat "*" (symbol-name (ert-test-name (ert-running-test))) "*"))
|
||||
(unwind-protect
|
||||
(let ((proc (erc-tests-common-create-subprocess code '("-batch") nil)))
|
||||
(let ((proc (erc-tests-common-create-subprocess
|
||||
`(,@(butlast code) (prin1 (list :result ,@(last code))))
|
||||
'("-batch") nil)))
|
||||
(while (accept-process-output proc 10))
|
||||
(goto-char (point-min))
|
||||
(search-forward "(:result " nil t)
|
||||
(unless (equal (ignore-errors (read (current-buffer))) expected)
|
||||
(unless (equal (and (search-forward "(:result " nil t)
|
||||
(read (current-buffer)))
|
||||
expected)
|
||||
(ert-fail (list "Mismatch"
|
||||
:expected expected
|
||||
:buffer-string (buffer-string)))))
|
||||
|
|
@ -3755,18 +3758,15 @@ keyword :result."
|
|||
(unless (keywordp mod)
|
||||
(push (if-let* ((mode (erc--find-mode mod))) mod (list :missing mod))
|
||||
moded)))
|
||||
(prin1 (list :result
|
||||
(sort moded (lambda (a b)
|
||||
(string< (symbol-name a) (symbol-name b)))))))
|
||||
(sort moded (lambda (a b) (string< (symbol-name a) (symbol-name b)))))
|
||||
erc-tests--modules))
|
||||
|
||||
(ert-deftest erc--essential-hook-ordering ()
|
||||
(erc-tests--assert-printed-in-subprocess
|
||||
'(progn
|
||||
(erc-update-modules)
|
||||
(prin1 (list :result
|
||||
(list :erc-insert-modify-hook erc-insert-modify-hook
|
||||
:erc-send-modify-hook erc-send-modify-hook))))
|
||||
(list :erc-insert-modify-hook erc-insert-modify-hook
|
||||
:erc-send-modify-hook erc-send-modify-hook))
|
||||
|
||||
'( :erc-insert-modify-hook (erc-controls-highlight ; 0
|
||||
erc-button-add-buttons ; 30
|
||||
|
|
@ -3798,26 +3798,37 @@ keyword :result."
|
|||
(should (eq (erc--find-group 'foo nil) 'erc))
|
||||
(should (eq (erc--find-group 'fake 'baz) 'erc-foo))))
|
||||
|
||||
(ert-deftest erc--find-group--real ()
|
||||
:tags '(:unstable)
|
||||
(require 'erc-services)
|
||||
(require 'erc-stamp)
|
||||
(require 'erc-sound)
|
||||
(require 'erc-page)
|
||||
(require 'erc-join)
|
||||
(require 'erc-capab)
|
||||
(require 'erc-pcomplete)
|
||||
(should (eq (erc--find-group 'services 'nickserv) 'erc-services))
|
||||
(should (eq (erc--find-group 'stamp 'timestamp) 'erc-stamp))
|
||||
(should (eq (erc--find-group 'sound 'ctcp-sound) 'erc-sound))
|
||||
(should (eq (erc--find-group 'page 'ctcp-page) 'erc-page))
|
||||
(should (eq (erc--find-group 'autojoin) 'erc-autojoin))
|
||||
(should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete))
|
||||
(should (eq (erc--find-group 'capab-identify) 'erc-capab))
|
||||
(should (eq (erc--find-group 'completion) 'erc-pcomplete))
|
||||
;; No group specified.
|
||||
(should (eq (erc--find-group 'smiley nil) 'erc))
|
||||
(should (eq (erc--find-group 'unmorse nil) 'erc)))
|
||||
(ert-deftest erc--find-group/realistic ()
|
||||
(erc-tests--assert-printed-in-subprocess
|
||||
'(progn
|
||||
(require 'erc-services)
|
||||
(require 'erc-stamp)
|
||||
(require 'erc-sound)
|
||||
(require 'erc-page)
|
||||
(require 'erc-join)
|
||||
(require 'erc-capab)
|
||||
(require 'erc-pcomplete)
|
||||
(list (erc--find-group 'services 'nickserv)
|
||||
(erc--find-group 'stamp 'timestamp)
|
||||
(erc--find-group 'sound 'ctcp-sound)
|
||||
(erc--find-group 'page 'ctcp-page)
|
||||
(erc--find-group 'autojoin)
|
||||
(erc--find-group 'pcomplete 'Completion)
|
||||
(erc--find-group 'completion)
|
||||
(erc--find-group 'capab-identify)
|
||||
;; No group specified.
|
||||
(erc--find-group 'smiley nil)
|
||||
(erc--find-group 'unmorse nil)))
|
||||
'(erc-services
|
||||
erc-stamp
|
||||
erc-sound
|
||||
erc-page
|
||||
erc-autojoin
|
||||
erc-pcomplete
|
||||
erc-pcomplete
|
||||
erc-capab
|
||||
erc
|
||||
erc)))
|
||||
|
||||
(ert-deftest erc--sort-modules ()
|
||||
(should (equal (erc--sort-modules '(networks foo fill bar fill stamp bar))
|
||||
|
|
@ -3920,28 +3931,32 @@ keyword :result."
|
|||
"(req . explicit-feature-lib)")))))))
|
||||
|
||||
(ert-deftest erc--update-modules/realistic ()
|
||||
(let ((calls nil)
|
||||
;; Module `pcomplete' "resolves" to `completion'.
|
||||
(erc-modules '(pcomplete autojoin networks)))
|
||||
(cl-letf (((symbol-function 'require)
|
||||
(lambda (s &rest _) (push (cons 'req s) calls)))
|
||||
(erc-tests--assert-printed-in-subprocess
|
||||
'(progn
|
||||
(require 'ert)
|
||||
(require 'erc)
|
||||
(should (featurep 'erc-networks))
|
||||
(should-not erc-networks-mode)
|
||||
;; The pcomplete module isn't loaded, and the non-alias form of
|
||||
;; its command isn't autoloaded, so `erc--find-mode' will do so.
|
||||
(should-not (featurep 'erc-pcomplete))
|
||||
(should-not (intern-soft "erc-pcomplete-mode"))
|
||||
;; The join module is autoloaded.
|
||||
(should-not (featurep 'erc-join))
|
||||
(should (fboundp 'erc-autojoin-mode))
|
||||
(should-not (boundp 'erc-autojoin-mode))
|
||||
|
||||
;; Spoof global module detection.
|
||||
((symbol-function 'custom-variable-p)
|
||||
(lambda (v)
|
||||
(memq v '(erc-autojoin-mode erc-networks-mode
|
||||
erc-completion-mode))))
|
||||
;; Mock and spy real builtins.
|
||||
((symbol-function 'erc-autojoin-mode)
|
||||
(lambda (n) (push (cons 'autojoin n) calls)))
|
||||
((symbol-function 'erc-networks-mode)
|
||||
(lambda (n) (push (cons 'networks n) calls)))
|
||||
((symbol-function 'erc-completion-mode)
|
||||
(lambda (n) (push (cons 'completion n) calls))))
|
||||
;; These are all global modules, so no return value is expected.
|
||||
(let ((erc-modules (cons (seq-random-elt '(completion pcomplete))
|
||||
'(networks autojoin))))
|
||||
(should-not (erc--update-modules erc-modules)))
|
||||
|
||||
(should-not (erc--update-modules erc-modules)) ; no locals
|
||||
(should (equal (nreverse calls)
|
||||
'((completion . 1) (autojoin . 1) (networks . 1)))))))
|
||||
(list erc-networks-mode
|
||||
(featurep 'erc-pcomplete)
|
||||
(featurep 'erc-join)
|
||||
(symbol-value (intern-soft "erc-pcomplete-mode"))
|
||||
(bound-and-true-p erc-autojoin-mode)))
|
||||
'(t t t t t)))
|
||||
|
||||
(ert-deftest erc--merge-local-modes ()
|
||||
(cl-letf (((get 'erc-b-mode 'erc-module) 'b)
|
||||
|
|
|
|||
|
|
@ -28,22 +28,20 @@
|
|||
|
||||
(defun erc-d-t-kill-related-buffers ()
|
||||
"Kill all erc- or erc-d- related buffers."
|
||||
(let (buflist)
|
||||
(dolist (buf (buffer-list))
|
||||
(with-current-buffer buf
|
||||
(when (or erc-d-u--process-buffer
|
||||
(derived-mode-p 'erc-mode 'erc-dcc-chat-mode))
|
||||
(push buf buflist))))
|
||||
(dolist (buf buflist)
|
||||
(when (and (boundp 'erc-server-flood-timer)
|
||||
(timerp erc-server-flood-timer))
|
||||
(cancel-timer erc-server-flood-timer))
|
||||
(when-let* ((proc (get-buffer-process buf)))
|
||||
(delete-process proc))
|
||||
(when (buffer-live-p buf)
|
||||
(dolist (buf (buffer-list))
|
||||
(with-current-buffer buf
|
||||
(when (or erc-d-u--process-buffer
|
||||
(derived-mode-p 'erc-mode
|
||||
'erc-dcc-chat-mode)
|
||||
(string-match (rx bot
|
||||
(? " ") "*erc" (in "- ") (+ nonl) "*"
|
||||
eot)
|
||||
(buffer-name)))
|
||||
(when-let* ((proc (get-buffer-process buf)))
|
||||
(delete-process proc))
|
||||
(kill-buffer buf))))
|
||||
(while (when-let* ((buf (pop erc-d-u--canned-buffers)))
|
||||
(kill-buffer buf))))
|
||||
(while-let ((buf (pop erc-d-u--canned-buffers)))
|
||||
(kill-buffer buf)))
|
||||
|
||||
(defun erc-d-t-silence-around (orig &rest args)
|
||||
"Run ORIG function with ARGS silently.
|
||||
|
|
|
|||
|
|
@ -462,8 +462,7 @@ including line delimiters."
|
|||
(substring string (match-end 0))))
|
||||
(erc-d--log process line nil)
|
||||
(ring-insert queue (erc-d-i--parse-message line nil))))
|
||||
(when string
|
||||
(setf (process-get process :stashed-input) string))))
|
||||
(setf (process-get process :stashed-input) string)))
|
||||
|
||||
;; Misc process properties:
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -267,6 +267,10 @@ Dialog resource directories are located by expanding the variable
|
|||
(package-initialize))))
|
||||
(require 'erc)
|
||||
(cl-assert (equal erc-version ,erc-version) t)))
|
||||
;; Load test-related compat shims too niche for Compat, such as
|
||||
;; a <31 definition of `ert-with-buffer-selected'.
|
||||
(tcompat (and (featurep 'erc-tests-compat)
|
||||
(locate-library "erc-tests-compat")))
|
||||
;; Make subprocess terminal bigger than controlling.
|
||||
(buf (cl-letf (((symbol-function 'window-screen-lines)
|
||||
(lambda () (car erc-scenarios-common--term-size)))
|
||||
|
|
@ -277,6 +281,9 @@ Dialog resource directories are located by expanding the variable
|
|||
nil `(,@(or init '("-Q")) "-nw"
|
||||
"-eval" ,(format "%S" setup)
|
||||
"-l" ,file-name
|
||||
,@(and tcompat
|
||||
(list "-L" (file-name-directory tcompat)
|
||||
"-l" tcompat))
|
||||
"-eval" ,(format "%S" cmd)))))
|
||||
(proc (get-buffer-process buf))
|
||||
(err (lambda ()
|
||||
|
|
|
|||
|
|
@ -81,11 +81,18 @@ Assign the result to `erc-server-process' in the current buffer."
|
|||
;; To facilitate automatic testing when a fake-server has already
|
||||
;; been created by an earlier ERT test.
|
||||
(kill-buffer-query-functions nil))
|
||||
(dolist (buf (erc-buffer-list))
|
||||
(kill-buffer buf))
|
||||
(mapc #'kill-buffer
|
||||
(match-buffers
|
||||
`(or ,@(static-if (>= emacs-major-version 30)
|
||||
'((derived-mode erc-mode erc-dcc-chat-mode))
|
||||
'((major-mode . erc-mode) (major-mode . erc-dcc-chat-mode)))
|
||||
,(rx bot (? ?\s) "*erc" (in "- ") (+ nonl) ?* eot))))
|
||||
(named-let doit ((buffers extra-buffers))
|
||||
(dolist (buf buffers)
|
||||
(if (consp buf) (doit buf) (kill-buffer buf))))))
|
||||
(if (consp buf)
|
||||
(doit buf)
|
||||
(when (buffer-live-p buf)
|
||||
(kill-buffer buf)))))))
|
||||
|
||||
(defun erc-tests-common-with-process-input-spy (test-fn)
|
||||
"Mock `erc-process-input-line' and call TEST-FN.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue