[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 7097be8ef60 4/5: Move ERC test utilities to common file
|
From: |
F. Jason Park |
|
Subject: |
master 7097be8ef60 4/5: Move ERC test utilities to common file |
|
Date: |
Thu, 28 Dec 2023 00:47:21 -0500 (EST) |
branch: master
commit 7097be8ef601a20cdcd5d3a2bf2b1e33f2124981
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
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(-)
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 "<bob> 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 "<bob> 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 "<bob> 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 "<bob> 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 "<bob> 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 "<bob> 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)