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