2021-07-09 20:03:51 -07:00
|
|
|
;;; erc-goodies-tests.el --- Tests for erc-goodies -*- 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:
|
|
|
|
|
;;; Code:
|
|
|
|
|
(require 'ert-x)
|
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.
2023-12-24 12:21:49 -08:00
|
|
|
(eval-and-compile
|
|
|
|
|
(let ((load-path (cons (ert-resource-directory) load-path)))
|
|
|
|
|
(require 'erc-tests-common)))
|
|
|
|
|
|
2021-07-09 20:03:51 -07:00
|
|
|
(require 'erc-goodies)
|
|
|
|
|
|
|
|
|
|
(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
|
|
|
|
|
(setq beg (+ beg (point-min)))
|
|
|
|
|
(let ((end (+ beg (1- (length end-str)))))
|
|
|
|
|
(while (and beg (< beg end))
|
|
|
|
|
(let* ((val (get-text-property beg 'font-lock-face))
|
|
|
|
|
(ft (flatten-tree (ensure-list val))))
|
|
|
|
|
(dolist (p (ensure-list present))
|
|
|
|
|
(if (consp p)
|
|
|
|
|
(should (member p val))
|
|
|
|
|
(should (memq p ft))))
|
|
|
|
|
(dolist (a (ensure-list absent))
|
|
|
|
|
(if (consp a)
|
|
|
|
|
(should-not (member a val))
|
|
|
|
|
(should-not (memq a ft))))
|
|
|
|
|
(setq beg (text-property-not-all beg (point-max)
|
|
|
|
|
'font-lock-face val))))))
|
|
|
|
|
|
|
|
|
|
;; These are from the "Examples" section of
|
|
|
|
|
;; https://modern.ircdocs.horse/formatting.html
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-controls-highlight--examples ()
|
|
|
|
|
(should (eq t erc-interpret-controls-p))
|
|
|
|
|
(let ((erc-insert-modify-hook '(erc-controls-highlight))
|
|
|
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
|
|
|
(erc-mode)
|
|
|
|
|
(setq-local erc-interpret-mirc-color t)
|
|
|
|
|
(erc--initialize-markers (point) nil)
|
|
|
|
|
|
|
|
|
|
(let* ((m "I love \C-c3IRC!\C-c It is the \C-c7best protocol ever!")
|
|
|
|
|
(msg (erc-format-privmessage "bob" m nil t)))
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg))
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(should (search-forward "<bob> " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 "I love" 'erc-default-face 'fg:erc-color-face3)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
7 " IRC!" 'fg:erc-color-face3)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
11 " It is the " 'erc-default-face 'fg:erc-color-face7)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
22 "best protocol ever!" 'fg:erc-color-face7))
|
|
|
|
|
|
|
|
|
|
(let* ((m "This is a \C-]\C-c13,9cool \C-cmessage")
|
|
|
|
|
(msg (erc-format-privmessage "alice" m nil t)))
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg))
|
|
|
|
|
(should (search-forward "<alice> " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 "this is a " 'erc-default-face 'erc-italic-face)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
10 "cool " '(erc-italic-face fg:erc-color-face13 bg:erc-color-face9))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
15 "message" 'erc-italic-face
|
|
|
|
|
'(fg:erc-color-face13 bg:erc-color-face9)))
|
|
|
|
|
|
|
|
|
|
(let* ((m "IRC \C-bis \C-c4,12so \C-cgreat\C-o!")
|
|
|
|
|
(msg (erc-format-privmessage "bob" m nil t)))
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg))
|
|
|
|
|
(should (search-forward "<bob> " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 "IRC " 'erc-default-face 'erc-bold-face)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
4 "is " 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
7 "so " '(erc-bold-face fg:erc-color-face4 bg:erc-color-face12))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
10 "great" 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
15 "!" 'erc-default-face 'erc-bold-face))
|
|
|
|
|
|
|
|
|
|
(let* ((m (concat "Rules: Don't spam 5\C-c13,8,6\C-c,7,8, "
|
|
|
|
|
"and especially not \C-b9\C-b\C-]!"))
|
|
|
|
|
(msg (erc-format-privmessage "alice" m nil t)))
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg))
|
|
|
|
|
(should (search-forward "<alice> " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 "Rules: Don't spam 5" 'erc-default-face
|
|
|
|
|
'(fg:erc-color-face13 bg:erc-color-face8))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
19 ",6" '(fg:erc-color-face13 bg:erc-color-face8))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
21 ",7,8, and especially not " 'erc-default-face
|
|
|
|
|
'(fg:erc-color-face13 bg:erc-color-face8 erc-bold-face))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
44 "9" 'erc-bold-face 'erc-italic-face)
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
45 "!" 'erc-italic-face 'erc-bold-face))
|
|
|
|
|
|
|
|
|
|
(when noninteractive
|
|
|
|
|
(kill-buffer)))))
|
|
|
|
|
|
|
|
|
|
;; Like the test above, this is most intuitive when run interactively.
|
|
|
|
|
;; Hovering over the redacted area should reveal its underlying text
|
|
|
|
|
;; in a high-contrast face.
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-controls-highlight--inverse ()
|
|
|
|
|
(should (eq t erc-interpret-controls-p))
|
|
|
|
|
(let ((erc-insert-modify-hook '(erc-controls-highlight))
|
|
|
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
|
|
|
(erc-mode)
|
|
|
|
|
(setq-local erc-interpret-mirc-color t)
|
|
|
|
|
(erc--initialize-markers (point) nil)
|
|
|
|
|
|
|
|
|
|
(let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
|
|
|
|
|
(msg (erc-format-privmessage "bob" m nil t)))
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg))
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(should (search-forward "<bob> " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(should (eq (get-text-property (+ 9 (point)) 'mouse-face)
|
|
|
|
|
'erc-inverse-face))
|
|
|
|
|
(should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
|
|
|
|
|
'erc-inverse-face))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 "Spoiler: " 'erc-default-face
|
|
|
|
|
'(fg:erc-color-face0 bg:erc-color-face0))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
9 "Hello" '(erc-spoiler-face)
|
|
|
|
|
'( fg:erc-color-face0 bg:erc-color-face0
|
|
|
|
|
fg:erc-color-face1 bg:erc-color-face1))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
18 " World" '(erc-spoiler-face)
|
|
|
|
|
'( fg:erc-color-face0 bg:erc-color-face0
|
|
|
|
|
fg:erc-color-face1 bg:erc-color-face1 )))
|
|
|
|
|
(when noninteractive
|
|
|
|
|
(kill-buffer)))))
|
|
|
|
|
|
|
|
|
|
(defvar erc-goodies-tests--motd
|
|
|
|
|
;; This is from ergo's MOTD
|
|
|
|
|
'((":- - this is \2bold text\17.")
|
|
|
|
|
(":- - this is \35italics text\17.")
|
|
|
|
|
(":- - this is \0034red\3 and \0032blue\3 text.")
|
|
|
|
|
(":- - this is \0034,12red text with a light blue background\3.")
|
|
|
|
|
(":- - this is a normal escaped dollarsign: $")
|
|
|
|
|
(":- ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0031,0 00 \0030,1 01 \0030,2 02 \0030,3 03 "
|
|
|
|
|
"\0031,4 04 \0030,5 05 \0030,6 06 \0031,7 07 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0031,8 08 \0031,9 09 \0030,10 10 \0031,11 11 "
|
|
|
|
|
"\0030,12 12 \0031,13 13 \0031,14 14 \0031,15 15 ")
|
|
|
|
|
(":- ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,16 16 \0030,17 17 \0030,18 18 \0030,19 19 "
|
|
|
|
|
"\0030,20 20 \0030,21 21 \0030,22 22 \0030,23 23 "
|
|
|
|
|
"\0030,24 24 \0030,25 25 \0030,26 26 \0030,27 27 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,28 28 \0030,29 29 \0030,30 30 \0030,31 31 "
|
|
|
|
|
"\0030,32 32 \0030,33 33 \0030,34 34 \0030,35 35 "
|
|
|
|
|
"\0030,36 36 \0030,37 37 \0030,38 38 \0030,39 39 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,40 40 \0030,41 41 \0030,42 42 \0030,43 43 "
|
|
|
|
|
"\0030,44 44 \0030,45 45 \0030,46 46 \0030,47 47 "
|
|
|
|
|
"\0030,48 48 \0030,49 49 \0030,50 50 \0030,51 51 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,52 52 \0030,53 53 \0031,54 54 \0031,55 55 "
|
|
|
|
|
"\0031,56 56 \0031,57 57 \0031,58 58 \0030,59 59 "
|
|
|
|
|
"\0030,60 60 \0030,61 61 \0030,62 62 \0030,63 63 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,64 64 \0031,65 65 \0031,66 66 \0031,67 67 "
|
|
|
|
|
"\0031,68 68 \0031,69 69 \0031,70 70 \0031,71 71 "
|
|
|
|
|
"\0030,72 72 \0030,73 73 \0030,74 74 \0030,75 75 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0031,76 76 \0031,77 77 \0031,78 78 \0031,79 79 "
|
|
|
|
|
"\0031,80 80 \0031,81 81 \0031,82 82 \0031,83 83 "
|
|
|
|
|
"\0031,84 84 \0031,85 85 \0031,86 86 \0031,87 87 ")
|
|
|
|
|
(":- "
|
|
|
|
|
"\0030,88 88 \0030,89 89 \0030,90 90 \0030,91 91 "
|
|
|
|
|
"\0030,92 92 \0030,93 93 \0030,94 94 \0030,95 95 "
|
|
|
|
|
"\0031,96 96 \0031,97 97 \0031,98 98 \399,99 99 ")
|
|
|
|
|
(":- ")))
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-controls-highlight--motd ()
|
|
|
|
|
(should (eq t erc-interpret-controls-p))
|
|
|
|
|
(let ((erc-insert-modify-hook '(erc-controls-highlight))
|
|
|
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
|
|
|
(erc-mode)
|
|
|
|
|
(setq-local erc-interpret-mirc-color t)
|
|
|
|
|
(erc--initialize-markers (point) nil)
|
|
|
|
|
|
|
|
|
|
(dolist (parts erc-goodies-tests--motd)
|
|
|
|
|
(erc-display-message nil 'notice (current-buffer) (string-join parts)))
|
|
|
|
|
|
|
|
|
|
;; Spot check
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(should (search-forward " 16 " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 " 17 " '(fg:erc-color-face0 (:background "#472100")))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
4 " 18 " '(fg:erc-color-face0 (:background "#474700"))
|
|
|
|
|
'((:background "#472100"))))
|
|
|
|
|
|
|
|
|
|
(should (search-forward " 71 " nil t))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (point) (pos-eol))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
0 " 72 " '(fg:erc-color-face0 (:background "#5959ff")))
|
|
|
|
|
(erc-goodies-tests--assert-face
|
|
|
|
|
4 " 73 " '(fg:erc-color-face0 (:background "#c459ff"))
|
|
|
|
|
'((:background "#5959ff"))))
|
|
|
|
|
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(when noninteractive
|
|
|
|
|
(kill-buffer)))))
|
|
|
|
|
|
2022-12-09 22:00:59 -08:00
|
|
|
|
|
|
|
|
;; Among other things, this test also asserts that a local module's
|
|
|
|
|
;; minor-mode toggle is allowed to disable its mode variable as
|
|
|
|
|
;; needed.
|
|
|
|
|
|
2023-07-12 23:53:06 -07:00
|
|
|
(defun erc-goodies-tests--assert-kp-indicator-on ()
|
|
|
|
|
(should erc--keep-place-indicator-overlay)
|
2023-12-23 12:46:33 -08:00
|
|
|
(should (local-variable-p 'window-buffer-change-functions))
|
2023-07-12 23:53:06 -07:00
|
|
|
(should window-configuration-change-hook)
|
|
|
|
|
(should (memq 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
(should (eq erc-keep-place-mode
|
|
|
|
|
(not (local-variable-p 'erc-insert-pre-hook)))))
|
|
|
|
|
|
|
|
|
|
(defun erc-goodies-tests--assert-kp-indicator-off ()
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))
|
2023-12-23 12:46:33 -08:00
|
|
|
(should-not (local-variable-p 'window-buffer-change-functions))
|
2023-07-12 23:53:06 -07:00
|
|
|
(should-not erc--keep-place-indicator-overlay))
|
|
|
|
|
|
|
|
|
|
(defun erc-goodies-tests--kp-indicator-populate ()
|
|
|
|
|
(erc-display-message nil 'notice (current-buffer)
|
|
|
|
|
"This buffer is for text that is not saved")
|
|
|
|
|
(erc-display-message nil 'notice (current-buffer)
|
|
|
|
|
"and for lisp evaluation")
|
|
|
|
|
(should (search-forward "saved" nil t))
|
|
|
|
|
(erc-keep-place-move nil)
|
|
|
|
|
(goto-char erc-input-marker))
|
|
|
|
|
|
|
|
|
|
(defun erc-goodies-tests--keep-place-indicator (test)
|
2022-12-09 22:00:59 -08:00
|
|
|
(with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
|
|
|
|
|
(erc-mode)
|
|
|
|
|
(erc--initialize-markers (point) nil)
|
2023-05-07 19:43:57 -07:00
|
|
|
(setq erc-server-process
|
|
|
|
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
|
|
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
2023-07-12 23:53:06 -07:00
|
|
|
(let (erc-connect-pre-hook
|
2022-12-09 22:00:59 -08:00
|
|
|
erc-modules)
|
|
|
|
|
|
2023-07-12 23:53:06 -07:00
|
|
|
(ert-info ("Clean slate")
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
(should-not erc-keep-place-mode)
|
|
|
|
|
(should-not (memq 'keep-place erc-modules)))
|
2022-12-09 22:00:59 -08:00
|
|
|
|
2023-07-12 23:53:06 -07:00
|
|
|
(funcall test))
|
2022-12-09 22:00:59 -08:00
|
|
|
|
|
|
|
|
(when noninteractive
|
2023-07-12 23:53:06 -07:00
|
|
|
(erc-keep-place-indicator-mode -1)
|
|
|
|
|
(erc-keep-place-mode -1)
|
|
|
|
|
(should-not (member 'erc-keep-place
|
|
|
|
|
(default-value 'erc-insert-pre-hook)))
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))
|
2022-12-09 22:00:59 -08:00
|
|
|
(kill-buffer))))
|
|
|
|
|
|
2023-07-12 23:53:06 -07:00
|
|
|
(ert-deftest erc-keep-place-indicator-mode--no-global ()
|
|
|
|
|
(erc-goodies-tests--keep-place-indicator
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value t")
|
|
|
|
|
(should (eq erc-keep-place-indicator-buffer-type t))
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
|
|
|
|
|
(erc-keep-place-indicator-mode -1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value `target'")
|
|
|
|
|
(let ((erc-keep-place-indicator-buffer-type 'target))
|
|
|
|
|
;; No-op because server buffer.
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
;; Spoof target buffer (no longer no-op).
|
|
|
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)))
|
|
|
|
|
|
|
|
|
|
(erc-keep-place-indicator-mode -1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value `server'")
|
|
|
|
|
(let ((erc-keep-place-indicator-buffer-type 'server))
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
(setq erc--target nil)
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)))
|
|
|
|
|
|
|
|
|
|
;; Populate buffer
|
|
|
|
|
(erc-goodies-tests--kp-indicator-populate)
|
|
|
|
|
|
|
|
|
|
(ert-info ("Indicator survives reconnect")
|
|
|
|
|
(let ((erc--server-reconnecting (buffer-local-variables)))
|
|
|
|
|
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
|
|
|
|
|
(erc-open "localhost" 6667 "tester" "Tester" 'connect
|
|
|
|
|
nil nil nil nil nil "tester" nil)))
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
(should (= (point) erc-input-marker))
|
|
|
|
|
(goto-char (overlay-start erc--keep-place-indicator-overlay))
|
|
|
|
|
(should (looking-at (rx "*** This buffer is for text")))))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-keep-place-indicator-mode--global ()
|
|
|
|
|
(erc-goodies-tests--keep-place-indicator
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
|
|
|
|
(push 'keep-place erc-modules)
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value t")
|
|
|
|
|
(should (eq erc-keep-place-indicator-buffer-type t))
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
;; Local module activates global `keep-place'.
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
;; Does not register local version of hook (otherwise would run
|
|
|
|
|
;; twice).
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
|
|
|
|
|
(erc-keep-place-indicator-mode -1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value `target'")
|
|
|
|
|
(let ((erc-keep-place-indicator-buffer-type 'target))
|
|
|
|
|
;; No-op because server buffer.
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
;; Does not interfere with global activation state.
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
;; Morph into a target buffer (no longer no-op).
|
|
|
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
;; Does not register local version of hook.
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))))
|
|
|
|
|
|
|
|
|
|
(erc-keep-place-indicator-mode -1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value `server'")
|
|
|
|
|
(let ((erc-keep-place-indicator-buffer-type 'server))
|
|
|
|
|
;; No-op because we're now a target buffer.
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-off)
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
;; Back to server.
|
|
|
|
|
(setq erc--target nil)
|
|
|
|
|
(erc-keep-place-indicator-mode +1)
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Local adapts to global toggle")
|
|
|
|
|
(erc-keep-place-mode -1)
|
|
|
|
|
(should-not (member 'erc-keep-place
|
|
|
|
|
(default-value 'erc-insert-pre-hook)))
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
(erc-keep-place-mode +1)
|
|
|
|
|
(should (member 'erc-keep-place (default-value 'erc-insert-pre-hook)))
|
|
|
|
|
(should-not (local-variable-p 'erc-insert-pre-hook))
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on))
|
|
|
|
|
|
|
|
|
|
;; Populate buffer
|
|
|
|
|
(erc-goodies-tests--kp-indicator-populate)
|
|
|
|
|
|
|
|
|
|
(ert-info ("Indicator survives reconnect")
|
|
|
|
|
(let ((erc--server-reconnecting (buffer-local-variables)))
|
|
|
|
|
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
|
|
|
|
|
(erc-open "localhost" 6667 "tester" "Tester" 'connect
|
|
|
|
|
nil nil nil nil nil "tester" nil)))
|
|
|
|
|
(erc-goodies-tests--assert-kp-indicator-on)
|
|
|
|
|
(should erc-keep-place-mode)
|
|
|
|
|
(should (member 'erc-keep-place erc-insert-pre-hook))
|
|
|
|
|
(should (= (point) erc-input-marker))
|
|
|
|
|
(goto-char (overlay-start erc--keep-place-indicator-overlay))
|
|
|
|
|
(should (looking-at (rx "*** This buffer is for text")))))))
|
|
|
|
|
|
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.
2023-12-24 12:21:49 -08:00
|
|
|
(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))))))
|
|
|
|
|
|
|
|
|
|
|
2021-07-09 20:03:51 -07:00
|
|
|
;;; erc-goodies-tests.el ends here
|