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:
parent
ffd5d2f38d
commit
6135fec692
@ -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)))
|
||||
|
@ -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)))
|
||||
|
@ -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)))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user