1
Fork 0
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:
F. Jason Park 2026-04-03 17:35:42 -07:00
parent a24ff52a79
commit 40b6f0180b
6 changed files with 100 additions and 69 deletions

View file

@ -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!")))

View file

@ -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)

View file

@ -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.

View file

@ -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:
;;

View file

@ -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 ()

View file

@ -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.