From 7097be8ef601a20cdcd5d3a2bf2b1e33f2124981 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 24 Dec 2023 12:21:49 -0800 Subject: [PATCH] Move ERC test utilities to common file * lisp/erc/erc-common.el (erc--define-catalog): Update name of reference to convenience command now located in `erc-tests-common'. * test/lisp/erc/erc-button-tests.el: Require common test-util library `erc-tests-common', located under test/lisp/erc/resources. ; (erc-button-alist--url, ; erc-button-tests--erc-button-alist--function-as-form, ; erc-button-tests--erc-button-alist--nil-form, ; erc-button--display-error-notice-with-keys): Use common helper ; `erc-tests-common-init-server-proc' from test-utils library. * test/lisp/erc/erc-fill-tests.el: Require `erc-tests-common'. (erc-fill-tests--wrap-populate): Use helper `erc-tests-common-init-server-proc'. (erc-fill-tests--save-p): Remove. See replacement `erc-tests-common-snapshot-save-p' in erc-tests-common. (erc-fill-tests--graphic-dir): Add trailing slash. (erc-fill-tests--compare): Move body to generalized utility `erc-tests-common-snapshot-compare' in erc-tests-common. * test/lisp/erc/erc-goodies-tests.el: Require `erc-tests-common'. (erc--get-inserted-msg-beg/readonly, erc--get-inserted-msg-end/readonly, erc--get-inserted-msg-bounds/readonly): Move here from erc-tests.el. * test/lisp/erc/erc-networks-tests.el: Load `erc-tests-common'. (erc-networks-tests--create-live-proc): Defer to `erc-tests-common-init-server-proc' and drop optional buffer param. (erc-networks-tests--clean-bufs): Defer to `erc-tests-common-kill-buffers'. (erc-networks--rename-server-buffer--existing--live): Call `erc-networks-tests--create-live-proc' in server buffer. * test/lisp/erc/erc-scenarios-internal.el: Load `erc-tests-common'. (erc-scenarios-internal--run-graphical-all): Use `erc-tests-common-create-subprocess' to create process. * test/lisp/erc/erc-scenarios-sasl.el (erc-scenarios-sasl--plain-fail): Silence error message. * test/lisp/erc/erc-stamp-tests.el: Require `erc-tests-common'. (erc-stamp-tests--insert-right, erc-timestamp-intangible--left): Use `erc-tests-common-init-server-proc'. (erc-tests--assert-get-inserted-msg/stamp, erc-stamp-tests--assert-get-inserted-msg/stamp): Move from erc-tests.el, renaming to latter. (erc--get-inserted-msg-beg/stamp, erc--get-inserted-msg-beg/readonly/stamp, erc--get-inserted-msg-end/stamp, erc--get-inserted-msg-end/readonly/stamp, erc--get-inserted-msg-bounds/stamp, erc--get-inserted-msg-bounds/readonly/stamp): Move here from erc-tests.el. * test/lisp/erc/erc-tests.el: Require `erc-tests-common'. (erc-with-server-buffer): Use renamed test-helper utility `erc-tests-common-init-server-proc'. (erc-tests--send-prep, erc-tests--set-fake-server-process): Move to `erc-tests-common' library and rename to `erc-tests-common-prep-for-insertion' and `erc-tests-common-init-server-proc', respectively. ; (erc-hide-prompt, erc--refresh-prompt, ; erc-setup-buffer--custom-action, erc--parsed-prefix, ; erc--update-channel-modes, erc--channel-modes, ; erc--channel-modes/graphic-p, erc-ring-previous-command): Use ; `erc-tests-common-prep-for-insertion' instead of ; `erc-tests--send-prep', and use `erc-tests-common-init-server-proc' ; instead of `erc-tests--set-fake-server-process'. (erc-tests--with-process-input-spy): Move to `erc-tests-common' and rename `erc-tests-common-with-process-input-spy'. ; (erc--check-prompt-input-functions, erc-send-current-line, ; erc--check-prompt-input-for-multiline-blanks, ; erc-send-whitespace-lines): Use renamed ; `erc-tests-common-with-process-input-spy' and ; `erc-tests-common-init-server-proc'. ; (erc-process-input-line): Use renamed ; `erc-tests-common-init-server-proc'. (erc-tests--get-inserted-msg-setup, erc-tests--assert-get-inserted-msg, erc-tests--assert-get-inserted-msg/basic, erc-tests--assert-get-inserted-msg-readonly-with): Move to `erc-tests-common' and rename with "common" prefix, using single instead of double hyphen. (erc-tests--assert-get-inserted-msg/stamp): Move to `erc-stamp-tests' and rename with "stamp" prefix. (erc--get-inserted-msg-beg/stamp, erc--get-inserted-msg-beg/readonly/stamp, erc--get-inserted-msg-end/stamp, erc--get-inserted-msg-end/readonly/stamp, erc--get-inserted-msg-bounds/stamp, erc--get-inserted-msg-bounds/readonly/stamp): Move to `erc-stamp-tests'. (erc--get-inserted-msg-beg/readonly, erc--get-inserted-msg-end/readonly, erc--get-inserted-msg-bounds/readonly): Move to `erc-goodies-tests'. ; (erc--get-inserted-msg-beg/basic, ; erc--get-inserted-msg-end/basic, ; erc--get-inserted-msg-bounds/basic): Use common helpers. ; (erc--route-insertion): Use renamed helper functions ; `erc-tests-common-with-process-input-spy' and ; `erc-tests-common-init-server-proc'. (erc-tests--make-server-buf): Move to `erc-common-tests' and rename with "common" prefix. (erc-tests--make-client-buf): Remove unused function without supplying replacement. ; (erc-handle-irc-url): Use renamed `erc-tests-common-make-server-buf' ; utility function. ; (erc-tests--assert-printed-in-subprocess): Use helper from common lib ; `erc-tests-common-create-subprocess code' to do the heavy lifting. (erc-tests--string-to-propertized-parts, erc-tests-pp-propertized-parts): Move to `erc-tests-common' and rename with "common" prefix. * test/lisp/erc/resources/erc-tests-common.el: New file containing helper utilities and fixtures used by multiple files in test/lisp/erc. --- lisp/erc/erc-common.el | 6 +- test/lisp/erc/erc-button-tests.el | 25 +- test/lisp/erc/erc-fill-tests.el | 92 ++----- test/lisp/erc/erc-goodies-tests.el | 21 ++ test/lisp/erc/erc-networks-tests.el | 20 +- test/lisp/erc/erc-scenarios-internal.el | 19 +- test/lisp/erc/erc-scenarios-sasl.el | 1 + test/lisp/erc/erc-stamp-tests.el | 52 +++- test/lisp/erc/erc-tests.el | 290 +++----------------- test/lisp/erc/resources/erc-tests-common.el | 287 +++++++++++++++++++ 10 files changed, 449 insertions(+), 364 deletions(-) create mode 100644 test/lisp/erc/resources/erc-tests-common.el diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 64312e51f41..6c101dea4e3 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -551,10 +551,10 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style." "Define `erc-display-message' formatting templates for NAME, a symbol. See `erc-define-message-format-catalog' for the meaning of -ENTRIES, an alist. Also see `erc-tests-pp-propertized-parts' in +ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in tests/lisp/erc/erc-tests.el for a convenience command to convert -a literal string into a sequence of `propertize' forms, which -are much easier to review and edit." +a literal string into a sequence of `propertize' forms, which are +much easier to review and edit." (declare (indent 1)) (let (out) (dolist (e entries (cons 'progn (nreverse out))) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 34ad06b7eb8..be11b76bd2e 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -21,12 +21,15 @@ ;;; Code: +(require 'ert-x) ; cl-lib +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-button) (ert-deftest erc-button-alist--url () - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let ((verify (lambda (p url) @@ -65,9 +68,7 @@ (apply #'erc-button-add-button rest)) (defun erc-button-tests--erc-button-alist--function-as-form (func) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let* ((erc-button-tests--form nil) @@ -102,9 +103,7 @@ (apply #'erc-button-add-button r)))) (defun erc-button-tests--erc-button-alist--nil-form (form) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let* ((erc-button-tests--form nil) @@ -228,11 +227,9 @@ (inhibit-message noninteractive) erc-modules erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (erc-mode) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) - (erc--initialize-markers (point) nil) + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") + (erc-button-mode +1) (should (equal (erc-button--display-error-notice-with-keys "If \\[erc-bol] fails, " diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 5e5b1d332ac..df83466cbc3 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -24,6 +24,10 @@ ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-fill) (defvar erc-fill-tests--buffers nil) @@ -58,9 +62,7 @@ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (cl-letf (((symbol-function 'erc-server-connect) (lambda (&rest _) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil)))) + (erc-tests-common-init-server-proc "sleep" "1")))) (with-current-buffer (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect nil nil nil nil nil "tester" 'foonet) @@ -106,10 +108,9 @@ (when set-transient-map-timer (timer-event-handler set-transient-map-timer)) (set-window-buffer (selected-window) original-window-buffer) - (when noninteractive - (while-let ((buf (pop erc-fill-tests--buffers))) - (kill-buffer buf)) - (kill-buffer)))))))) + (when (or noninteractive (getenv "ERC_TESTS_GRAPHICAL")) + (erc-tests-common-kill-buffers erc-fill-tests--buffers) + (setq erc-fill-tests--buffers nil)))))))) (defun erc-fill-tests--wrap-check-prefixes (&rest prefixes) ;; Check that prefix props are applied over correct intervals. @@ -134,74 +135,21 @@ (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix) '(space :width erc-fill--wrap-value)))))) -;; Use this variable to generate new snapshots after carefully -;; reviewing the output of *each* snapshot (not just first and last). -;; Obviously, only run one test at a time. -(defvar erc-fill-tests--save-p (getenv "ERC_TESTS_FILL_SAVE")) - ;; On graphical displays, echo .graphic >> .git/info/exclude -(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic") +(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic/") (defun erc-fill-tests--compare (name) - (let* ((dir (expand-file-name (if (display-graphic-p) - erc-fill-tests--graphic-dir - "fill/snapshots/") - (ert-resource-directory))) - (expect-file (file-name-with-extension (expand-file-name name dir) - "eld")) - (erc--own-property-names - (seq-difference `(font-lock-face ,@erc--own-property-names) - `(field display wrap-prefix line-prefix - erc--msg erc--cmd erc--spkr erc--ts erc--ctcp - erc--ephemeral) - #'eq)) - (print-circle t) - (print-escape-newlines t) - (print-escape-nonascii t) - (got (erc--remove-text-properties - (buffer-substring (point-min) erc-insert-marker))) - (repr (string-replace "erc-fill--wrap-value" - (number-to-string erc-fill--wrap-value) - (prin1-to-string got)))) - (with-current-buffer (generate-new-buffer name) - (push (current-buffer) erc-fill-tests--buffers) - (with-silent-modifications - (insert (setq got (read repr)))) - (erc-mode)) - ;; LHS is a string, RHS is a symbol. - (if (string= erc-fill-tests--save-p (ert-test-name (ert-running-test))) - (let (inhibit-message) - (with-temp-file expect-file - (insert repr)) - ;; Limit writing snapshots to one test at a time. - (message "erc-fill-tests--compare: wrote %S" expect-file)) - (if (file-exists-p expect-file) - ;; Ensure string-valued properties, like timestamps, aren't - ;; recursive (signals `max-lisp-eval-depth' exceeded). - (named-let assert-equal - ((latest (read repr)) - (expect (read (with-temp-buffer - (insert-file-contents-literally expect-file) - (buffer-string))))) - (pcase latest - ((or "" 'nil) t) - ((pred stringp) - (should (equal-including-properties latest expect)) - (let ((latest-intervals (object-intervals latest)) - (expect-intervals (object-intervals expect))) - (while-let ((l-iv (pop latest-intervals)) - (x-iv (pop expect-intervals)) - (l-tab (map-into (nth 2 l-iv) 'hash-table)) - (x-tab (map-into (nth 2 x-iv) 'hash-table))) - (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab)) - (assert-equal l-v (gethash l-k x-tab)) - (remhash l-k x-tab)) - (should (zerop (hash-table-count x-tab)))))) - ((pred sequencep) - (assert-equal (seq-first latest) (seq-first expect)) - (assert-equal (seq-rest latest) (seq-rest expect))) - (_ (should (equal latest expect))))) - (message "Snapshot file missing: %S" expect-file))))) + (let ((dir (expand-file-name (if (display-graphic-p) + erc-fill-tests--graphic-dir + "fill/snapshots/" ) + (ert-resource-directory))) + (transform-fn (lambda (got) + (string-replace "erc-fill--wrap-value" + (number-to-string erc-fill--wrap-value) + got))) + (buffer-setup-fn (lambda () + (push (current-buffer) erc-fill-tests--buffers)))) + (erc-tests-common-snapshot-compare name dir transform-fn buffer-setup-fn))) ;; To inspect variable pitch, set `erc-mode-hook' to ;; diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index ca02089eb7c..bdd197fa5cb 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -20,6 +20,10 @@ ;;; Commentary: ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-goodies) (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) @@ -420,4 +424,21 @@ (goto-char (overlay-start erc--keep-place-indicator-overlay)) (should (looking-at (rx "*** This buffer is for text"))))))) +(ert-deftest erc--get-inserted-msg-beg/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) + + ;;; erc-goodies-tests.el ends here diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d0f1dddf6b3..7d9424d7430 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -20,25 +20,21 @@ ;;; Code: (require 'ert-x) ; cl-lib -(require 'erc) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) (defun erc-networks-tests--create-dead-proc (&optional buf) (let ((p (start-process "true" (or buf (current-buffer)) "true"))) (while (process-live-p p) (sit-for 0.1)) p)) -(defun erc-networks-tests--create-live-proc (&optional buf) - (let ((proc (start-process "sleep" (or buf (current-buffer)) "sleep" "1"))) - (set-process-query-on-exit-flag proc nil) - proc)) +(defun erc-networks-tests--create-live-proc () + (erc-tests-common-init-server-proc "sleep" "1")) ;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS. (defun erc-networks-tests--clean-bufs () - (let (erc-kill-channel-hook - erc-kill-server-hook - erc-kill-buffer-hook) - (dolist (buf (erc-buffer-list)) - (kill-buffer buf)))) + (erc-tests-common-kill-buffers)) (defun erc-networks-tests--bufnames (prefix) (let* ((case-fold-search) @@ -1442,10 +1438,12 @@ (let* (erc-kill-server-hook erc-insert-modify-hook (old-buf (get-buffer-create "FooNet")) - (old-proc (erc-networks-tests--create-live-proc old-buf))) ; live + ;; + old-proc) ; live (with-current-buffer old-buf (erc-mode) + (setq old-proc (erc-networks-tests--create-live-proc)) (erc--initialize-markers (point) nil) (insert "*** Old buf") (setq erc-network 'FooNet diff --git a/test/lisp/erc/erc-scenarios-internal.el b/test/lisp/erc/erc-scenarios-internal.el index 4ec94cedf0e..b6c4d1ba27f 100644 --- a/test/lisp/erc/erc-scenarios-internal.el +++ b/test/lisp/erc/erc-scenarios-internal.el @@ -24,9 +24,12 @@ (when (and (getenv "EMACS_TEST_DIRECTORY") (getenv "EMACS_TEST_JUNIT_REPORT")) (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name))) - (let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory)) - load-path))) - (load "erc-d-tests" nil 'silent))) + (let ((load-path `(,(expand-file-name "erc-d" (ert-resource-directory)) + ,(ert-resource-directory) + ,@load-path))) + ;; Run all tests in ./resources/erc-d/erc-d-tests.el. + (load "erc-d-tests" nil 'silent) + (require 'erc-tests-common))) ;; Run all tests tagged `:erc--graphical' in an "interactive" ;; subprocess. Time out after 90 seconds. @@ -45,13 +48,9 @@ (with-current-buffer ert--output-buffer-name (kill-emacs (ert--stats-failed-unexpected ert--results-stats))))) - (args `("erc-interactive-all" ,(current-buffer) - ,(concat invocation-directory invocation-name) - "-Q" "-L" "." "-l" "ert" - ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o) - "-eval" ,(format "%S" program))) - (proc (apply #'start-process args))) - (set-process-query-on-exit-flag proc nil) + (proc (erc-tests-common-create-subprocess program + '( "-L" "." "-l" "ert") + libs))) (erc-d-t-wait-for 90 "interactive tests to complete" (not (process-live-p proc))) diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el index 74075b1aaf3..ecabc365adb 100644 --- a/test/lisp/erc/erc-scenarios-sasl.el +++ b/test/lisp/erc/erc-scenarios-sasl.el @@ -151,6 +151,7 @@ (erc-sasl-mechanism 'plain) (erc--warnings-buffer-name "*ERC test warnings*") (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) (expect (erc-d-t-make-expecter))) (with-current-buffer (erc :server "127.0.0.1" diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index fd2e7000c0e..3f17e36e002 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -21,6 +21,10 @@ ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-stamp) (require 'erc-goodies) ; for `erc-make-read-only' @@ -44,9 +48,7 @@ (erc-mode) (erc-munge-invisibility-spec) (erc--initialize-markers (point) nil) - (setq erc-server-process (start-process "p" (current-buffer) - "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (funcall test) @@ -223,13 +225,13 @@ (erc-timestamp-intangible t) ; default changed to nil in 2014 (erc-hide-timestamps t) (erc-insert-timestamp-function 'erc-insert-timestamp-left) - (erc-server-process (start-process "true" (current-buffer) "true")) (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) msg erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (should (not cursor-sensor-inhibit)) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-mode) + (erc-tests-common-init-server-proc "true") (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) @@ -307,4 +309,44 @@ (should (equal (call-interactively #'erc-echo-timestamp) "1983-09-26 21:00:00 -07"))))) +(defun erc-stamp-tests--assert-get-inserted-msg/stamp (test-fn) + (let ((erc-insert-modify-hook erc-insert-modify-hook) + (erc-insert-timestamp-function 'erc-insert-timestamp-right) + (erc-timestamp-use-align-to 0) + (erc-timestamp-format "[00:00]")) + (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook) + (erc-tests-common-get-inserted-msg-setup)) + (goto-char 19) + (should (looking-back (rx " hi [00:00]"))) + (erc-tests-common-assert-get-inserted-msg 3 19 test-fn)) + +(ert-deftest erc--get-inserted-msg-beg/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-beg/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-end/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) + ;;; erc-stamp-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ffc96eb4f1d..2d6eda6a24c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -22,7 +22,10 @@ ;;; Code: (require 'ert-x) -(require 'erc) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-ring) (ert-deftest erc--read-time-period () @@ -113,7 +116,7 @@ (ert-deftest erc-with-server-buffer () (setq erc-away 1) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (let (mockingp calls) (advice-add 'buffer-local-value :after @@ -155,34 +158,22 @@ (when (cl-evenp c) (push c out))))) (should (equal out '(?f ?d ?b))))) -(defun erc-tests--send-prep () - ;; Caller should probably shadow `erc-insert-modify-hook' or - ;; populate user tables for erc-button. - (erc-mode) - (erc--initialize-markers (point) nil) - (should (= (point) erc-input-marker))) - -(defun erc-tests--set-fake-server-process (&rest args) - (setq erc-server-process - (apply #'start-process (car args) (current-buffer) args)) - (set-process-query-on-exit-flag erc-server-process nil)) - (ert-deftest erc-hide-prompt () (let ((erc-hide-prompt erc-hide-prompt) ;; erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (with-current-buffer (get-buffer-create "ServNet") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) (setq erc-network 'ServNet) (set-process-query-on-exit-flag erc-server-process nil)) (with-current-buffer (get-buffer-create "#chan") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) (setq erc-server-process (buffer-local-value 'erc-server-process @@ -190,7 +181,7 @@ erc--target (erc--target-from-string "#chan"))) (with-current-buffer (get-buffer-create "bob") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) (setq erc-server-process (buffer-local-value 'erc-server-process @@ -318,10 +309,10 @@ (ert-info ("Server buffer") (with-current-buffer (get-buffer-create "ServNet") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p "ServNet 3>")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) (setq erc-network 'ServNet erc-server-current-nick "tester" @@ -353,7 +344,7 @@ (ert-info ("Channel buffer") (with-current-buffer (get-buffer-create "#chan") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p "#chan 9>")) (goto-char erc-input-marker) @@ -546,7 +537,7 @@ (ert-deftest erc-setup-buffer--custom-action () (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--server-last-reconnect-count 0) (let ((owin (selected-window)) (obuf (window-buffer)) @@ -677,7 +668,7 @@ (ert-deftest erc--parsed-prefix () (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table)) ;; Uses fallback values when no PREFIX parameter yet received, thus @@ -755,7 +746,7 @@ erc-server-users (make-hash-table :test #'equal) erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -845,7 +836,7 @@ erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) @@ -890,7 +881,7 @@ '(:erc--graphical))) (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") erc-server-parameters @@ -1200,7 +1191,7 @@ (ert-deftest erc-ring-previous-command () (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) @@ -1381,29 +1372,8 @@ (should (equal '("" "" "") (split-string "\n\n" p))) (should (equal '("" "" "") (split-string "\n\r" p))))) -(defun erc-tests--with-process-input-spy (test) - (with-current-buffer (get-buffer-create "FakeNet") - (let* ((erc--input-review-functions - (remove #'erc-add-to-input-ring erc--input-review-functions)) - (erc-pre-send-functions - (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now - (inhibit-message noninteractive) - (erc-server-current-nick "tester") - (erc-last-input-time 0) - erc-accidental-paste-threshold-seconds - erc-send-modify-hook - ;; - calls) - (cl-letf (((symbol-function 'erc-process-input-line) - (lambda (&rest r) (push r calls))) - ((symbol-function 'erc-server-buffer) - (lambda () (current-buffer)))) - (erc-tests--send-prep) - (funcall test (lambda () (pop calls))))) - (when noninteractive (kill-buffer)))) - (ert-deftest erc--check-prompt-input-functions () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) (ert-info ("Errors when point not in prompt area") ; actually just dings @@ -1438,9 +1408,9 @@ ;; These also indirectly tests `erc-send-input' (ert-deftest erc-send-current-line () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (should (= 0 erc-last-input-time)) (ert-info ("Simple command") @@ -1519,9 +1489,9 @@ '("Stripping" "Padding")) (ert-deftest erc--check-prompt-input-for-multiline-blanks () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "10") + (erc-tests-common-init-server-proc "sleep" "10") (should-not erc-send-whitespace-lines) (should erc-warn-about-blank-lines) @@ -1600,9 +1570,9 @@ rv )))))) (ert-deftest erc-send-whitespace-lines () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq-local erc-send-whitespace-lines t) (ert-info ("Multiline hunk with blank line correctly split") @@ -1697,7 +1667,7 @@ (erc-default-recipients '("#chan")) calls) (with-temp-buffer - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1755,120 +1725,19 @@ (should-not calls)))))) -(defun erc-tests--get-inserted-msg-setup () - (erc-mode) - (erc--initialize-markers (point) nil) - (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" - :sender "bob" - :command "PRIVMSG" - :command-args (list "#chan" "hi") - :contents "hi")) - (erc--msg-prop-overrides '((erc--ts . 0)))) - (erc-display-message parsed nil (current-buffer) - (erc-format-privmessage "bob" "hi" nil t))) - (goto-char 3) - (should (looking-at " hi"))) - -;; All these bounds-finding functions take an optional POINT argument. -;; So run each case with and without it at each pos in the message. -(defun erc-tests--assert-get-inserted-msg (from to assert-fn) - (dolist (pt-arg '(nil t)) - (dolist (i (number-sequence from to)) - (goto-char i) - (ert-info ((format "At %d (%c) %s param" i (char-after i) - (if pt-arg "with" ""))) - (funcall assert-fn (and pt-arg i)))))) - -(defun erc-tests--assert-get-inserted-msg/basic (test-fn) - (erc-tests--get-inserted-msg-setup) - (goto-char 11) - (should (looking-back " hi")) - (erc-tests--assert-get-inserted-msg 3 11 test-fn)) - -(defun erc-tests--assert-get-inserted-msg/stamp (test-fn) - (require 'erc-stamp) - (defvar erc-insert-timestamp-function) - (defvar erc-timestamp-format) - (defvar erc-timestamp-use-align-to) - (let ((erc-insert-modify-hook erc-insert-modify-hook) - (erc-insert-timestamp-function 'erc-insert-timestamp-right) - (erc-timestamp-use-align-to 0) - (erc-timestamp-format "[00:00]")) - (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook) - (erc-tests--get-inserted-msg-setup)) - (goto-char 19) - (should (looking-back (rx " hi [00:00]"))) - (erc-tests--assert-get-inserted-msg 3 19 test-fn)) - -;; This is a "mixin" and requires a base assertion function to work. -(defun erc-tests--assert-get-inserted-msg-readonly-with (assert-fn test-fn) - (defvar erc-readonly-mode) - (defvar erc-readonly-mode-hook) - (let ((erc-readonly-mode nil) - (erc-readonly-mode-hook nil) - (erc-send-post-hook erc-send-post-hook) - (erc-insert-post-hook erc-insert-post-hook)) - (erc-readonly-mode +1) - (funcall assert-fn test-fn))) - (ert-deftest erc--get-inserted-msg-beg/basic () - (erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) (ert-deftest erc--get-inserted-msg-end/basic () - (erc-tests--assert-get-inserted-msg/basic + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) -(ert-deftest erc--get-inserted-msg-end/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) - -(ert-deftest erc--get-inserted-msg-end/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) - -(ert-deftest erc--get-inserted-msg-end/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) - (ert-deftest erc--get-inserted-msg-bounds/basic () - (erc-tests--assert-get-inserted-msg/basic + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) -(ert-deftest erc--get-inserted-msg-bounds/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) - (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) - -(ert-deftest erc--get-inserted-msg-bounds/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) - (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) - -(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) - (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) - (ert-deftest erc--delete-inserted-message () (erc-mode) (erc--initialize-markers (point) nil) @@ -2631,8 +2500,8 @@ (should (equal (erc--format-speaker-input-message "oh my") expect)))) (ert-deftest erc--route-insertion () - (erc-tests--send-prep) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") (setq erc-networks--id (erc-networks--id-create 'foonet)) (let* ((erc-modules) ; for `erc--open-target' @@ -3018,30 +2887,6 @@ (erc-server-connect-function erc-open-network-stream)))))))) -(defun erc-tests--make-server-buf (name) - (with-current-buffer (get-buffer-create name) - (erc-mode) - (setq erc-server-process (start-process "sleep" (current-buffer) - "sleep" "1") - erc-session-server (concat "irc." name ".org") - erc-session-port 6667 - erc-network (intern name)) - (set-process-query-on-exit-flag erc-server-process nil) - (current-buffer))) - -(defun erc-tests--make-client-buf (server name) - (unless (bufferp server) - (setq server (get-buffer server))) - (with-current-buffer (get-buffer-create name) - (erc-mode) - (setq erc--target (erc--target-from-string name)) - (dolist (v '(erc-server-process - erc-session-server - erc-session-port - erc-network)) - (set v (buffer-local-value v server))) - (current-buffer))) - (ert-deftest erc-handle-irc-url () (let* (calls rvbuf @@ -3055,10 +2900,10 @@ (cl-letf (((symbol-function 'erc-cmd-JOIN) (lambda (&rest r) (push r calls)))) - (with-current-buffer (erc-tests--make-server-buf "foonet") + (with-current-buffer (erc-tests-common-make-server-buf "foonet") (setq rvbuf (current-buffer))) - (erc-tests--make-server-buf "barnet") - (erc-tests--make-server-buf "baznet") + (erc-tests-common-make-server-buf "barnet") + (erc-tests-common-make-server-buf "baznet") (ert-info ("Unknown network") (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc") @@ -3082,7 +2927,8 @@ (should-not calls)) (ert-info ("Known network, existing chan with key") - (erc-tests--make-client-buf "foonet" "#chan") + (save-excursion + (with-current-buffer "foonet" (erc--open-target "#chan"))) (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") (should (equal '("#chan" "sec") (pop calls))) (should-not calls)) @@ -3095,7 +2941,7 @@ (ert-info ("Unknown network, connect, chan") (with-current-buffer "foonet" (should-not (local-variable-p 'erc-after-connect))) - (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu"))) + (setq rvbuf (lambda () (erc-tests-common-make-server-buf "gnu"))) (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc") (should (equal '("irc" :server "irc.gnu.org") (pop calls))) (should-not calls) @@ -3107,10 +2953,7 @@ (should-not calls)))) (when noninteractive - (kill-buffer "foonet") - (kill-buffer "barnet") - (kill-buffer "baznet") - (kill-buffer "#chan"))) + (erc-tests-common-kill-buffers))) (ert-deftest erc-channel-user () ;; Traditional and alternate constructor swapped for compatibility. @@ -3201,31 +3044,7 @@ (should (eq (erc--normalize-module-symbol 'nickserv) 'services))) (defun erc-tests--assert-printed-in-subprocess (code expected) - (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) - ((string-prefix-p "erc-" found))) - (intern found) - 'erc)) - ;; This is for integrations testing with managed configs - ;; ("starter kits") that use a different package manager. - (init (and-let* ((found (getenv "ERC_TESTS_INIT")) - (files (split-string found ","))) - (mapcan (lambda (f) (list "-l" f)) files))) - (prog - `(progn - ,@(and (not init) (featurep 'compat) - `((require 'package) - (let ((package-load-list '((compat t) (,package t)))) - (package-initialize)))) - (require 'erc) - (cl-assert (equal erc-version ,erc-version) t) - ,code)) - (proc (apply #'start-process - (symbol-name (ert-test-name (ert-running-test))) - (current-buffer) - (concat invocation-directory invocation-name) - `("-batch" ,@(or init '("-Q")) - "-eval" ,(format "%S" prog))))) - (set-process-query-on-exit-flag proc t) + (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil))) (while (accept-process-output proc 10)) (goto-char (point-min)) (unless (equal (read (current-buffer)) expected) @@ -3573,38 +3392,11 @@ connection." (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) -(defun erc-tests--string-to-propertized-parts (string) - "Return a sequence of `propertize' forms for generating STRING. -Expect maintainers manipulating template catalogs to use this -with `pp-eval-last-sexp' or similar to convert back and forth -between literal strings." - `(concat - ,@(mapcar - (pcase-lambda (`(,beg ,end ,plist)) - ;; At the time of writing, `propertize' produces a string - ;; with the order of the input plist reversed. - `(propertize ,(substring-no-properties string beg end) - ,@(let (out) - (while-let ((plist) - (k (pop plist)) - (v (pop plist))) - (push (if (or (consp v) (symbolp v)) `',v v) out) - (push `',k out)) - out))) - (object-intervals string)))) - -(defun erc-tests-pp-propertized-parts (arg) - "Convert literal string before point into a `propertize'd form. -For simplicity, assume string evaluates to itself." - (interactive "P") - (let ((sexp (erc-tests--string-to-propertized-parts (pp-last-sexp)))) - (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) - -(ert-deftest erc-tests--string-to-propertized-parts () +(ert-deftest erc-tests-common-string-to-propertized-parts () :tags '(:unstable) ; only run this locally (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'")) - (should (equal (erc-tests--string-to-propertized-parts + (should (equal (erc-tests-common-string-to-propertized-parts #("abc" 0 1 (face default foo 1) 1 3 (face (default italic) bar "2"))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el new file mode 100644 index 00000000000..9d9cc4294bb --- /dev/null +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -0,0 +1,287 @@ +;;; erc-tests-common.el --- Common helpers for ERC tests -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file must *not* contain any `ert-deftest' definitions. See +;; top of test/lisp/erc/erc-tests.el for loading example. +;; +;; Environment variables: +;; +;; `ERC_PACKAGE_NAME': Name of the installed ERC package currently +;; running. ERC needs this in order to load the same package in +;; tests that run in a subprocess. Necessary even when the package +;; name is `erc' and not something like `erc-49860'. +;; +;; `ERC_TESTS_INIT': The name of an alternate init file. Mainly for +;; integrations tests involving starter kits. +;; +;; `ERC_TESTS_SNAPSHOT_SAVE': When set, ERC saves the current test's +;; snapshots to disk. +;; + +;;; Code: +(require 'ert-x) +(require 'erc) + +;; Caller should probably shadow `erc-insert-modify-hook' or populate +;; user tables for erc-button. +;; FIXME explain this comment ^ in more detail or delete. +(defun erc-tests-common-prep-for-insertion () + "Initialize current buffer with essentials for message insertion. +Assume caller intends to use `erc-display-message'." + (erc-mode) + (erc--initialize-markers (point) nil) + (should (= (point) erc-input-marker))) + +(defun erc-tests-common-init-server-proc (&rest args) + "Create a process with `start-process' from ARGS. +Assign the result to `erc-server-process' in the current buffer." + (setq erc-server-process + (apply #'start-process (car args) (current-buffer) args)) + (set-process-query-on-exit-flag erc-server-process nil) + erc-server-process) + +;; After dropping support for Emacs 27, callers can use +;; `get-buffer-create' with INHIBIT-BUFFER-HOOKS. +(defun erc-tests-common-kill-buffers (&rest extra-buffers) + "Kill all ERC buffers and possibly EXTRA-BUFFERS." + (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (dolist (buf (erc-buffer-list)) + (kill-buffer buf)) + (named-let doit ((buffers extra-buffers)) + (dolist (buf buffers) + (if (consp buf) (doit buf) (kill-buffer buf)))))) + +(defun erc-tests-common-with-process-input-spy (test-fn) + "Mock `erc-process-input-line' and call TEST-FN. +Shadow `erc--input-review-functions' and `erc-pre-send-functions' +with `erc-add-to-input-ring' removed. Shadow other relevant +variables as nil, and bind `erc-last-input-time' to 0. Also mock +`erc-server-buffer' to return the current buffer. Call TEST-FN +with a utility function that returns the set of arguments most +recently passed to the mocked `erc-process-input-line'. Make +`inhibit-message' non-nil unless running interactively." + (with-current-buffer (get-buffer-create "FakeNet") + (let* ((erc--input-review-functions + (remove 'erc-add-to-input-ring erc--input-review-functions)) + (erc-pre-send-functions + (remove 'erc-add-to-input-ring erc-pre-send-functions)) ; for now + (inhibit-message noninteractive) + (erc-server-current-nick "tester") + (erc-last-input-time 0) + erc-accidental-paste-threshold-seconds + erc-send-modify-hook + ;; + calls) + (cl-letf (((symbol-function 'erc-process-input-line) + (lambda (&rest r) (push r calls))) + ((symbol-function 'erc-server-buffer) + (lambda () (current-buffer)))) + (erc-tests-common-prep-for-insertion) + (funcall test-fn (lambda () (pop calls))))) + (when noninteractive (kill-buffer)))) + +(defun erc-tests-common-make-server-buf (name) + "Return a server buffer named NAME, creating it if necessary. +Use NAME for the network and the session server as well." + (with-current-buffer (get-buffer-create name) + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-session-server (concat "irc." name ".org") + erc-server-announced-name (concat "west." name ".org") + erc-session-port 6667 + erc-network (intern name) + erc-networks--id (erc-networks--id-create nil)) + (current-buffer))) + +(defun erc-tests-common-string-to-propertized-parts (string) + "Return a sequence of `propertize' forms for generating STRING. +Expect maintainers manipulating template catalogs to use this +with `pp-eval-last-sexp' or similar to convert back and forth +between literal strings." + `(concat + ,@(mapcar + (pcase-lambda (`(,beg ,end ,plist)) + ;; At the time of writing, `propertize' produces a string + ;; with the order of the input plist reversed. + `(propertize ,(substring-no-properties string beg end) + ,@(let (out) + (while-let ((plist) + (k (pop plist)) + (v (pop plist))) + (push (if (or (consp v) (symbolp v)) `',v v) out) + (push `',k out)) + out))) + (object-intervals string)))) + +(defun erc-tests-common-pp-propertized-parts (arg) + "Convert literal string before point into a `propertize'd form. +For simplicity, assume string evaluates to itself." + (interactive "P") + (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp)))) + (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) + +;; The following utilities are meant to help prepare tests for +;; `erc--get-inserted-msg-bounds' and friends. +(defun erc-tests-common-get-inserted-msg-setup () + (erc-tests-common-prep-for-insertion) + (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" + :sender "bob" + :command "PRIVMSG" + :command-args (list "#chan" "hi") + :contents "hi")) + (erc--msg-prop-overrides '((erc--ts . 0)))) + (erc-display-message parsed nil (current-buffer) + (erc-format-privmessage "bob" "hi" nil t))) + (goto-char 3) + (should (looking-at " hi"))) + +;; All these bounds-finding functions take an optional POINT argument. +;; So run each case with and without it at each pos in the message. +(defun erc-tests-common-assert-get-inserted-msg (from to assert-fn) + (dolist (pt-arg '(nil t)) + (dolist (i (number-sequence from to)) + (goto-char i) + (ert-info ((format "At %d (%c) %s param" i (char-after i) + (if pt-arg "with" ""))) + (funcall assert-fn (and pt-arg i)))))) + +(defun erc-tests-common-assert-get-inserted-msg/basic (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (goto-char 11) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) + +;; This is a "mixin" and requires a base assertion function, like +;; `erc-tests-common-assert-get-inserted-msg/basic', to work. +(defun erc-tests-common-assert-get-inserted-msg-readonly-with + (assert-fn test-fn) + (defvar erc-readonly-mode) + (defvar erc-readonly-mode-hook) + (let ((erc-readonly-mode nil) + (erc-readonly-mode-hook nil) + (erc-send-post-hook erc-send-post-hook) + (erc-insert-post-hook erc-insert-post-hook)) + (erc-readonly-mode +1) + (funcall assert-fn test-fn))) + + +;;;; Buffer snapshots + +;; Use this variable to generate new snapshots after carefully +;; reviewing the output of *each* snapshot (not just first and last). +;; Obviously, only run one test at a time. +(defvar erc-tests-common-snapshot-save-p (getenv "ERC_TESTS_SNAPSHOT_SAVE")) + +(defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn) + "Compare `buffer-string' to snapshot NAME.eld in DIR, if present. +When non-nil, run TRANS-FN to fiter the current buffer string, +and expect a similar string in return. Call BUF-INIT-FN, when +non-nil, in the preview buffer after inserting the filtered +string." + (let* ((expect-file (file-name-with-extension (expand-file-name name dir) + "eld")) + (erc--own-property-names + (seq-difference `(font-lock-face ,@erc--own-property-names) + `(field display wrap-prefix line-prefix + erc--msg erc--cmd erc--spkr erc--ts erc--ctcp + erc--ephemeral) + #'eq)) + (print-circle t) + (print-escape-newlines t) + (print-escape-nonascii t) + (got (erc--remove-text-properties + (buffer-substring (point-min) erc-insert-marker))) + (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))) + (with-current-buffer (generate-new-buffer name) + (with-silent-modifications + (insert (setq got (read repr)))) + (when buf-init-fn (funcall buf-init-fn)) + (erc-mode)) + ;; LHS is a string, RHS is a symbol. + (if (string= erc-tests-common-snapshot-save-p + (ert-test-name (ert-running-test))) + (let (inhibit-message) + (with-temp-file expect-file + (insert repr)) + ;; Limit writing snapshots to one test at a time. + (message "erc-tests-common-snapshot-compare: wrote %S" expect-file)) + (if (file-exists-p expect-file) + ;; Ensure string-valued properties, like timestamps, aren't + ;; recursive (signals `max-lisp-eval-depth' exceeded). + (named-let assert-equal + ((latest (read repr)) + (expect (read (with-temp-buffer + (insert-file-contents-literally expect-file) + (buffer-string))))) + (pcase latest + ((or "" 'nil) t) + ((pred stringp) + (should (equal-including-properties latest expect)) + (let ((latest-intervals (object-intervals latest)) + (expect-intervals (object-intervals expect))) + (while-let ((l-iv (pop latest-intervals)) + (x-iv (pop expect-intervals)) + (l-tab (map-into (nth 2 l-iv) 'hash-table)) + (x-tab (map-into (nth 2 x-iv) 'hash-table))) + (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab)) + (assert-equal l-v (gethash l-k x-tab)) + (remhash l-k x-tab)) + (should (zerop (hash-table-count x-tab)))))) + ((pred sequencep) + (assert-equal (seq-first latest) (seq-first expect)) + (assert-equal (seq-rest latest) (seq-rest expect))) + (_ (should (equal latest expect))))) + (message "Snapshot file missing: %S" expect-file))))) + +(defun erc-tests-common-create-subprocess (code switches libs) + "Return subprocess for running CODE in an inferior Emacs. +Include SWITCHES, like \"-batch\", as well as libs, after +interspersing \"-l\" between members." + (let* ((package (if-let ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) + (intern found) + 'erc)) + ;; For integrations testing with managed configs that use a + ;; different package manager. + (init (and-let* ((found (getenv "ERC_TESTS_INIT")) + (files (split-string found ","))) + (mapcan (lambda (f) (list "-l" f)) files))) + (prog + `(progn + ,@(and (not init) (featurep 'compat) + `((require 'package) + (let ((package-load-list '((compat t) (,package t)))) + (package-initialize)))) + (require 'erc) + (cl-assert (equal erc-version ,erc-version) t) + ,code)) + (proc (apply #'start-process + (symbol-name (ert-test-name (ert-running-test))) + (current-buffer) + (concat invocation-directory invocation-name) + `(,@(or init '("-Q")) + ,@switches + ,@(mapcan (lambda (f) (list "-l" f)) libs) + "-eval" ,(format "%S" prog))))) + (set-process-query-on-exit-flag proc t) + proc)) + +(provide 'erc-tests-common) -- 2.39.2