Add baseline test coverage for erc-match
* lisp/erc/erc-match.el (erc-pal-highlight-type) (erc-fool-highlight-type, erc-dangerous-host-highlight-type): Clarify some areas in doc strings. * test/lisp/erc/erc-match-tests.el: Require `erc-test-common' library. (erc-match-tests--assert-face-absent) (erc-match-tests--assert-face-present) (erc-match-tests--assert-speaker-highlighted) (erc-match-tests--assert-speaker-only-highlighted) (erc-match-tests--perform) (erc-match-tests--hl-type-nick): New functions. (erc-match-message/pal/nick, erc-match-message/fool/nick) (erc-match-message/dangerous-host/nick): New tests. (erc-match-tests--hl-type-message): New function. (erc-match-message/pal/message) (erc-match-message/fool/message) (erc-match-message/dangerous-host/message): New tests. (erc-match-tests--hl-type-all): New function. (erc-match-message/pal/all, erc-match-message/fool/all) (erc-match-message/dangerous-host/all): New tests. (erc-match-tests--hl-type-nick-or-keyword): New function. (erc-match-message/current-nick/nick-or-keyword): New test. (erc-match-tests--hl-type-keyword): New function. (erc-match-message/keyword/keyword): New test. (erc-match-tests--log-matches): New function. (erc-log-matches): New test. * test/lisp/erc/resources/erc-tests-common.el: Require `erc-d-i'. (erc-tests-common-add-cmem, erc-tests-common-parse-line) (erc-tests-common-simulate-line) (erc-tests-common-simulate-privmsg): New functions.
This commit is contained in:
F. Jason Park
parent
9906e34f97
commit
9bddb264ba
3 changed files with 462 additions and 21 deletions
|
|
@ -118,11 +118,21 @@ The following values are allowed:
|
|||
|
||||
nil - do not highlight the message at all
|
||||
`nick' - highlight pal's nickname only
|
||||
`message' - highlight the entire message from pal
|
||||
\\+`message' - highlight the full message body from a matching pal
|
||||
`all' - highlight the entire message (including the nick)
|
||||
from pal
|
||||
|
||||
Any other value disables pal highlighting altogether."
|
||||
A value of `nick' only highlights a matching sender's nick in the
|
||||
bracketed speaker portion of the message. A value of \\+`message'
|
||||
basically highlights its complement: the message-body alone, after the
|
||||
speaker tag. All values for this option require a matching sender to be
|
||||
an actual user on the network \(or a bot/service) as opposed to a host
|
||||
name, such as that of the server itself \(e.g. \"irc.gnu.org\"). When
|
||||
patterns from other user-based categories \(namely, \\+`fool' and
|
||||
\\+`dangerous-host') also match, the behavior is undefined. However, in
|
||||
ERC 5.6, `erc-dangerous-host-face' is known to clobber `erc-fool-face',
|
||||
which in turn clobbers `erc-pal-face'. \(Other effects, such as
|
||||
\\+`fool'-related invisibility may not survive such collisions.)"
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const message)
|
||||
|
|
@ -130,17 +140,18 @@ Any other value disables pal highlighting altogether."
|
|||
|
||||
(defcustom erc-fool-highlight-type 'nick
|
||||
"Determines how to highlight messages by fools.
|
||||
See `erc-fools'.
|
||||
Unlike with the \\+`pal' and \\+`dangerous-host' categories, ERC doesn't
|
||||
only attempt to match associated patterns (here, from `erc-fools')
|
||||
against a message's sender, it also checks for matches in traditional
|
||||
IRC-style \"mentions\" in which a speaker addresses a USER directly:
|
||||
|
||||
The following values are allowed:
|
||||
<speaker> USER: hi.
|
||||
<speaker> USER, hi.
|
||||
|
||||
nil - do not highlight the message at all
|
||||
`nick' - highlight fool's nickname only
|
||||
`message' - highlight the entire message from fool
|
||||
`all' - highlight the entire message (including the nick)
|
||||
from fool
|
||||
|
||||
Any other value disables fool highlighting altogether."
|
||||
However, at present, this option doesn't offer a means of highlighting
|
||||
matched mentions alone. See `erc-pal-highlight-type' for a summary of
|
||||
possible values and additional details common to categories like
|
||||
\\+`fool' that normally match against a message's sender."
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const message)
|
||||
|
|
@ -165,16 +176,10 @@ Any other value disables keyword highlighting altogether."
|
|||
|
||||
(defcustom erc-dangerous-host-highlight-type 'nick
|
||||
"Determines how to highlight messages by nicks from dangerous-hosts.
|
||||
See `erc-dangerous-hosts'.
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
`nick' - highlight nick from dangerous-host only
|
||||
`message' - highlight the entire message from dangerous-host
|
||||
`all' - highlight the entire message (including the nick)
|
||||
from dangerous-host
|
||||
|
||||
Any other value disables dangerous-host highlighting altogether."
|
||||
Use option `erc-dangerous-hosts' to specify patterns. See
|
||||
`erc-pal-highlight-type' for a summary of possible values as well as
|
||||
additional details common to categories like \\+`dangerous-host' that
|
||||
normally match against a message's sender."
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const message)
|
||||
|
|
|
|||
|
|
@ -22,6 +22,9 @@
|
|||
|
||||
(require 'ert-x)
|
||||
(require 'erc-match)
|
||||
(eval-and-compile
|
||||
(let ((load-path (cons (ert-resource-directory) load-path)))
|
||||
(require 'erc-tests-common)))
|
||||
|
||||
|
||||
(ert-deftest erc-add-entry-to-list ()
|
||||
|
|
@ -190,4 +193,400 @@
|
|||
(should (equal (cadr (pop calls)) nil))
|
||||
(should (equal erc-dangerous-hosts '("example.net")))))))
|
||||
|
||||
(defun erc-match-tests--assert-face-absent (face end)
|
||||
"Ensure FACE is absent from point until pos or substring END."
|
||||
(when (stringp end)
|
||||
(save-excursion
|
||||
(search-forward end)
|
||||
(setq end (1- (match-beginning 0)))))
|
||||
(ert-info ((format "Face %S absent throughout: %S" face
|
||||
(buffer-substring-no-properties (point) end)))
|
||||
(while (<= (point) end)
|
||||
(ert-info ((format "Looking at: (%d %c)" (char-after) (char-after)))
|
||||
(let ((val (ensure-list (get-text-property (point) 'font-lock-face))))
|
||||
(should-not (memq face val))))
|
||||
(forward-char))))
|
||||
|
||||
(defun erc-match-tests--assert-face-present (face end)
|
||||
"Ensure FACE is present from point until pos or substring END."
|
||||
(when (stringp end)
|
||||
(save-excursion
|
||||
(search-forward end)
|
||||
(setq end (1- (match-beginning 0)))))
|
||||
(ert-info ((format "Face %S appears throughout: %S" face
|
||||
(buffer-substring-no-properties (point) end)))
|
||||
(while (<= (point) end)
|
||||
(ert-info ((format "Looking at: (%d %c)" (char-after) (char-after)))
|
||||
(let ((val (ensure-list (get-text-property (point) 'font-lock-face))))
|
||||
(should (eq face (car val)))))
|
||||
(forward-char))))
|
||||
|
||||
(defun erc-match-tests--assert-speaker-highlighted (nick face)
|
||||
(search-forward (concat "<" nick ">"))
|
||||
(goto-char (pos-bol))
|
||||
(should (= (char-after) ?<))
|
||||
(should (equal (get-text-property (point) 'font-lock-face)
|
||||
'erc-default-face))
|
||||
|
||||
(ert-info ((format "Nick in <%s> highlighted" nick))
|
||||
(forward-char)
|
||||
(erc-match-tests--assert-face-present face "> "))
|
||||
|
||||
(should (= (char-after) ?>)))
|
||||
|
||||
(defun erc-match-tests--assert-speaker-only-highlighted (nick face)
|
||||
(erc-match-tests--assert-speaker-highlighted nick face)
|
||||
(ert-info ("Remaining text in line not highlighted")
|
||||
(erc-match-tests--assert-face-absent face (pos-eol))))
|
||||
|
||||
(defun erc-match-tests--perform (test)
|
||||
(erc-tests-common-make-server-buf)
|
||||
(setq erc-server-current-nick "tester")
|
||||
(with-current-buffer (erc--open-target "#chan")
|
||||
(funcall test))
|
||||
(when noninteractive
|
||||
(erc-tests-common-kill-buffers)))
|
||||
|
||||
;; The `nick' highlight type only covers a matching sender's speaker
|
||||
;; tag. It does not do any highlighting for pal/fool/dangerous-host
|
||||
;; mentions. While `current-nick' and `keyword' categories match
|
||||
;; against a message's content, the speaker's nick is still highlighted
|
||||
;; (in the corresponding face) when a match occurs.
|
||||
(defun erc-match-tests--hl-type-nick (face &optional test)
|
||||
(should (eq erc-current-nick-highlight-type 'keyword))
|
||||
(should (eq erc-keyword-highlight-type 'keyword))
|
||||
|
||||
(erc-match-tests--perform
|
||||
(lambda ()
|
||||
(erc-tests-common-add-cmem "bob")
|
||||
(erc-tests-common-add-cmem "alice")
|
||||
;; Change highlight type for match categories `keyword' and
|
||||
;; `current-nick' to `nick'.
|
||||
(let ((erc-current-nick-highlight-type 'nick)
|
||||
(erc-keyword-highlight-type 'nick)
|
||||
(erc-keywords '("thing")))
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi alice")
|
||||
(erc-tests-common-simulate-privmsg "alice" "hi bob")
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi tester")
|
||||
(erc-tests-common-simulate-privmsg "bob" "something blue"))
|
||||
(goto-char (point-min))
|
||||
|
||||
;; A sender's nick appears in `erc-{pals,fools,dangerous-hosts}',
|
||||
;; so the nick portion of their speaker tag alone is highlighted.
|
||||
(erc-match-tests--assert-speaker-only-highlighted "bob" face)
|
||||
|
||||
;; A non-matching sender mentions a would-be match (if message
|
||||
;; bodies were considered), and the nick portion of their speaker
|
||||
;; tag is *not* highlighted.
|
||||
(search-forward "<alice>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent face (pos-eol))
|
||||
|
||||
;; A matching sender mentions our own nick ("tester"), and their
|
||||
;; speaker's nick is highlighted in `erc-current-nick-face' instead
|
||||
;; of the normal category face (e.g., `erc-pal-face'). This
|
||||
;; happens because the implementation applies highlighting for
|
||||
;; non-NUH-based categories (`keyword' and `current-nick') after
|
||||
;; sender-based ones.
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(erc-match-tests--assert-speaker-only-highlighted
|
||||
"bob" 'erc-current-nick-face)
|
||||
|
||||
;; A matching sender mentions keyword "tester", and their speaker's
|
||||
;; nick is highlighted in `erc-keyword-face' instead of the normal
|
||||
;; category face for the same reason mentioned above.
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(erc-match-tests--assert-speaker-only-highlighted
|
||||
"bob" 'erc-keyword-face)
|
||||
|
||||
(when test
|
||||
(funcall test)))))
|
||||
|
||||
(defun erc-match-tests--hl-type-nick/mention (face)
|
||||
(erc-match-tests--hl-type-nick
|
||||
face
|
||||
(lambda ()
|
||||
(erc-tests-common-simulate-privmsg "alice" "bob: one")
|
||||
(erc-tests-common-simulate-privmsg "alice" "bob, two")
|
||||
(erc-tests-common-simulate-privmsg "alice" "three, bob.")
|
||||
|
||||
(search-forward "<alice> bob: one")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-speaker-only-highlighted "alice" face)
|
||||
|
||||
(search-forward "<alice> bob, two")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-speaker-only-highlighted "alice" face)
|
||||
|
||||
(search-forward "<alice> three, bob.")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-speaker-only-highlighted "alice" face))))
|
||||
|
||||
(ert-deftest erc-match-message/pal/nick ()
|
||||
(should (eq erc-pal-highlight-type 'nick))
|
||||
(let ((erc-pals (list "bob")))
|
||||
(erc-match-tests--hl-type-nick 'erc-pal-face)))
|
||||
|
||||
(ert-deftest erc-match-message/fool/nick ()
|
||||
(should (eq erc-fool-highlight-type 'nick))
|
||||
(let ((erc-fools (list "bob")))
|
||||
(erc-match-tests--hl-type-nick/mention 'erc-fool-face)))
|
||||
|
||||
(ert-deftest erc-match-message/dangerous-host/nick ()
|
||||
(should (eq erc-dangerous-host-highlight-type 'nick))
|
||||
(let ((erc-dangerous-hosts (list "bob")))
|
||||
(erc-match-tests--hl-type-nick 'erc-dangerous-host-face)))
|
||||
|
||||
(defun erc-match-tests--hl-type-message (face)
|
||||
(should (eq erc-current-nick-highlight-type 'keyword))
|
||||
(should (eq erc-keyword-highlight-type 'keyword))
|
||||
|
||||
(erc-match-tests--perform
|
||||
(lambda ()
|
||||
(erc-tests-common-add-cmem "bob")
|
||||
(erc-tests-common-add-cmem "alice")
|
||||
;; Change highlight type for categories `keyword' and
|
||||
;; `current-nick' to `message'.
|
||||
(let ((erc-current-nick-highlight-type 'message)
|
||||
(erc-keyword-highlight-type 'message)
|
||||
(erc-keywords '("thing")))
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi alice")
|
||||
(erc-tests-common-simulate-privmsg "alice" "hi bob")
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi tester")
|
||||
(erc-tests-common-simulate-privmsg "bob" "something blue"))
|
||||
(goto-char (point-min))
|
||||
|
||||
;; Message body portion appears in `erc-{pals,fools,dangerous-hosts}'.
|
||||
;; But the speaker portion is not highlighted by `match'.
|
||||
(erc-match-tests--assert-face-absent face "hi alice")
|
||||
(erc-match-tests--assert-face-present face
|
||||
(+ (point) (length "hi alice") -1))
|
||||
|
||||
;; A non-matching sender mentions a would-be match (if message
|
||||
;; bodies were considered), but nothing is highlighted.
|
||||
(search-forward "<alice>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent face (pos-eol))
|
||||
|
||||
;; A matching sender mentions our own nick ("tester"), and the
|
||||
;; message body is highlighted in `erc-current-nick-face' instead
|
||||
;; of the normal category face (e.g., `erc-pal-face').
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(save-excursion (erc-match-tests--assert-face-absent face "hi tester"))
|
||||
(erc-match-tests--assert-face-absent 'erc-current-nick-face "hi tester")
|
||||
(erc-match-tests--assert-face-present 'erc-current-nick-face (pos-eol))
|
||||
|
||||
;; A matching sender mentions keyword "thing", and the message body
|
||||
;; is highlighted in `erc-keyword-face' instead of the normal
|
||||
;; category face.
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(save-excursion (erc-match-tests--assert-face-absent face "something"))
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "something")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face (pos-eol)))))
|
||||
|
||||
(ert-deftest erc-match-message/pal/message ()
|
||||
(should (eq erc-pal-highlight-type 'nick))
|
||||
(let ((erc-pals (list "bob"))
|
||||
(erc-pal-highlight-type 'message))
|
||||
(erc-match-tests--hl-type-message 'erc-pal-face)))
|
||||
|
||||
(ert-deftest erc-match-message/fool/message ()
|
||||
(should (eq erc-fool-highlight-type 'nick))
|
||||
(let ((erc-fools (list "bob"))
|
||||
(erc-fool-highlight-type 'message))
|
||||
(erc-match-tests--hl-type-message 'erc-fool-face)))
|
||||
|
||||
(ert-deftest erc-match-message/dangerous-host/message ()
|
||||
(should (eq erc-dangerous-host-highlight-type 'nick))
|
||||
(let ((erc-dangerous-hosts (list "bob"))
|
||||
(erc-dangerous-host-highlight-type 'message))
|
||||
(erc-match-tests--hl-type-message 'erc-dangerous-host-face)))
|
||||
|
||||
(defun erc-match-tests--hl-type-all (face)
|
||||
(should (eq erc-current-nick-highlight-type 'keyword))
|
||||
(should (eq erc-keyword-highlight-type 'keyword))
|
||||
|
||||
(erc-match-tests--perform
|
||||
(lambda ()
|
||||
(erc-tests-common-add-cmem "bob")
|
||||
(erc-tests-common-add-cmem "alice")
|
||||
;; Change highlight type for categories `current-nick' and
|
||||
;; `keyword' to `all'.
|
||||
(let ((erc-current-nick-highlight-type 'all)
|
||||
(erc-keyword-highlight-type 'all)
|
||||
(erc-keywords '("thing")))
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi alice")
|
||||
(erc-tests-common-simulate-privmsg "alice" "hi bob")
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi tester")
|
||||
(erc-tests-common-simulate-privmsg "bob" "something blue"))
|
||||
(goto-char (point-min))
|
||||
|
||||
;; Entire message, including speaker appears in a speaker-based
|
||||
;; face `erc-{pals,fools,dangerous-hosts}'.
|
||||
(search-forward "<bob>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-present
|
||||
face (+ (point) (length "<bob> hi alice") -1))
|
||||
|
||||
;; A non-matching sender mentions a would-be match (if message
|
||||
;; bodies were considered), but nothing is highlighted.
|
||||
(search-forward "<alice>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent face (pos-eol))
|
||||
|
||||
;; A matching sender mentions our own nick ("tester"), and the
|
||||
;; entire message, including the speaker portion, is highlighted in
|
||||
;; `erc-current-nick-face' instead of the normal category face
|
||||
;; (e.g., `erc-pal-face').
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(save-excursion (erc-match-tests--assert-face-absent face (pos-eol)))
|
||||
(erc-match-tests--assert-face-present 'erc-current-nick-face (pos-eol))
|
||||
|
||||
;; A matching sender mentions keyword "thing", and the entire
|
||||
;; message is highlighted in `erc-keyword-face' instead of the
|
||||
;; normal category face.
|
||||
(should (looking-at (rx "<bob>")))
|
||||
(save-excursion (erc-match-tests--assert-face-absent face (pos-eol)))
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face (pos-eol)))))
|
||||
|
||||
(ert-deftest erc-match-message/pal/all ()
|
||||
(should (eq erc-pal-highlight-type 'nick))
|
||||
(let ((erc-pals (list "bob"))
|
||||
(erc-pal-highlight-type 'all))
|
||||
(erc-match-tests--hl-type-all 'erc-pal-face)))
|
||||
|
||||
(ert-deftest erc-match-message/fool/all ()
|
||||
(should (eq erc-fool-highlight-type 'nick))
|
||||
(let ((erc-fools (list "bob"))
|
||||
(erc-fool-highlight-type 'all))
|
||||
(erc-match-tests--hl-type-all 'erc-fool-face)))
|
||||
|
||||
(ert-deftest erc-match-message/dangerous-host/all ()
|
||||
(should (eq erc-dangerous-host-highlight-type 'nick))
|
||||
(let ((erc-dangerous-hosts (list "bob"))
|
||||
(erc-dangerous-host-highlight-type 'all))
|
||||
(erc-match-tests--hl-type-all 'erc-dangerous-host-face)))
|
||||
|
||||
(defun erc-match-tests--hl-type-nick-or-keyword ()
|
||||
(should (eq erc-current-nick-highlight-type 'keyword))
|
||||
|
||||
(erc-match-tests--perform
|
||||
(lambda ()
|
||||
(erc-tests-common-add-cmem "bob")
|
||||
(erc-tests-common-add-cmem "alice")
|
||||
;; Change highlight type for category `current-nick' from the
|
||||
;; default to `nick-or-keyword'.
|
||||
(let ((erc-current-nick-highlight-type 'nick-or-keyword))
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 353 tester = #chan :bob tester alice")
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 366 tester #chan :End of NAMES list")
|
||||
(erc-tests-common-simulate-privmsg "bob" "hi tester"))
|
||||
(goto-char (point-min))
|
||||
|
||||
;; An initial NAMES burst arrives. Its sender is "irc.foonet.org",
|
||||
;; so `match' skips the "nick" half of `nick-or-keyword' and
|
||||
;; considers the input non-NUH-based (because a host name alone
|
||||
;; can't be a real user). IOW, it pretends the option's value is
|
||||
;; `keyword', and highlights all occurrences in the message body.
|
||||
(search-forward "*** Users on #chan: bob tester")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent 'erc-current-nick-face "tester")
|
||||
(erc-match-tests--assert-face-present 'erc-current-nick-face
|
||||
(+ (point) (length "tester") -1))
|
||||
(erc-match-tests--assert-face-absent 'erc-current-nick-face (pos-eol))
|
||||
|
||||
;; Someone mentions our nick ("tester"), and only their speaker
|
||||
;; tag's nick is highlighted in `erc-current-nick-face' because
|
||||
;; that speaker is a real server user.
|
||||
(search-forward "<bob>")
|
||||
(goto-char (pos-bol))
|
||||
(should-not (get-text-property (point) 'erc-current-nick-face))
|
||||
(forward-char)
|
||||
(erc-match-tests--assert-face-present 'erc-current-nick-face
|
||||
"> hi tester")
|
||||
(erc-match-tests--assert-face-absent 'erc-current-nick-face
|
||||
(+ (point) (length "hi tester"))))))
|
||||
|
||||
(ert-deftest erc-match-message/current-nick/nick-or-keyword ()
|
||||
(erc-match-tests--hl-type-nick-or-keyword))
|
||||
|
||||
(defun erc-match-tests--hl-type-keyword ()
|
||||
(should (eq erc-keyword-highlight-type 'keyword))
|
||||
|
||||
(erc-match-tests--perform
|
||||
(lambda ()
|
||||
(erc-tests-common-add-cmem "bob")
|
||||
(erc-tests-common-add-cmem "imamodel")
|
||||
(erc-tests-common-add-cmem "ModerNerd")
|
||||
|
||||
(let ((erc-keywords '("mode")))
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 353 tester = #chan :bob imamodel ModerNerd tester")
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 366 tester #chan :End of NAMES list")
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 324 tester #chan +Cnt")
|
||||
(erc-tests-common-simulate-line
|
||||
":irc.foonet.org 329 tester #chan 1703579802")
|
||||
(erc-tests-common-simulate-privmsg "bob" "imamodel: spam a la mode!")
|
||||
(erc-tests-common-simulate-privmsg "imamodel" "hi bob"))
|
||||
|
||||
(goto-char (point-min))
|
||||
|
||||
;; All occurrences highlighted in a non-user-based message.
|
||||
(search-forward "*** Users on #chan:")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "model ")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face "l ")
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "Mode")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face "rNerd")
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
|
||||
|
||||
;; Formatted text matched against rather than original message.
|
||||
(search-forward "*** #chan modes:")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "modes:")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face "s: +Cnt")
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
|
||||
|
||||
;; All occurrences highlighted in a user-based message.
|
||||
(search-forward "<bob>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "model")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face "l: spam")
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face "mode!")
|
||||
(erc-match-tests--assert-face-present 'erc-keyword-face "!")
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol))
|
||||
|
||||
;; Matching speaker ignored.
|
||||
(search-forward "<imamodel>")
|
||||
(goto-char (pos-bol))
|
||||
(erc-match-tests--assert-face-absent 'erc-keyword-face (pos-eol)))))
|
||||
|
||||
(ert-deftest erc-match-message/keyword/keyword ()
|
||||
(erc-match-tests--hl-type-keyword))
|
||||
|
||||
(defun erc-match-tests--log-matches ()
|
||||
(let ((erc-log-matches-flag t)
|
||||
(erc-timestamp-format "[@@TS@@]"))
|
||||
(erc-match-tests--hl-type-keyword)
|
||||
(with-current-buffer "*scratch*"
|
||||
(ert-simulate-keys "\t\r"
|
||||
(erc-go-to-log-matches-buffer))
|
||||
(should (equal (buffer-name) "ERC Keywords"))
|
||||
(goto-char (point-min))
|
||||
(should (equal (buffer-string) "\
|
||||
== Type \"q\" to dismiss messages ==
|
||||
[@@TS@@]<Server:353:#chan> *** Users on #chan: bob imamodel ModerNerd tester
|
||||
[@@TS@@]<Server:324:#chan> *** #chan modes: +Cnt
|
||||
[@@TS@@]<bob:#chan> imamodel: spam a la mode!
|
||||
"))
|
||||
(when noninteractive
|
||||
(kill-buffer)))))
|
||||
|
||||
(ert-deftest erc-log-matches ()
|
||||
(erc-match-tests--log-matches))
|
||||
|
||||
|
||||
;;; erc-match-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -40,6 +40,10 @@
|
|||
(require 'ert-x)
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'erc-stamp))
|
||||
(eval-and-compile
|
||||
(let ((load-path (cons (expand-file-name "../erc-d" (ert-resource-directory))
|
||||
load-path)))
|
||||
(require 'erc-d-i)))
|
||||
|
||||
(defmacro erc-tests-common-equal-with-props (a b)
|
||||
"Compare strings A and B for equality including text props.
|
||||
|
|
@ -153,6 +157,39 @@ For simplicity, assume string evaluates to itself."
|
|||
(let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp))))
|
||||
(if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp))))
|
||||
|
||||
|
||||
(cl-defun erc-tests-common-add-cmem
|
||||
(nick &optional (host "fsf.org")
|
||||
(user (concat "~" (substring nick 0 (min 10 (length nick)))))
|
||||
(full-name (upcase-initials nick)))
|
||||
"Create channel user for NICK with test-oriented defaults."
|
||||
(erc-update-channel-member (erc-target) nick nick t nil nil nil nil nil
|
||||
host user full-name))
|
||||
|
||||
(defun erc-tests-common-parse-line (line)
|
||||
"Return a single `erc-response' parsed from line."
|
||||
(let ((parsed (erc-d-i--parse-message line)))
|
||||
(make-erc-response :unparsed (erc-d-i-message.unparsed parsed)
|
||||
:sender (erc-d-i-message.sender parsed)
|
||||
:command (erc-d-i-message.command parsed)
|
||||
:command-args (erc-d-i-message.command-args parsed)
|
||||
:contents (erc-d-i-message.contents parsed)
|
||||
:tags (erc-d-i-message.tags parsed))))
|
||||
|
||||
(defun erc-tests-common-simulate-line (line)
|
||||
"Run response handlers for raw IRC protocol LINE."
|
||||
(let ((parsed (erc-tests-common-parse-line line))
|
||||
(erc--msg-prop-overrides (or erc--msg-prop-overrides
|
||||
'((erc--ts . 0)))))
|
||||
(erc-call-hooks erc-server-process parsed)))
|
||||
|
||||
(defun erc-tests-common-simulate-privmsg (nick msg)
|
||||
(erc-tests-common-simulate-line
|
||||
(format ":%s PRIVMSG %s :%s"
|
||||
(erc-user-spec (erc-get-server-user nick))
|
||||
(erc-target)
|
||||
msg)))
|
||||
|
||||
;; 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 ()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue