1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00

; Increase ERC test server queue size

* test/lisp/erc/erc-scenarios-scrolltobottom.el
(erc-scenarios-scrolltobottom--normal,
erc-scenarios-scrolltobottom--all): Use updated name for test fixture.
* test/lisp/erc/resources/erc-d/erc-d.el
(erc-d--initialize-client): For lengthy batches, `erc-d--filter' may
run multiple times before `erc-d--on-request' can pull from the queue,
which results in discarded incoming messages and match failures.
(erc-d--m, erc-d--log): Convert to ordinary functions.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-scrolltobottom--normal,
erc-scenarios-common-scrolltobottom--normal): Rename test fixture from
former to latter and attempt to fix intermittent failure re
`count-screen-lines'.
This commit is contained in:
F. Jason Park 2023-09-18 22:50:28 -07:00
parent ffd5d2f38d
commit 6135fec692
3 changed files with 25 additions and 30 deletions

View File

@ -35,7 +35,7 @@
(should-not erc-scrolltobottom-all)
(erc-scenarios-scrolltobottom--normal
(erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion doesn't anchor prompt in other window")
(let ((w (next-window)))
@ -52,7 +52,7 @@
(let ((erc-scrolltobottom-all t))
(erc-scenarios-scrolltobottom--normal
(erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion anchors prompt in other window")
(let ((w (next-window)))

View File

@ -254,7 +254,7 @@ return a replacement.")
(ending (process-get process :dialog-ending))
(dialog (make-erc-d-dialog :name name
:process process
:queue (make-ring 5)
:queue (make-ring 10)
:exchanges (make-ring 10)
:match-handlers mat-h
:server-fqdn fqdn)))
@ -292,33 +292,27 @@ With int SKIP, advance past that many exchanges."
(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
(defmacro erc-d--m (process format-string &rest args)
"Output ARGS using FORMAT-STRING somewhere depending on context.
PROCESS should be a client connection or a server network process."
`(let ((format-string (if erc-d--m-debug
(concat (format-time-string "%s.%N: ")
,format-string)
,format-string))
(want-insert (and ,process erc-d--in-process))
(buffer (process-buffer (process-get ,process :server))))
(when (and want-insert (buffer-live-p buffer))
(with-current-buffer buffer
(goto-char (point-max))
(insert (concat (format ,format-string ,@args) "\n"))))
(when (or erc-d--m-debug (not want-insert))
(message format-string ,@args))))
(defun erc-d--m (process format-string &rest args)
"Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere."
(when erc-d--m-debug
(setq format-string (concat (format-time-string "%s.%N: ") format-string)))
(let ((insertp (and process erc-d--in-process))
(buffer (process-buffer (process-get process :server))))
(when (and insertp (buffer-live-p buffer))
(princ (concat (apply #'format format-string args) "\n") buffer))
(when (or erc-d--m-debug (not insertp))
(apply #'message format-string args))))
(defmacro erc-d--log (process string &optional outbound)
"Log STRING sent to (OUTBOUND) or received from PROCESS peer."
`(let ((id (or (process-get ,process :log-id)
(let ((port (erc-d-u--get-remote-port ,process)))
(process-put ,process :log-id port)
port)))
(name (erc-d-dialog-name (process-get ,process :dialog))))
(if ,outbound
(erc-d--m process "-> %s:%s %s" name id ,string)
(dolist (line (split-string ,string (process-get process :ending)))
(erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log (process string &optional outbound)
"Log STRING received from or OUTBOUND to PROCESS peer."
(let ((id (or (process-get process :log-id)
(let ((port (erc-d-u--get-remote-port process)))
(process-put process :log-id port) port)))
(name (erc-d-dialog-name (process-get process :dialog))))
(if outbound
(erc-d--m process "-> %s:%s %s" name id string)
(dolist (line (split-string string (process-get process :ending)))
(erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log-process-event (server process msg)
(erc-d--m server "%s: %s" process (string-trim-right msg)))

View File

@ -341,7 +341,7 @@ See Info node `(emacs) Term Mode' for the various commands."
;;;; Fixtures
(defun erc-scenarios-scrolltobottom--normal (test)
(defun erc-scenarios-common-scrolltobottom--normal (test)
(erc-scenarios-common-with-noninteractive-in-term
((erc-scenarios-common-dialog "scrolltobottom")
(dumb-server (erc-d-run "localhost" t 'help))
@ -402,6 +402,7 @@ See Info node `(emacs) Term Mode' for the various commands."
(erc-cmd-MSG "NickServ help register")
(save-excursion (erc-d-t-search-for 10 "End of NickServ"))
(should (= 1 (point)))
(redisplay)
(should (zerop (count-screen-lines (window-start) (window-point))))
(should (erc-scenarios-common--prompt-past-win-end-p)))