master 3b52f8f9816 1/9: ; Add erc-stamp test for right-margin face
"F. Jason Park" <[email protected]> Tue, 30 Jun 2026 23:37:21 -0400 (EDT)
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit 3b52f8f98168c5c26d6db78263a5055689545d58 Author: F. Jason Park <[email protected]> Commit: F. Jason Park <[email protected]> ; Add erc-stamp test for right-margin face * test/lisp/erc/erc-scenarios-fill-wrap.el (erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior): New function. (erc-scenarios-fill-wrap/right-margin-stamp-face): New test that fails if the right-margin's timestamp doesn't display its face property correctly. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--run-in-term): Add control channel to run code from the subprocess in the controlling process. (erc-scenarios-common-term-with-line-mode): New macro. (erc-scenarios-common--inferior-term-c2-proc): New variable. (erc-scenarios-common-term-call-in-superior): New function. (Bug#80693) --- test/lisp/erc/erc-scenarios-fill-wrap.el | 68 +++++++++++++++++++++ test/lisp/erc/resources/erc-scenarios-common.el | 79 ++++++++++++++++++++++++- 2 files changed, 146 insertions(+), 1 deletion(-) diff --git a/test/lisp/erc/erc-scenarios-fill-wrap.el b/test/lisp/erc/erc-scenarios-fill-wrap.el index 89f6eaf7988..d0e5ba035a9 100644 --- a/test/lisp/erc/erc-scenarios-fill-wrap.el +++ b/test/lisp/erc/erc-scenarios-fill-wrap.el @@ -91,4 +91,72 @@ (erc-scrolltobottom-mode -1))) +(defun erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior () + (erc-d-t-wait-for 10 (erc-scenarios-common-term-with-line-mode + (search-forward "[23:20]" nil t))) + (should (member + (get-text-property (match-beginning 0) 'font-lock-face) + (list '((:foreground "#00FF00") term-bold) ; 31 graphical + '((:foreground "green3") term-bold) ; 31 non-graphical + '(( :foreground "green3" ; 29,30 non-graphical + :background "unspecified-bg" + :inverse-video nil) + term-bold) + '(( :foreground "green3" ; 28 non-graphical + :background "unspecified-bg" + :inverse-video nil) + :inherit term-bold))))) + +;; Before Emacs 31, a display property's margin string would inherit +;; face properties residing at the same buffer position. Beginning in +;; 31, only those on the spec's string itself were to be considered. To +;; adapt, ERC added an explicit face to its margin stamps. This test +;; checks the final "realized" appearance without regard for the +;; properties themselves. It does so through very roundabout means, +;; using a term.el subprocess. Obviously, reverting 9ba65aa9 "Fix +;; missing margin face on display prop in erc-stamp" or commenting out +;; its addition to `erc-insert-timestamp-right' makes this test fail +;; unless the inciting changes added by bug#80693 were to also be +;; reverted to restore pre-31 behavior. +(ert-deftest erc-scenarios-fill-wrap/right-margin-stamp-face () + :tags '(:expensive-test :unstable) + + (when (and noninteractive (= emacs-major-version 27)) + (ert-skip "May stall on Emacs 27")) + + ;; Force fixture to use inferior process so that face-merging behavior + ;; can be verified in the controlling Emacs instance. + (let ((erc-scenarios-common-interactive-debug-term-p (not noninteractive))) + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "join/legacy") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'foonet)) + (erc-stamp--tz t) + ;; Start at 2023-10-22T06:16:43.445Z + (erc-stamp--current-time (if (< emacs-major-version 29) + '(25908 23515 445000 0) + '(1697930203445 . 1000))) + (erc-timer-hook (cons (lambda (&rest _) + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 15))) + erc-timer-hook)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((FooNet "#chan"))) + (erc-modules `(fill-wrap ,@erc-modules)) + (port (process-contact dumb-server :service))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "This server is in debug mode")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "[23:20]") + + (erc-scenarios-common-term-call-in-superior + #'erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior) + (funcall expect 10 "<bob> tester, welcome"))))) + ;;; erc-scenarios-fill-wrap.el ends here diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index aa18bbf7b21..4177379d935 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -284,6 +284,30 @@ completion." ;; a <31 definition of `ert-with-buffer-selected'. (tcompat (and (featurep 'erc-tests-compat) (locate-library "erc-tests-compat"))) + (control-process nil) + ;; Create a control channel to communicate between the term + ;; subprocess and the controlling Emacs. Must run before + ;; creating the subprocess so it sees the env var. + (control-server-process nil) + (_ (progn + (setq control-server-process + (make-network-process + :server 1 + :sentinel (lambda (p s) + (when (string-prefix-p "open" s) + (setq control-process p) + (set-process-buffer + p (get-buffer-create + "*erc-test-term-c2/superior*")) + (delete-process control-server-process))) + :noquery t ; client inherits + :host "localhost" + :service t + :coding 'utf-8-emacs + :name "*erc-test-term-c2/superior*")) + (push (format "ERC_TEST_TERM_C2_PORT=%d" + (process-contact control-server-process :service)) + process-environment))) ;; Make subprocess terminal bigger than controlling. (buf (cl-letf (((symbol-function 'window-screen-lines) (lambda () (car erc-scenarios-common--term-size))) @@ -311,7 +335,23 @@ completion." (set-process-query-on-exit-flag proc nil) (unless noninteractive (term-char-mode)) (erc-d-t-wait-for 30 (process-live-p proc)) - (while (accept-process-output proc)) + (with-timeout (30 nil) + (while (accept-process-output proc) + ;; If the subprocess emitted something readable, assume it's a + ;; named function and call it, letting errors propagate. + (when control-process + (unless (zerop (buffer-size (process-buffer control-process))) + (with-current-buffer (process-buffer control-process) + (goto-char (point-min)) + (let* ((test (read (current-buffer))) + (result (and (symbolp test) + (string-prefix-p "erc-" (symbol-name test)) + (with-current-buffer buf + (funcall test))))) + (cl-assert (eq (get-buffer-process buf) proc)) + (run-at-time 0 nil #'process-send-string + control-process (format "%S\n" result))) + (erase-buffer)))))) (term-line-mode) (goto-char (point-min)) ;; Otherwise gives process exited abnormally with exit-code >0 @@ -321,9 +361,46 @@ completion." (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) (delete-file temp-file) + ;; Kill client if connected, else server that's still listening. + (delete-process (or control-process control-server-process)) (when noninteractive (kill-buffer))))) +(defmacro erc-scenarios-common-term-with-line-mode (&rest body) + "Run BODY to validate contents of term window's contents." + `(save-restriction + (cl-assert (eq major-mode 'term-mode)) + (when (fboundp 'term-handle-deferred-scroll) + (term-handle-deferred-scroll)) + (defvar term-home-marker) + (narrow-to-region term-home-marker (point-max)) + (goto-char (point-min)) + ,@body)) + +(defvar erc-scenarios-common--inferior-term-c2-proc nil) + +(defun erc-scenarios-common-term-call-in-superior (sym) + "Run function SYM in superior process instead of term subprocess." + (run-at-time + 0 nil #'process-send-string + (or (and erc-scenarios-common--inferior-term-c2-proc + (process-live-p erc-scenarios-common--inferior-term-c2-proc)) + (setq erc-scenarios-common--inferior-term-c2-proc + (let ((b (get-buffer-create "*erc-test-term-c2/inferior*"))) + (make-network-process + :buffer b + :noquery t + :host "localhost" + :service (string-to-number (getenv "ERC_TEST_TERM_C2_PORT")) + :coding 'utf-8-emacs + :name (buffer-name b))))) + (concat (symbol-name sym) "\n")) + (ert-with-buffer-selected (current-buffer) + (with-current-buffer "*erc-test-term-c2/inferior*" + (ert-info ("Superior process assertion confirmed") + (erc-d-t-wait-for 10 (> (point-max) 1)) + (erase-buffer))))) + (defvar erc-scenarios-common-interactive-debug-term-p nil "Non-nil means run test in an inferior Emacs, even if interactive.")