diff options
| author | F. Jason Park | 2023-12-24 12:21:49 -0800 |
|---|---|---|
| committer | F. Jason Park | 2023-12-27 21:32:25 -0800 |
| commit | 7097be8ef601a20cdcd5d3a2bf2b1e33f2124981 (patch) | |
| tree | 98608ecc405f7920bf3f04ce53abfda7b7989599 | |
| parent | c83a2d15097e39d2a46d898f7731ca592c59e5a7 (diff) | |
| download | emacs-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.el | 6 | ||||
| -rw-r--r-- | test/lisp/erc/erc-button-tests.el | 25 | ||||
| -rw-r--r-- | test/lisp/erc/erc-fill-tests.el | 92 | ||||
| -rw-r--r-- | test/lisp/erc/erc-goodies-tests.el | 21 | ||||
| -rw-r--r-- | test/lisp/erc/erc-networks-tests.el | 20 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-internal.el | 19 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-sasl.el | 1 | ||||
| -rw-r--r-- | test/lisp/erc/erc-stamp-tests.el | 52 | ||||
| -rw-r--r-- | test/lisp/erc/erc-tests.el | 290 | ||||
| -rw-r--r-- | 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." | |||
| 551 | "Define `erc-display-message' formatting templates for NAME, a symbol. | 551 | "Define `erc-display-message' formatting templates for NAME, a symbol. |
| 552 | 552 | ||
| 553 | See `erc-define-message-format-catalog' for the meaning of | 553 | See `erc-define-message-format-catalog' for the meaning of |
| 554 | ENTRIES, an alist. Also see `erc-tests-pp-propertized-parts' in | 554 | ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in |
| 555 | tests/lisp/erc/erc-tests.el for a convenience command to convert | 555 | tests/lisp/erc/erc-tests.el for a convenience command to convert |
| 556 | a literal string into a sequence of `propertize' forms, which | 556 | a literal string into a sequence of `propertize' forms, which are |
| 557 | are much easier to review and edit." | 557 | much 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. | ||
| 3578 | Expect maintainers manipulating template catalogs to use this | ||
| 3579 | with `pp-eval-last-sexp' or similar to convert back and forth | ||
| 3580 | between 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. | ||
| 3598 | For 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. | ||
| 48 | Assume 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. | ||
| 55 | Assign 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. | ||
| 74 | Shadow `erc--input-review-functions' and `erc-pre-send-functions' | ||
| 75 | with `erc-add-to-input-ring' removed. Shadow other relevant | ||
| 76 | variables as nil, and bind `erc-last-input-time' to 0. Also mock | ||
| 77 | `erc-server-buffer' to return the current buffer. Call TEST-FN | ||
| 78 | with a utility function that returns the set of arguments most | ||
| 79 | recently 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. | ||
| 103 | Use 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. | ||
| 116 | Expect maintainers manipulating template catalogs to use this | ||
| 117 | with `pp-eval-last-sexp' or similar to convert back and forth | ||
| 118 | between 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. | ||
| 136 | For 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. | ||
| 195 | When non-nil, run TRANS-FN to fiter the current buffer string, | ||
| 196 | and expect a similar string in return. Call BUF-INIT-FN, when | ||
| 197 | non-nil, in the preview buffer after inserting the filtered | ||
| 198 | string." | ||
| 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. | ||
| 256 | Include SWITCHES, like \"-batch\", as well as libs, after | ||
| 257 | interspersing \"-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) | ||