aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2023-12-24 12:21:49 -0800
committerF. Jason Park2023-12-27 21:32:25 -0800
commit7097be8ef601a20cdcd5d3a2bf2b1e33f2124981 (patch)
tree98608ecc405f7920bf3f04ce53abfda7b7989599
parentc83a2d15097e39d2a46d898f7731ca592c59e5a7 (diff)
downloademacs-7097be8ef601a20cdcd5d3a2bf2b1e33f2124981.tar.gz
emacs-7097be8ef601a20cdcd5d3a2bf2b1e33f2124981.zip
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.
-rw-r--r--lisp/erc/erc-common.el6
-rw-r--r--test/lisp/erc/erc-button-tests.el25
-rw-r--r--test/lisp/erc/erc-fill-tests.el92
-rw-r--r--test/lisp/erc/erc-goodies-tests.el21
-rw-r--r--test/lisp/erc/erc-networks-tests.el20
-rw-r--r--test/lisp/erc/erc-scenarios-internal.el19
-rw-r--r--test/lisp/erc/erc-scenarios-sasl.el1
-rw-r--r--test/lisp/erc/erc-stamp-tests.el52
-rw-r--r--test/lisp/erc/erc-tests.el290
-rw-r--r--test/lisp/erc/resources/erc-tests-common.el287
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."
551 "Define `erc-display-message' formatting templates for NAME, a symbol. 551 "Define `erc-display-message' formatting templates for NAME, a symbol.
552 552
553See `erc-define-message-format-catalog' for the meaning of 553See `erc-define-message-format-catalog' for the meaning of
554ENTRIES, an alist. Also see `erc-tests-pp-propertized-parts' in 554ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in
555tests/lisp/erc/erc-tests.el for a convenience command to convert 555tests/lisp/erc/erc-tests.el for a convenience command to convert
556a literal string into a sequence of `propertize' forms, which 556a literal string into a sequence of `propertize' forms, which are
557are much easier to review and edit." 557much easier to review and edit."
558 (declare (indent 1)) 558 (declare (indent 1))
559 (let (out) 559 (let (out)
560 (dolist (e entries (cons 'progn (nreverse out))) 560 (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 @@
21 21
22;;; Code: 22;;; Code:
23 23
24(require 'ert-x) ; cl-lib
25(eval-and-compile
26 (let ((load-path (cons (ert-resource-directory) load-path)))
27 (require 'erc-tests-common)))
28
24(require 'erc-button) 29(require 'erc-button)
25 30
26(ert-deftest erc-button-alist--url () 31(ert-deftest erc-button-alist--url ()
27 (setq erc-server-process 32 (erc-tests-common-init-server-proc "sleep" "1")
28 (start-process "sleep" (current-buffer) "sleep" "1"))
29 (set-process-query-on-exit-flag erc-server-process nil)
30 (with-current-buffer (erc--open-target "#chan") 33 (with-current-buffer (erc--open-target "#chan")
31 (let ((verify 34 (let ((verify
32 (lambda (p url) 35 (lambda (p url)
@@ -65,9 +68,7 @@
65 (apply #'erc-button-add-button rest)) 68 (apply #'erc-button-add-button rest))
66 69
67(defun erc-button-tests--erc-button-alist--function-as-form (func) 70(defun erc-button-tests--erc-button-alist--function-as-form (func)
68 (setq erc-server-process 71 (erc-tests-common-init-server-proc "sleep" "1")
69 (start-process "sleep" (current-buffer) "sleep" "1"))
70 (set-process-query-on-exit-flag erc-server-process nil)
71 72
72 (with-current-buffer (erc--open-target "#chan") 73 (with-current-buffer (erc--open-target "#chan")
73 (let* ((erc-button-tests--form nil) 74 (let* ((erc-button-tests--form nil)
@@ -102,9 +103,7 @@
102 (apply #'erc-button-add-button r)))) 103 (apply #'erc-button-add-button r))))
103 104
104(defun erc-button-tests--erc-button-alist--nil-form (form) 105(defun erc-button-tests--erc-button-alist--nil-form (form)
105 (setq erc-server-process 106 (erc-tests-common-init-server-proc "sleep" "1")
106 (start-process "sleep" (current-buffer) "sleep" "1"))
107 (set-process-query-on-exit-flag erc-server-process nil)
108 107
109 (with-current-buffer (erc--open-target "#chan") 108 (with-current-buffer (erc--open-target "#chan")
110 (let* ((erc-button-tests--form nil) 109 (let* ((erc-button-tests--form nil)
@@ -228,11 +227,9 @@
228 (inhibit-message noninteractive) 227 (inhibit-message noninteractive)
229 erc-modules 228 erc-modules
230 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) 229 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
231 (erc-mode) 230 (erc-tests-common-prep-for-insertion)
232 (setq erc-server-process 231 (erc-tests-common-init-server-proc "sleep" "1")
233 (start-process "sleep" (current-buffer) "sleep" "1")) 232
234 (set-process-query-on-exit-flag erc-server-process nil)
235 (erc--initialize-markers (point) nil)
236 (erc-button-mode +1) 233 (erc-button-mode +1)
237 (should (equal (erc-button--display-error-notice-with-keys 234 (should (equal (erc-button--display-error-notice-with-keys
238 "If \\[erc-bol] fails, " 235 "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 @@
24 24
25;;; Code: 25;;; Code:
26(require 'ert-x) 26(require 'ert-x)
27(eval-and-compile
28 (let ((load-path (cons (ert-resource-directory) load-path)))
29 (require 'erc-tests-common)))
30
27(require 'erc-fill) 31(require 'erc-fill)
28 32
29(defvar erc-fill-tests--buffers nil) 33(defvar erc-fill-tests--buffers nil)
@@ -58,9 +62,7 @@
58 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) 62 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
59 (cl-letf (((symbol-function 'erc-server-connect) 63 (cl-letf (((symbol-function 'erc-server-connect)
60 (lambda (&rest _) 64 (lambda (&rest _)
61 (setq erc-server-process 65 (erc-tests-common-init-server-proc "sleep" "1"))))
62 (start-process "sleep" (current-buffer) "sleep" "1"))
63 (set-process-query-on-exit-flag erc-server-process nil))))
64 (with-current-buffer 66 (with-current-buffer
65 (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect 67 (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect
66 nil nil nil nil nil "tester" 'foonet) 68 nil nil nil nil nil "tester" 'foonet)
@@ -106,10 +108,9 @@
106 (when set-transient-map-timer 108 (when set-transient-map-timer
107 (timer-event-handler set-transient-map-timer)) 109 (timer-event-handler set-transient-map-timer))
108 (set-window-buffer (selected-window) original-window-buffer) 110 (set-window-buffer (selected-window) original-window-buffer)
109 (when noninteractive 111 (when (or noninteractive (getenv "ERC_TESTS_GRAPHICAL"))
110 (while-let ((buf (pop erc-fill-tests--buffers))) 112 (erc-tests-common-kill-buffers erc-fill-tests--buffers)
111 (kill-buffer buf)) 113 (setq erc-fill-tests--buffers nil))))))))
112 (kill-buffer))))))))
113 114
114(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes) 115(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes)
115 ;; Check that prefix props are applied over correct intervals. 116 ;; Check that prefix props are applied over correct intervals.
@@ -134,74 +135,21 @@
134 (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix) 135 (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix)
135 '(space :width erc-fill--wrap-value)))))) 136 '(space :width erc-fill--wrap-value))))))
136 137
137;; Use this variable to generate new snapshots after carefully
138;; reviewing the output of *each* snapshot (not just first and last).
139;; Obviously, only run one test at a time.
140(defvar erc-fill-tests--save-p (getenv "ERC_TESTS_FILL_SAVE"))
141
142;; On graphical displays, echo .graphic >> .git/info/exclude 138;; On graphical displays, echo .graphic >> .git/info/exclude
143(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic") 139(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic/")
144 140
145(defun erc-fill-tests--compare (name) 141(defun erc-fill-tests--compare (name)
146 (let* ((dir (expand-file-name (if (display-graphic-p) 142 (let ((dir (expand-file-name (if (display-graphic-p)
147 erc-fill-tests--graphic-dir 143 erc-fill-tests--graphic-dir
148 "fill/snapshots/") 144 "fill/snapshots/" )
149 (ert-resource-directory))) 145 (ert-resource-directory)))
150 (expect-file (file-name-with-extension (expand-file-name name dir) 146 (transform-fn (lambda (got)
151 "eld")) 147 (string-replace "erc-fill--wrap-value"
152 (erc--own-property-names 148 (number-to-string erc-fill--wrap-value)
153 (seq-difference `(font-lock-face ,@erc--own-property-names) 149 got)))
154 `(field display wrap-prefix line-prefix 150 (buffer-setup-fn (lambda ()
155 erc--msg erc--cmd erc--spkr erc--ts erc--ctcp 151 (push (current-buffer) erc-fill-tests--buffers))))
156 erc--ephemeral) 152 (erc-tests-common-snapshot-compare name dir transform-fn buffer-setup-fn)))
157 #'eq))
158 (print-circle t)
159 (print-escape-newlines t)
160 (print-escape-nonascii t)
161 (got (erc--remove-text-properties
162 (buffer-substring (point-min) erc-insert-marker)))
163 (repr (string-replace "erc-fill--wrap-value"
164 (number-to-string erc-fill--wrap-value)
165 (prin1-to-string got))))
166 (with-current-buffer (generate-new-buffer name)
167 (push (current-buffer) erc-fill-tests--buffers)
168 (with-silent-modifications
169 (insert (setq got (read repr))))
170 (erc-mode))
171 ;; LHS is a string, RHS is a symbol.
172 (if (string= erc-fill-tests--save-p (ert-test-name (ert-running-test)))
173 (let (inhibit-message)
174 (with-temp-file expect-file
175 (insert repr))
176 ;; Limit writing snapshots to one test at a time.
177 (message "erc-fill-tests--compare: wrote %S" expect-file))
178 (if (file-exists-p expect-file)
179 ;; Ensure string-valued properties, like timestamps, aren't
180 ;; recursive (signals `max-lisp-eval-depth' exceeded).
181 (named-let assert-equal
182 ((latest (read repr))
183 (expect (read (with-temp-buffer
184 (insert-file-contents-literally expect-file)
185 (buffer-string)))))
186 (pcase latest
187 ((or "" 'nil) t)
188 ((pred stringp)
189 (should (equal-including-properties latest expect))
190 (let ((latest-intervals (object-intervals latest))
191 (expect-intervals (object-intervals expect)))
192 (while-let ((l-iv (pop latest-intervals))
193 (x-iv (pop expect-intervals))
194 (l-tab (map-into (nth 2 l-iv) 'hash-table))
195 (x-tab (map-into (nth 2 x-iv) 'hash-table)))
196 (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
197 (assert-equal l-v (gethash l-k x-tab))
198 (remhash l-k x-tab))
199 (should (zerop (hash-table-count x-tab))))))
200 ((pred sequencep)
201 (assert-equal (seq-first latest) (seq-first expect))
202 (assert-equal (seq-rest latest) (seq-rest expect)))
203 (_ (should (equal latest expect)))))
204 (message "Snapshot file missing: %S" expect-file)))))
205 153
206;; To inspect variable pitch, set `erc-mode-hook' to 154;; To inspect variable pitch, set `erc-mode-hook' to
207;; 155;;
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 @@
20;;; Commentary: 20;;; Commentary:
21;;; Code: 21;;; Code:
22(require 'ert-x) 22(require 'ert-x)
23(eval-and-compile
24 (let ((load-path (cons (ert-resource-directory) load-path)))
25 (require 'erc-tests-common)))
26
23(require 'erc-goodies) 27(require 'erc-goodies)
24 28
25(defun erc-goodies-tests--assert-face (beg end-str present &optional absent) 29(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
@@ -420,4 +424,21 @@
420 (goto-char (overlay-start erc--keep-place-indicator-overlay)) 424 (goto-char (overlay-start erc--keep-place-indicator-overlay))
421 (should (looking-at (rx "*** This buffer is for text"))))))) 425 (should (looking-at (rx "*** This buffer is for text")))))))
422 426
427(ert-deftest erc--get-inserted-msg-beg/readonly ()
428 (erc-tests-common-assert-get-inserted-msg-readonly-with
429 #'erc-tests-common-assert-get-inserted-msg/basic
430 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
431
432(ert-deftest erc--get-inserted-msg-end/readonly ()
433 (erc-tests-common-assert-get-inserted-msg-readonly-with
434 #'erc-tests-common-assert-get-inserted-msg/basic
435 (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
436
437(ert-deftest erc--get-inserted-msg-bounds/readonly ()
438 (erc-tests-common-assert-get-inserted-msg-readonly-with
439 #'erc-tests-common-assert-get-inserted-msg/basic
440 (lambda (arg)
441 (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
442
443
423;;; erc-goodies-tests.el ends here 444;;; 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 @@
20;;; Code: 20;;; Code:
21 21
22(require 'ert-x) ; cl-lib 22(require 'ert-x) ; cl-lib
23(require 'erc) 23(eval-and-compile
24 (let ((load-path (cons (ert-resource-directory) load-path)))
25 (require 'erc-tests-common)))
24 26
25(defun erc-networks-tests--create-dead-proc (&optional buf) 27(defun erc-networks-tests--create-dead-proc (&optional buf)
26 (let ((p (start-process "true" (or buf (current-buffer)) "true"))) 28 (let ((p (start-process "true" (or buf (current-buffer)) "true")))
27 (while (process-live-p p) (sit-for 0.1)) 29 (while (process-live-p p) (sit-for 0.1))
28 p)) 30 p))
29 31
30(defun erc-networks-tests--create-live-proc (&optional buf) 32(defun erc-networks-tests--create-live-proc ()
31 (let ((proc (start-process "sleep" (or buf (current-buffer)) "sleep" "1"))) 33 (erc-tests-common-init-server-proc "sleep" "1"))
32 (set-process-query-on-exit-flag proc nil)
33 proc))
34 34
35;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS. 35;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS.
36(defun erc-networks-tests--clean-bufs () 36(defun erc-networks-tests--clean-bufs ()
37 (let (erc-kill-channel-hook 37 (erc-tests-common-kill-buffers))
38 erc-kill-server-hook
39 erc-kill-buffer-hook)
40 (dolist (buf (erc-buffer-list))
41 (kill-buffer buf))))
42 38
43(defun erc-networks-tests--bufnames (prefix) 39(defun erc-networks-tests--bufnames (prefix)
44 (let* ((case-fold-search) 40 (let* ((case-fold-search)
@@ -1442,10 +1438,12 @@
1442 (let* (erc-kill-server-hook 1438 (let* (erc-kill-server-hook
1443 erc-insert-modify-hook 1439 erc-insert-modify-hook
1444 (old-buf (get-buffer-create "FooNet")) 1440 (old-buf (get-buffer-create "FooNet"))
1445 (old-proc (erc-networks-tests--create-live-proc old-buf))) ; live 1441 ;;
1442 old-proc) ; live
1446 1443
1447 (with-current-buffer old-buf 1444 (with-current-buffer old-buf
1448 (erc-mode) 1445 (erc-mode)
1446 (setq old-proc (erc-networks-tests--create-live-proc))
1449 (erc--initialize-markers (point) nil) 1447 (erc--initialize-markers (point) nil)
1450 (insert "*** Old buf") 1448 (insert "*** Old buf")
1451 (setq erc-network 'FooNet 1449 (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 @@
24 (when (and (getenv "EMACS_TEST_DIRECTORY") 24 (when (and (getenv "EMACS_TEST_DIRECTORY")
25 (getenv "EMACS_TEST_JUNIT_REPORT")) 25 (getenv "EMACS_TEST_JUNIT_REPORT"))
26 (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name))) 26 (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name)))
27 (let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory)) 27 (let ((load-path `(,(expand-file-name "erc-d" (ert-resource-directory))
28 load-path))) 28 ,(ert-resource-directory)
29 (load "erc-d-tests" nil 'silent))) 29 ,@load-path)))
30 ;; Run all tests in ./resources/erc-d/erc-d-tests.el.
31 (load "erc-d-tests" nil 'silent)
32 (require 'erc-tests-common)))
30 33
31;; Run all tests tagged `:erc--graphical' in an "interactive" 34;; Run all tests tagged `:erc--graphical' in an "interactive"
32;; subprocess. Time out after 90 seconds. 35;; subprocess. Time out after 90 seconds.
@@ -45,13 +48,9 @@
45 (with-current-buffer ert--output-buffer-name 48 (with-current-buffer ert--output-buffer-name
46 (kill-emacs (ert--stats-failed-unexpected 49 (kill-emacs (ert--stats-failed-unexpected
47 ert--results-stats))))) 50 ert--results-stats)))))
48 (args `("erc-interactive-all" ,(current-buffer) 51 (proc (erc-tests-common-create-subprocess program
49 ,(concat invocation-directory invocation-name) 52 '( "-L" "." "-l" "ert")
50 "-Q" "-L" "." "-l" "ert" 53 libs)))
51 ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o)
52 "-eval" ,(format "%S" program)))
53 (proc (apply #'start-process args)))
54 (set-process-query-on-exit-flag proc nil)
55 54
56 (erc-d-t-wait-for 90 "interactive tests to complete" 55 (erc-d-t-wait-for 90 "interactive tests to complete"
57 (not (process-live-p proc))) 56 (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 @@
151 (erc-sasl-mechanism 'plain) 151 (erc-sasl-mechanism 'plain)
152 (erc--warnings-buffer-name "*ERC test warnings*") 152 (erc--warnings-buffer-name "*ERC test warnings*")
153 (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) 153 (warnings-buffer (get-buffer-create erc--warnings-buffer-name))
154 (inhibit-message noninteractive)
154 (expect (erc-d-t-make-expecter))) 155 (expect (erc-d-t-make-expecter)))
155 156
156 (with-current-buffer (erc :server "127.0.0.1" 157 (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 @@
21 21
22;;; Code: 22;;; Code:
23(require 'ert-x) 23(require 'ert-x)
24(eval-and-compile
25 (let ((load-path (cons (ert-resource-directory) load-path)))
26 (require 'erc-tests-common)))
27
24(require 'erc-stamp) 28(require 'erc-stamp)
25(require 'erc-goodies) ; for `erc-make-read-only' 29(require 'erc-goodies) ; for `erc-make-read-only'
26 30
@@ -44,9 +48,7 @@
44 (erc-mode) 48 (erc-mode)
45 (erc-munge-invisibility-spec) 49 (erc-munge-invisibility-spec)
46 (erc--initialize-markers (point) nil) 50 (erc--initialize-markers (point) nil)
47 (setq erc-server-process (start-process "p" (current-buffer) 51 (erc-tests-common-init-server-proc "sleep" "1")
48 "sleep" "1"))
49 (set-process-query-on-exit-flag erc-server-process nil)
50 52
51 (funcall test) 53 (funcall test)
52 54
@@ -223,13 +225,13 @@
223 (erc-timestamp-intangible t) ; default changed to nil in 2014 225 (erc-timestamp-intangible t) ; default changed to nil in 2014
224 (erc-hide-timestamps t) 226 (erc-hide-timestamps t)
225 (erc-insert-timestamp-function 'erc-insert-timestamp-left) 227 (erc-insert-timestamp-function 'erc-insert-timestamp-left)
226 (erc-server-process (start-process "true" (current-buffer) "true"))
227 (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) 228 (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp))
228 msg 229 msg
229 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) 230 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
230 (should (not cursor-sensor-inhibit)) 231 (should (not cursor-sensor-inhibit))
231 (set-process-query-on-exit-flag erc-server-process nil) 232
232 (erc-mode) 233 (erc-mode)
234 (erc-tests-common-init-server-proc "true")
233 (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") 235 (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
234 (erc-mode) 236 (erc-mode)
235 (erc--initialize-markers (point) nil) 237 (erc--initialize-markers (point) nil)
@@ -307,4 +309,44 @@
307 (should (equal (call-interactively #'erc-echo-timestamp) 309 (should (equal (call-interactively #'erc-echo-timestamp)
308 "1983-09-26 21:00:00 -07"))))) 310 "1983-09-26 21:00:00 -07")))))
309 311
312(defun erc-stamp-tests--assert-get-inserted-msg/stamp (test-fn)
313 (let ((erc-insert-modify-hook erc-insert-modify-hook)
314 (erc-insert-timestamp-function 'erc-insert-timestamp-right)
315 (erc-timestamp-use-align-to 0)
316 (erc-timestamp-format "[00:00]"))
317 (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook)
318 (erc-tests-common-get-inserted-msg-setup))
319 (goto-char 19)
320 (should (looking-back (rx "<bob> hi [00:00]")))
321 (erc-tests-common-assert-get-inserted-msg 3 19 test-fn))
322
323(ert-deftest erc--get-inserted-msg-beg/stamp ()
324 (erc-stamp-tests--assert-get-inserted-msg/stamp
325 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
326
327(ert-deftest erc--get-inserted-msg-beg/readonly/stamp ()
328 (erc-tests-common-assert-get-inserted-msg-readonly-with
329 #'erc-stamp-tests--assert-get-inserted-msg/stamp
330 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
331
332(ert-deftest erc--get-inserted-msg-end/stamp ()
333 (erc-stamp-tests--assert-get-inserted-msg/stamp
334 (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
335
336(ert-deftest erc--get-inserted-msg-end/readonly/stamp ()
337 (erc-tests-common-assert-get-inserted-msg-readonly-with
338 #'erc-stamp-tests--assert-get-inserted-msg/stamp
339 (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
340
341(ert-deftest erc--get-inserted-msg-bounds/stamp ()
342 (erc-stamp-tests--assert-get-inserted-msg/stamp
343 (lambda (arg)
344 (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
345
346(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp ()
347 (erc-tests-common-assert-get-inserted-msg-readonly-with
348 #'erc-stamp-tests--assert-get-inserted-msg/stamp
349 (lambda (arg)
350 (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
351
310;;; erc-stamp-tests.el ends here 352;;; 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 @@
22;;; Code: 22;;; Code:
23 23
24(require 'ert-x) 24(require 'ert-x)
25(require 'erc) 25(eval-and-compile
26 (let ((load-path (cons (ert-resource-directory) load-path)))
27 (require 'erc-tests-common)))
28
26(require 'erc-ring) 29(require 'erc-ring)
27 30
28(ert-deftest erc--read-time-period () 31(ert-deftest erc--read-time-period ()
@@ -113,7 +116,7 @@
113 116
114(ert-deftest erc-with-server-buffer () 117(ert-deftest erc-with-server-buffer ()
115 (setq erc-away 1) 118 (setq erc-away 1)
116 (erc-tests--set-fake-server-process "sleep" "1") 119 (erc-tests-common-init-server-proc "sleep" "1")
117 120
118 (let (mockingp calls) 121 (let (mockingp calls)
119 (advice-add 'buffer-local-value :after 122 (advice-add 'buffer-local-value :after
@@ -155,34 +158,22 @@
155 (when (cl-evenp c) (push c out))))) 158 (when (cl-evenp c) (push c out)))))
156 (should (equal out '(?f ?d ?b))))) 159 (should (equal out '(?f ?d ?b)))))
157 160
158(defun erc-tests--send-prep ()
159 ;; Caller should probably shadow `erc-insert-modify-hook' or
160 ;; populate user tables for erc-button.
161 (erc-mode)
162 (erc--initialize-markers (point) nil)
163 (should (= (point) erc-input-marker)))
164
165(defun erc-tests--set-fake-server-process (&rest args)
166 (setq erc-server-process
167 (apply #'start-process (car args) (current-buffer) args))
168 (set-process-query-on-exit-flag erc-server-process nil))
169
170(ert-deftest erc-hide-prompt () 161(ert-deftest erc-hide-prompt ()
171 (let ((erc-hide-prompt erc-hide-prompt) 162 (let ((erc-hide-prompt erc-hide-prompt)
172 ;; 163 ;;
173 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) 164 erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
174 165
175 (with-current-buffer (get-buffer-create "ServNet") 166 (with-current-buffer (get-buffer-create "ServNet")
176 (erc-tests--send-prep) 167 (erc-tests-common-prep-for-insertion)
177 (goto-char erc-insert-marker) 168 (goto-char erc-insert-marker)
178 (should (looking-at-p (regexp-quote erc-prompt))) 169 (should (looking-at-p (regexp-quote erc-prompt)))
179 (erc-tests--set-fake-server-process "sleep" "1") 170 (erc-tests-common-init-server-proc "sleep" "1")
180 (set-process-sentinel erc-server-process #'ignore) 171 (set-process-sentinel erc-server-process #'ignore)
181 (setq erc-network 'ServNet) 172 (setq erc-network 'ServNet)
182 (set-process-query-on-exit-flag erc-server-process nil)) 173 (set-process-query-on-exit-flag erc-server-process nil))
183 174
184 (with-current-buffer (get-buffer-create "#chan") 175 (with-current-buffer (get-buffer-create "#chan")
185 (erc-tests--send-prep) 176 (erc-tests-common-prep-for-insertion)
186 (goto-char erc-insert-marker) 177 (goto-char erc-insert-marker)
187 (should (looking-at-p (regexp-quote erc-prompt))) 178 (should (looking-at-p (regexp-quote erc-prompt)))
188 (setq erc-server-process (buffer-local-value 'erc-server-process 179 (setq erc-server-process (buffer-local-value 'erc-server-process
@@ -190,7 +181,7 @@
190 erc--target (erc--target-from-string "#chan"))) 181 erc--target (erc--target-from-string "#chan")))
191 182
192 (with-current-buffer (get-buffer-create "bob") 183 (with-current-buffer (get-buffer-create "bob")
193 (erc-tests--send-prep) 184 (erc-tests-common-prep-for-insertion)
194 (goto-char erc-insert-marker) 185 (goto-char erc-insert-marker)
195 (should (looking-at-p (regexp-quote erc-prompt))) 186 (should (looking-at-p (regexp-quote erc-prompt)))
196 (setq erc-server-process (buffer-local-value 'erc-server-process 187 (setq erc-server-process (buffer-local-value 'erc-server-process
@@ -318,10 +309,10 @@
318 309
319 (ert-info ("Server buffer") 310 (ert-info ("Server buffer")
320 (with-current-buffer (get-buffer-create "ServNet") 311 (with-current-buffer (get-buffer-create "ServNet")
321 (erc-tests--send-prep) 312 (erc-tests-common-prep-for-insertion)
322 (goto-char erc-insert-marker) 313 (goto-char erc-insert-marker)
323 (should (looking-at-p "ServNet 3>")) 314 (should (looking-at-p "ServNet 3>"))
324 (erc-tests--set-fake-server-process "sleep" "1") 315 (erc-tests-common-init-server-proc "sleep" "1")
325 (set-process-sentinel erc-server-process #'ignore) 316 (set-process-sentinel erc-server-process #'ignore)
326 (setq erc-network 'ServNet 317 (setq erc-network 'ServNet
327 erc-server-current-nick "tester" 318 erc-server-current-nick "tester"
@@ -353,7 +344,7 @@
353 344
354 (ert-info ("Channel buffer") 345 (ert-info ("Channel buffer")
355 (with-current-buffer (get-buffer-create "#chan") 346 (with-current-buffer (get-buffer-create "#chan")
356 (erc-tests--send-prep) 347 (erc-tests-common-prep-for-insertion)
357 (goto-char erc-insert-marker) 348 (goto-char erc-insert-marker)
358 (should (looking-at-p "#chan 9>")) 349 (should (looking-at-p "#chan 9>"))
359 (goto-char erc-input-marker) 350 (goto-char erc-input-marker)
@@ -546,7 +537,7 @@
546 537
547(ert-deftest erc-setup-buffer--custom-action () 538(ert-deftest erc-setup-buffer--custom-action ()
548 (erc-mode) 539 (erc-mode)
549 (erc-tests--set-fake-server-process "sleep" "1") 540 (erc-tests-common-init-server-proc "sleep" "1")
550 (setq erc--server-last-reconnect-count 0) 541 (setq erc--server-last-reconnect-count 0)
551 (let ((owin (selected-window)) 542 (let ((owin (selected-window))
552 (obuf (window-buffer)) 543 (obuf (window-buffer))
@@ -677,7 +668,7 @@
677 668
678(ert-deftest erc--parsed-prefix () 669(ert-deftest erc--parsed-prefix ()
679 (erc-mode) 670 (erc-mode)
680 (erc-tests--set-fake-server-process "sleep" "1") 671 (erc-tests-common-init-server-proc "sleep" "1")
681 (setq erc--isupport-params (make-hash-table)) 672 (setq erc--isupport-params (make-hash-table))
682 673
683 ;; Uses fallback values when no PREFIX parameter yet received, thus 674 ;; Uses fallback values when no PREFIX parameter yet received, thus
@@ -755,7 +746,7 @@
755 erc-server-users (make-hash-table :test #'equal) 746 erc-server-users (make-hash-table :test #'equal)
756 erc--isupport-params (make-hash-table) 747 erc--isupport-params (make-hash-table)
757 erc--target (erc--target-from-string "#test")) 748 erc--target (erc--target-from-string "#test"))
758 (erc-tests--set-fake-server-process "sleep" "1") 749 (erc-tests-common-init-server-proc "sleep" "1")
759 750
760 (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) 751 (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
761 calls) 752 calls)
@@ -845,7 +836,7 @@
845 erc-server-parameters 836 erc-server-parameters
846 '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) 837 '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
847 838
848 (erc-tests--set-fake-server-process "sleep" "1") 839 (erc-tests-common-init-server-proc "sleep" "1")
849 840
850 (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) 841 (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
851 (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) 842 (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
@@ -890,7 +881,7 @@
890 '(:erc--graphical))) 881 '(:erc--graphical)))
891 (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) 882 (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant"))
892 883
893 (erc-tests--set-fake-server-process "sleep" "1") 884 (erc-tests-common-init-server-proc "sleep" "1")
894 (setq erc--isupport-params (make-hash-table) 885 (setq erc--isupport-params (make-hash-table)
895 erc--target (erc--target-from-string "#test") 886 erc--target (erc--target-from-string "#test")
896 erc-server-parameters 887 erc-server-parameters
@@ -1200,7 +1191,7 @@
1200(ert-deftest erc-ring-previous-command () 1191(ert-deftest erc-ring-previous-command ()
1201 (with-current-buffer (get-buffer-create "*#fake*") 1192 (with-current-buffer (get-buffer-create "*#fake*")
1202 (erc-mode) 1193 (erc-mode)
1203 (erc-tests--send-prep) 1194 (erc-tests-common-prep-for-insertion)
1204 (setq erc-server-current-nick "tester") 1195 (setq erc-server-current-nick "tester")
1205 (setq-local erc-last-input-time 0) 1196 (setq-local erc-last-input-time 0)
1206 (should-not (local-variable-if-set-p 'erc-send-completed-hook)) 1197 (should-not (local-variable-if-set-p 'erc-send-completed-hook))
@@ -1381,29 +1372,8 @@
1381 (should (equal '("" "" "") (split-string "\n\n" p))) 1372 (should (equal '("" "" "") (split-string "\n\n" p)))
1382 (should (equal '("" "" "") (split-string "\n\r" p))))) 1373 (should (equal '("" "" "") (split-string "\n\r" p)))))
1383 1374
1384(defun erc-tests--with-process-input-spy (test)
1385 (with-current-buffer (get-buffer-create "FakeNet")
1386 (let* ((erc--input-review-functions
1387 (remove #'erc-add-to-input-ring erc--input-review-functions))
1388 (erc-pre-send-functions
1389 (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now
1390 (inhibit-message noninteractive)
1391 (erc-server-current-nick "tester")
1392 (erc-last-input-time 0)
1393 erc-accidental-paste-threshold-seconds
1394 erc-send-modify-hook
1395 ;;
1396 calls)
1397 (cl-letf (((symbol-function 'erc-process-input-line)
1398 (lambda (&rest r) (push r calls)))
1399 ((symbol-function 'erc-server-buffer)
1400 (lambda () (current-buffer))))
1401 (erc-tests--send-prep)
1402 (funcall test (lambda () (pop calls)))))
1403 (when noninteractive (kill-buffer))))
1404
1405(ert-deftest erc--check-prompt-input-functions () 1375(ert-deftest erc--check-prompt-input-functions ()
1406 (erc-tests--with-process-input-spy 1376 (erc-tests-common-with-process-input-spy
1407 (lambda (next) 1377 (lambda (next)
1408 1378
1409 (ert-info ("Errors when point not in prompt area") ; actually just dings 1379 (ert-info ("Errors when point not in prompt area") ; actually just dings
@@ -1438,9 +1408,9 @@
1438;; These also indirectly tests `erc-send-input' 1408;; These also indirectly tests `erc-send-input'
1439 1409
1440(ert-deftest erc-send-current-line () 1410(ert-deftest erc-send-current-line ()
1441 (erc-tests--with-process-input-spy 1411 (erc-tests-common-with-process-input-spy
1442 (lambda (next) 1412 (lambda (next)
1443 (erc-tests--set-fake-server-process "sleep" "1") 1413 (erc-tests-common-init-server-proc "sleep" "1")
1444 (should (= 0 erc-last-input-time)) 1414 (should (= 0 erc-last-input-time))
1445 1415
1446 (ert-info ("Simple command") 1416 (ert-info ("Simple command")
@@ -1519,9 +1489,9 @@
1519 '("Stripping" "Padding")) 1489 '("Stripping" "Padding"))
1520 1490
1521(ert-deftest erc--check-prompt-input-for-multiline-blanks () 1491(ert-deftest erc--check-prompt-input-for-multiline-blanks ()
1522 (erc-tests--with-process-input-spy 1492 (erc-tests-common-with-process-input-spy
1523 (lambda (next) 1493 (lambda (next)
1524 (erc-tests--set-fake-server-process "sleep" "10") 1494 (erc-tests-common-init-server-proc "sleep" "10")
1525 (should-not erc-send-whitespace-lines) 1495 (should-not erc-send-whitespace-lines)
1526 (should erc-warn-about-blank-lines) 1496 (should erc-warn-about-blank-lines)
1527 1497
@@ -1600,9 +1570,9 @@
1600 rv )))))) 1570 rv ))))))
1601 1571
1602(ert-deftest erc-send-whitespace-lines () 1572(ert-deftest erc-send-whitespace-lines ()
1603 (erc-tests--with-process-input-spy 1573 (erc-tests-common-with-process-input-spy
1604 (lambda (next) 1574 (lambda (next)
1605 (erc-tests--set-fake-server-process "sleep" "1") 1575 (erc-tests-common-init-server-proc "sleep" "1")
1606 (setq-local erc-send-whitespace-lines t) 1576 (setq-local erc-send-whitespace-lines t)
1607 1577
1608 (ert-info ("Multiline hunk with blank line correctly split") 1578 (ert-info ("Multiline hunk with blank line correctly split")
@@ -1697,7 +1667,7 @@
1697 (erc-default-recipients '("#chan")) 1667 (erc-default-recipients '("#chan"))
1698 calls) 1668 calls)
1699 (with-temp-buffer 1669 (with-temp-buffer
1700 (erc-tests--set-fake-server-process "sleep" "1") 1670 (erc-tests-common-init-server-proc "sleep" "1")
1701 (cl-letf (((symbol-function 'erc-cmd-MSG) 1671 (cl-letf (((symbol-function 'erc-cmd-MSG)
1702 (lambda (line) 1672 (lambda (line)
1703 (push line calls) 1673 (push line calls)
@@ -1755,120 +1725,19 @@
1755 1725
1756 (should-not calls)))))) 1726 (should-not calls))))))
1757 1727
1758(defun erc-tests--get-inserted-msg-setup ()
1759 (erc-mode)
1760 (erc--initialize-markers (point) nil)
1761 (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi"
1762 :sender "bob"
1763 :command "PRIVMSG"
1764 :command-args (list "#chan" "hi")
1765 :contents "hi"))
1766 (erc--msg-prop-overrides '((erc--ts . 0))))
1767 (erc-display-message parsed nil (current-buffer)
1768 (erc-format-privmessage "bob" "hi" nil t)))
1769 (goto-char 3)
1770 (should (looking-at "<bob> hi")))
1771
1772;; All these bounds-finding functions take an optional POINT argument.
1773;; So run each case with and without it at each pos in the message.
1774(defun erc-tests--assert-get-inserted-msg (from to assert-fn)
1775 (dolist (pt-arg '(nil t))
1776 (dolist (i (number-sequence from to))
1777 (goto-char i)
1778 (ert-info ((format "At %d (%c) %s param" i (char-after i)
1779 (if pt-arg "with" "")))
1780 (funcall assert-fn (and pt-arg i))))))
1781
1782(defun erc-tests--assert-get-inserted-msg/basic (test-fn)
1783 (erc-tests--get-inserted-msg-setup)
1784 (goto-char 11)
1785 (should (looking-back "<bob> hi"))
1786 (erc-tests--assert-get-inserted-msg 3 11 test-fn))
1787
1788(defun erc-tests--assert-get-inserted-msg/stamp (test-fn)
1789 (require 'erc-stamp)
1790 (defvar erc-insert-timestamp-function)
1791 (defvar erc-timestamp-format)
1792 (defvar erc-timestamp-use-align-to)
1793 (let ((erc-insert-modify-hook erc-insert-modify-hook)
1794 (erc-insert-timestamp-function 'erc-insert-timestamp-right)
1795 (erc-timestamp-use-align-to 0)
1796 (erc-timestamp-format "[00:00]"))
1797 (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook)
1798 (erc-tests--get-inserted-msg-setup))
1799 (goto-char 19)
1800 (should (looking-back (rx "<bob> hi [00:00]")))
1801 (erc-tests--assert-get-inserted-msg 3 19 test-fn))
1802
1803;; This is a "mixin" and requires a base assertion function to work.
1804(defun erc-tests--assert-get-inserted-msg-readonly-with (assert-fn test-fn)
1805 (defvar erc-readonly-mode)
1806 (defvar erc-readonly-mode-hook)
1807 (let ((erc-readonly-mode nil)
1808 (erc-readonly-mode-hook nil)
1809 (erc-send-post-hook erc-send-post-hook)
1810 (erc-insert-post-hook erc-insert-post-hook))
1811 (erc-readonly-mode +1)
1812 (funcall assert-fn test-fn)))
1813
1814(ert-deftest erc--get-inserted-msg-beg/basic () 1728(ert-deftest erc--get-inserted-msg-beg/basic ()
1815 (erc-tests--assert-get-inserted-msg/basic 1729 (erc-tests-common-assert-get-inserted-msg/basic
1816 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
1817
1818(ert-deftest erc--get-inserted-msg-beg/readonly ()
1819 (erc-tests--assert-get-inserted-msg-readonly-with
1820 #'erc-tests--assert-get-inserted-msg/basic
1821 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
1822
1823(ert-deftest erc--get-inserted-msg-beg/stamp ()
1824 (erc-tests--assert-get-inserted-msg/stamp
1825 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
1826
1827(ert-deftest erc--get-inserted-msg-beg/readonly/stamp ()
1828 (erc-tests--assert-get-inserted-msg-readonly-with
1829 #'erc-tests--assert-get-inserted-msg/stamp
1830 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) 1730 (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
1831 1731
1832(ert-deftest erc--get-inserted-msg-end/basic () 1732(ert-deftest erc--get-inserted-msg-end/basic ()
1833 (erc-tests--assert-get-inserted-msg/basic 1733 (erc-tests-common-assert-get-inserted-msg/basic
1834 (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) 1734 (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
1835 1735
1836(ert-deftest erc--get-inserted-msg-end/readonly ()
1837 (erc-tests--assert-get-inserted-msg-readonly-with
1838 #'erc-tests--assert-get-inserted-msg/basic
1839 (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
1840
1841(ert-deftest erc--get-inserted-msg-end/stamp ()
1842 (erc-tests--assert-get-inserted-msg/stamp
1843 (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
1844
1845(ert-deftest erc--get-inserted-msg-end/readonly/stamp ()
1846 (erc-tests--assert-get-inserted-msg-readonly-with
1847 #'erc-tests--assert-get-inserted-msg/stamp
1848 (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))
1849
1850(ert-deftest erc--get-inserted-msg-bounds/basic () 1736(ert-deftest erc--get-inserted-msg-bounds/basic ()
1851 (erc-tests--assert-get-inserted-msg/basic 1737 (erc-tests-common-assert-get-inserted-msg/basic
1852 (lambda (arg) 1738 (lambda (arg)
1853 (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) 1739 (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
1854 1740
1855(ert-deftest erc--get-inserted-msg-bounds/readonly ()
1856 (erc-tests--assert-get-inserted-msg-readonly-with
1857 #'erc-tests--assert-get-inserted-msg/basic
1858 (lambda (arg)
1859 (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg))))))
1860
1861(ert-deftest erc--get-inserted-msg-bounds/stamp ()
1862 (erc-tests--assert-get-inserted-msg/stamp
1863 (lambda (arg)
1864 (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
1865
1866(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp ()
1867 (erc-tests--assert-get-inserted-msg-readonly-with
1868 #'erc-tests--assert-get-inserted-msg/stamp
1869 (lambda (arg)
1870 (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))
1871
1872(ert-deftest erc--delete-inserted-message () 1741(ert-deftest erc--delete-inserted-message ()
1873 (erc-mode) 1742 (erc-mode)
1874 (erc--initialize-markers (point) nil) 1743 (erc--initialize-markers (point) nil)
@@ -2631,8 +2500,8 @@
2631 (should (equal (erc--format-speaker-input-message "oh my") expect)))) 2500 (should (equal (erc--format-speaker-input-message "oh my") expect))))
2632 2501
2633(ert-deftest erc--route-insertion () 2502(ert-deftest erc--route-insertion ()
2634 (erc-tests--send-prep) 2503 (erc-tests-common-prep-for-insertion)
2635 (erc-tests--set-fake-server-process "sleep" "1") 2504 (erc-tests-common-init-server-proc "sleep" "1")
2636 (setq erc-networks--id (erc-networks--id-create 'foonet)) 2505 (setq erc-networks--id (erc-networks--id-create 'foonet))
2637 2506
2638 (let* ((erc-modules) ; for `erc--open-target' 2507 (let* ((erc-modules) ; for `erc--open-target'
@@ -3018,30 +2887,6 @@
3018 (erc-server-connect-function 2887 (erc-server-connect-function
3019 erc-open-network-stream)))))))) 2888 erc-open-network-stream))))))))
3020 2889
3021(defun erc-tests--make-server-buf (name)
3022 (with-current-buffer (get-buffer-create name)
3023 (erc-mode)
3024 (setq erc-server-process (start-process "sleep" (current-buffer)
3025 "sleep" "1")
3026 erc-session-server (concat "irc." name ".org")
3027 erc-session-port 6667
3028 erc-network (intern name))
3029 (set-process-query-on-exit-flag erc-server-process nil)
3030 (current-buffer)))
3031
3032(defun erc-tests--make-client-buf (server name)
3033 (unless (bufferp server)
3034 (setq server (get-buffer server)))
3035 (with-current-buffer (get-buffer-create name)
3036 (erc-mode)
3037 (setq erc--target (erc--target-from-string name))
3038 (dolist (v '(erc-server-process
3039 erc-session-server
3040 erc-session-port
3041 erc-network))
3042 (set v (buffer-local-value v server)))
3043 (current-buffer)))
3044
3045(ert-deftest erc-handle-irc-url () 2890(ert-deftest erc-handle-irc-url ()
3046 (let* (calls 2891 (let* (calls
3047 rvbuf 2892 rvbuf
@@ -3055,10 +2900,10 @@
3055 (cl-letf (((symbol-function 'erc-cmd-JOIN) 2900 (cl-letf (((symbol-function 'erc-cmd-JOIN)
3056 (lambda (&rest r) (push r calls)))) 2901 (lambda (&rest r) (push r calls))))
3057 2902
3058 (with-current-buffer (erc-tests--make-server-buf "foonet") 2903 (with-current-buffer (erc-tests-common-make-server-buf "foonet")
3059 (setq rvbuf (current-buffer))) 2904 (setq rvbuf (current-buffer)))
3060 (erc-tests--make-server-buf "barnet") 2905 (erc-tests-common-make-server-buf "barnet")
3061 (erc-tests--make-server-buf "baznet") 2906 (erc-tests-common-make-server-buf "baznet")
3062 2907
3063 (ert-info ("Unknown network") 2908 (ert-info ("Unknown network")
3064 (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc") 2909 (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc")
@@ -3082,7 +2927,8 @@
3082 (should-not calls)) 2927 (should-not calls))
3083 2928
3084 (ert-info ("Known network, existing chan with key") 2929 (ert-info ("Known network, existing chan with key")
3085 (erc-tests--make-client-buf "foonet" "#chan") 2930 (save-excursion
2931 (with-current-buffer "foonet" (erc--open-target "#chan")))
3086 (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") 2932 (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc")
3087 (should (equal '("#chan" "sec") (pop calls))) 2933 (should (equal '("#chan" "sec") (pop calls)))
3088 (should-not calls)) 2934 (should-not calls))
@@ -3095,7 +2941,7 @@
3095 (ert-info ("Unknown network, connect, chan") 2941 (ert-info ("Unknown network, connect, chan")
3096 (with-current-buffer "foonet" 2942 (with-current-buffer "foonet"
3097 (should-not (local-variable-p 'erc-after-connect))) 2943 (should-not (local-variable-p 'erc-after-connect)))
3098 (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu"))) 2944 (setq rvbuf (lambda () (erc-tests-common-make-server-buf "gnu")))
3099 (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc") 2945 (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc")
3100 (should (equal '("irc" :server "irc.gnu.org") (pop calls))) 2946 (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
3101 (should-not calls) 2947 (should-not calls)
@@ -3107,10 +2953,7 @@
3107 (should-not calls)))) 2953 (should-not calls))))
3108 2954
3109 (when noninteractive 2955 (when noninteractive
3110 (kill-buffer "foonet") 2956 (erc-tests-common-kill-buffers)))
3111 (kill-buffer "barnet")
3112 (kill-buffer "baznet")
3113 (kill-buffer "#chan")))
3114 2957
3115(ert-deftest erc-channel-user () 2958(ert-deftest erc-channel-user ()
3116 ;; Traditional and alternate constructor swapped for compatibility. 2959 ;; Traditional and alternate constructor swapped for compatibility.
@@ -3201,31 +3044,7 @@
3201 (should (eq (erc--normalize-module-symbol 'nickserv) 'services))) 3044 (should (eq (erc--normalize-module-symbol 'nickserv) 'services)))
3202 3045
3203(defun erc-tests--assert-printed-in-subprocess (code expected) 3046(defun erc-tests--assert-printed-in-subprocess (code expected)
3204 (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) 3047 (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil)))
3205 ((string-prefix-p "erc-" found)))
3206 (intern found)
3207 'erc))
3208 ;; This is for integrations testing with managed configs
3209 ;; ("starter kits") that use a different package manager.
3210 (init (and-let* ((found (getenv "ERC_TESTS_INIT"))
3211 (files (split-string found ",")))
3212 (mapcan (lambda (f) (list "-l" f)) files)))
3213 (prog
3214 `(progn
3215 ,@(and (not init) (featurep 'compat)
3216 `((require 'package)
3217 (let ((package-load-list '((compat t) (,package t))))
3218 (package-initialize))))
3219 (require 'erc)
3220 (cl-assert (equal erc-version ,erc-version) t)
3221 ,code))
3222 (proc (apply #'start-process
3223 (symbol-name (ert-test-name (ert-running-test)))
3224 (current-buffer)
3225 (concat invocation-directory invocation-name)
3226 `("-batch" ,@(or init '("-Q"))
3227 "-eval" ,(format "%S" prog)))))
3228 (set-process-query-on-exit-flag proc t)
3229 (while (accept-process-output proc 10)) 3048 (while (accept-process-output proc 10))
3230 (goto-char (point-min)) 3049 (goto-char (point-min))
3231 (unless (equal (read (current-buffer)) expected) 3050 (unless (equal (read (current-buffer)) expected)
@@ -3573,38 +3392,11 @@ connection."
3573 (put 'erc-mname-enable 'definition-name 'mname) 3392 (put 'erc-mname-enable 'definition-name 'mname)
3574 (put 'erc-mname-disable 'definition-name 'mname)))))) 3393 (put 'erc-mname-disable 'definition-name 'mname))))))
3575 3394
3576(defun erc-tests--string-to-propertized-parts (string) 3395(ert-deftest erc-tests-common-string-to-propertized-parts ()
3577 "Return a sequence of `propertize' forms for generating STRING.
3578Expect maintainers manipulating template catalogs to use this
3579with `pp-eval-last-sexp' or similar to convert back and forth
3580between literal strings."
3581 `(concat
3582 ,@(mapcar
3583 (pcase-lambda (`(,beg ,end ,plist))
3584 ;; At the time of writing, `propertize' produces a string
3585 ;; with the order of the input plist reversed.
3586 `(propertize ,(substring-no-properties string beg end)
3587 ,@(let (out)
3588 (while-let ((plist)
3589 (k (pop plist))
3590 (v (pop plist)))
3591 (push (if (or (consp v) (symbolp v)) `',v v) out)
3592 (push `',k out))
3593 out)))
3594 (object-intervals string))))
3595
3596(defun erc-tests-pp-propertized-parts (arg)
3597 "Convert literal string before point into a `propertize'd form.
3598For simplicity, assume string evaluates to itself."
3599 (interactive "P")
3600 (let ((sexp (erc-tests--string-to-propertized-parts (pp-last-sexp))))
3601 (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp))))
3602
3603(ert-deftest erc-tests--string-to-propertized-parts ()
3604 :tags '(:unstable) ; only run this locally 3396 :tags '(:unstable) ; only run this locally
3605 (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'")) 3397 (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'"))
3606 3398
3607 (should (equal (erc-tests--string-to-propertized-parts 3399 (should (equal (erc-tests-common-string-to-propertized-parts
3608 #("abc" 3400 #("abc"
3609 0 1 (face default foo 1) 3401 0 1 (face default foo 1)
3610 1 3 (face (default italic) bar "2"))) 3402 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 @@
1;;; erc-tests-common.el --- Common helpers for ERC tests -*- lexical-binding: t -*-
2
3;; Copyright (C) 2023 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file must *not* contain any `ert-deftest' definitions. See
23;; top of test/lisp/erc/erc-tests.el for loading example.
24;;
25;; Environment variables:
26;;
27;; `ERC_PACKAGE_NAME': Name of the installed ERC package currently
28;; running. ERC needs this in order to load the same package in
29;; tests that run in a subprocess. Necessary even when the package
30;; name is `erc' and not something like `erc-49860'.
31;;
32;; `ERC_TESTS_INIT': The name of an alternate init file. Mainly for
33;; integrations tests involving starter kits.
34;;
35;; `ERC_TESTS_SNAPSHOT_SAVE': When set, ERC saves the current test's
36;; snapshots to disk.
37;;
38
39;;; Code:
40(require 'ert-x)
41(require 'erc)
42
43;; Caller should probably shadow `erc-insert-modify-hook' or populate
44;; user tables for erc-button.
45;; FIXME explain this comment ^ in more detail or delete.
46(defun erc-tests-common-prep-for-insertion ()
47 "Initialize current buffer with essentials for message insertion.
48Assume caller intends to use `erc-display-message'."
49 (erc-mode)
50 (erc--initialize-markers (point) nil)
51 (should (= (point) erc-input-marker)))
52
53(defun erc-tests-common-init-server-proc (&rest args)
54 "Create a process with `start-process' from ARGS.
55Assign the result to `erc-server-process' in the current buffer."
56 (setq erc-server-process
57 (apply #'start-process (car args) (current-buffer) args))
58 (set-process-query-on-exit-flag erc-server-process nil)
59 erc-server-process)
60
61;; After dropping support for Emacs 27, callers can use
62;; `get-buffer-create' with INHIBIT-BUFFER-HOOKS.
63(defun erc-tests-common-kill-buffers (&rest extra-buffers)
64 "Kill all ERC buffers and possibly EXTRA-BUFFERS."
65 (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
66 (dolist (buf (erc-buffer-list))
67 (kill-buffer buf))
68 (named-let doit ((buffers extra-buffers))
69 (dolist (buf buffers)
70 (if (consp buf) (doit buf) (kill-buffer buf))))))
71
72(defun erc-tests-common-with-process-input-spy (test-fn)
73 "Mock `erc-process-input-line' and call TEST-FN.
74Shadow `erc--input-review-functions' and `erc-pre-send-functions'
75with `erc-add-to-input-ring' removed. Shadow other relevant
76variables as nil, and bind `erc-last-input-time' to 0. Also mock
77`erc-server-buffer' to return the current buffer. Call TEST-FN
78with a utility function that returns the set of arguments most
79recently passed to the mocked `erc-process-input-line'. Make
80`inhibit-message' non-nil unless running interactively."
81 (with-current-buffer (get-buffer-create "FakeNet")
82 (let* ((erc--input-review-functions
83 (remove 'erc-add-to-input-ring erc--input-review-functions))
84 (erc-pre-send-functions
85 (remove 'erc-add-to-input-ring erc-pre-send-functions)) ; for now
86 (inhibit-message noninteractive)
87 (erc-server-current-nick "tester")
88 (erc-last-input-time 0)
89 erc-accidental-paste-threshold-seconds
90 erc-send-modify-hook
91 ;;
92 calls)
93 (cl-letf (((symbol-function 'erc-process-input-line)
94 (lambda (&rest r) (push r calls)))
95 ((symbol-function 'erc-server-buffer)
96 (lambda () (current-buffer))))
97 (erc-tests-common-prep-for-insertion)
98 (funcall test-fn (lambda () (pop calls)))))
99 (when noninteractive (kill-buffer))))
100
101(defun erc-tests-common-make-server-buf (name)
102 "Return a server buffer named NAME, creating it if necessary.
103Use NAME for the network and the session server as well."
104 (with-current-buffer (get-buffer-create name)
105 (erc-tests-common-prep-for-insertion)
106 (erc-tests-common-init-server-proc "sleep" "1")
107 (setq erc-session-server (concat "irc." name ".org")
108 erc-server-announced-name (concat "west." name ".org")
109 erc-session-port 6667
110 erc-network (intern name)
111 erc-networks--id (erc-networks--id-create nil))
112 (current-buffer)))
113
114(defun erc-tests-common-string-to-propertized-parts (string)
115 "Return a sequence of `propertize' forms for generating STRING.
116Expect maintainers manipulating template catalogs to use this
117with `pp-eval-last-sexp' or similar to convert back and forth
118between literal strings."
119 `(concat
120 ,@(mapcar
121 (pcase-lambda (`(,beg ,end ,plist))
122 ;; At the time of writing, `propertize' produces a string
123 ;; with the order of the input plist reversed.
124 `(propertize ,(substring-no-properties string beg end)
125 ,@(let (out)
126 (while-let ((plist)
127 (k (pop plist))
128 (v (pop plist)))
129 (push (if (or (consp v) (symbolp v)) `',v v) out)
130 (push `',k out))
131 out)))
132 (object-intervals string))))
133
134(defun erc-tests-common-pp-propertized-parts (arg)
135 "Convert literal string before point into a `propertize'd form.
136For simplicity, assume string evaluates to itself."
137 (interactive "P")
138 (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
139 (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp))))
140
141;; The following utilities are meant to help prepare tests for
142;; `erc--get-inserted-msg-bounds' and friends.
143(defun erc-tests-common-get-inserted-msg-setup ()
144 (erc-tests-common-prep-for-insertion)
145 (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi"
146 :sender "bob"
147 :command "PRIVMSG"
148 :command-args (list "#chan" "hi")
149 :contents "hi"))
150 (erc--msg-prop-overrides '((erc--ts . 0))))
151 (erc-display-message parsed nil (current-buffer)
152 (erc-format-privmessage "bob" "hi" nil t)))
153 (goto-char 3)
154 (should (looking-at "<bob> hi")))
155
156;; All these bounds-finding functions take an optional POINT argument.
157;; So run each case with and without it at each pos in the message.
158(defun erc-tests-common-assert-get-inserted-msg (from to assert-fn)
159 (dolist (pt-arg '(nil t))
160 (dolist (i (number-sequence from to))
161 (goto-char i)
162 (ert-info ((format "At %d (%c) %s param" i (char-after i)
163 (if pt-arg "with" "")))
164 (funcall assert-fn (and pt-arg i))))))
165
166(defun erc-tests-common-assert-get-inserted-msg/basic (test-fn)
167 (erc-tests-common-get-inserted-msg-setup)
168 (goto-char 11)
169 (should (looking-back "<bob> hi"))
170 (erc-tests-common-assert-get-inserted-msg 3 11 test-fn))
171
172;; This is a "mixin" and requires a base assertion function, like
173;; `erc-tests-common-assert-get-inserted-msg/basic', to work.
174(defun erc-tests-common-assert-get-inserted-msg-readonly-with
175 (assert-fn test-fn)
176 (defvar erc-readonly-mode)
177 (defvar erc-readonly-mode-hook)
178 (let ((erc-readonly-mode nil)
179 (erc-readonly-mode-hook nil)
180 (erc-send-post-hook erc-send-post-hook)
181 (erc-insert-post-hook erc-insert-post-hook))
182 (erc-readonly-mode +1)
183 (funcall assert-fn test-fn)))
184
185
186;;;; Buffer snapshots
187
188;; Use this variable to generate new snapshots after carefully
189;; reviewing the output of *each* snapshot (not just first and last).
190;; Obviously, only run one test at a time.
191(defvar erc-tests-common-snapshot-save-p (getenv "ERC_TESTS_SNAPSHOT_SAVE"))
192
193(defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn)
194 "Compare `buffer-string' to snapshot NAME.eld in DIR, if present.
195When non-nil, run TRANS-FN to fiter the current buffer string,
196and expect a similar string in return. Call BUF-INIT-FN, when
197non-nil, in the preview buffer after inserting the filtered
198string."
199 (let* ((expect-file (file-name-with-extension (expand-file-name name dir)
200 "eld"))
201 (erc--own-property-names
202 (seq-difference `(font-lock-face ,@erc--own-property-names)
203 `(field display wrap-prefix line-prefix
204 erc--msg erc--cmd erc--spkr erc--ts erc--ctcp
205 erc--ephemeral)
206 #'eq))
207 (print-circle t)
208 (print-escape-newlines t)
209 (print-escape-nonascii t)
210 (got (erc--remove-text-properties
211 (buffer-substring (point-min) erc-insert-marker)))
212 (repr (funcall (or trans-fn #'identity) (prin1-to-string got))))
213 (with-current-buffer (generate-new-buffer name)
214 (with-silent-modifications
215 (insert (setq got (read repr))))
216 (when buf-init-fn (funcall buf-init-fn))
217 (erc-mode))
218 ;; LHS is a string, RHS is a symbol.
219 (if (string= erc-tests-common-snapshot-save-p
220 (ert-test-name (ert-running-test)))
221 (let (inhibit-message)
222 (with-temp-file expect-file
223 (insert repr))
224 ;; Limit writing snapshots to one test at a time.
225 (message "erc-tests-common-snapshot-compare: wrote %S" expect-file))
226 (if (file-exists-p expect-file)
227 ;; Ensure string-valued properties, like timestamps, aren't
228 ;; recursive (signals `max-lisp-eval-depth' exceeded).
229 (named-let assert-equal
230 ((latest (read repr))
231 (expect (read (with-temp-buffer
232 (insert-file-contents-literally expect-file)
233 (buffer-string)))))
234 (pcase latest
235 ((or "" 'nil) t)
236 ((pred stringp)
237 (should (equal-including-properties latest expect))
238 (let ((latest-intervals (object-intervals latest))
239 (expect-intervals (object-intervals expect)))
240 (while-let ((l-iv (pop latest-intervals))
241 (x-iv (pop expect-intervals))
242 (l-tab (map-into (nth 2 l-iv) 'hash-table))
243 (x-tab (map-into (nth 2 x-iv) 'hash-table)))
244 (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
245 (assert-equal l-v (gethash l-k x-tab))
246 (remhash l-k x-tab))
247 (should (zerop (hash-table-count x-tab))))))
248 ((pred sequencep)
249 (assert-equal (seq-first latest) (seq-first expect))
250 (assert-equal (seq-rest latest) (seq-rest expect)))
251 (_ (should (equal latest expect)))))
252 (message "Snapshot file missing: %S" expect-file)))))
253
254(defun erc-tests-common-create-subprocess (code switches libs)
255 "Return subprocess for running CODE in an inferior Emacs.
256Include SWITCHES, like \"-batch\", as well as libs, after
257interspersing \"-l\" between members."
258 (let* ((package (if-let ((found (getenv "ERC_PACKAGE_NAME"))
259 ((string-prefix-p "erc-" found)))
260 (intern found)
261 'erc))
262 ;; For integrations testing with managed configs that use a
263 ;; different package manager.
264 (init (and-let* ((found (getenv "ERC_TESTS_INIT"))
265 (files (split-string found ",")))
266 (mapcan (lambda (f) (list "-l" f)) files)))
267 (prog
268 `(progn
269 ,@(and (not init) (featurep 'compat)
270 `((require 'package)
271 (let ((package-load-list '((compat t) (,package t))))
272 (package-initialize))))
273 (require 'erc)
274 (cl-assert (equal erc-version ,erc-version) t)
275 ,code))
276 (proc (apply #'start-process
277 (symbol-name (ert-test-name (ert-running-test)))
278 (current-buffer)
279 (concat invocation-directory invocation-name)
280 `(,@(or init '("-Q"))
281 ,@switches
282 ,@(mapcan (lambda (f) (list "-l" f)) libs)
283 "-eval" ,(format "%S" prog)))))
284 (set-process-query-on-exit-flag proc t)
285 proc))
286
287(provide 'erc-tests-common)