emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 9bddb264ba8 4/5: Add baseline test coverage for erc-match


From: F. Jason Park
Subject: master 9bddb264ba8 4/5: Add baseline test coverage for erc-match
Date: Fri, 11 Oct 2024 19:16:32 -0400 (EDT)

branch: master
commit 9bddb264ba851f39068773b9538de4170928e159
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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.
---
 lisp/erc/erc-match.el                       |  51 ++--
 test/lisp/erc/erc-match-tests.el            | 399 ++++++++++++++++++++++++++++
 test/lisp/erc/resources/erc-tests-common.el |  37 +++
 3 files changed, 464 insertions(+), 23 deletions(-)

diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 8497382a733..e28e7122cce 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -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'.
-
-The following values are allowed:
-
-    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."
+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:
+
+  <speaker> USER: hi.
+  <speaker> USER, hi.
+
+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)
diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el
index 34610fc0438..d22a945724b 100644
--- a/test/lisp/erc/erc-match-tests.el
+++ b/test/lisp/erc/erc-match-tests.el
@@ -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
diff --git a/test/lisp/erc/resources/erc-tests-common.el 
b/test/lisp/erc/resources/erc-tests-common.el
index 91654467dae..db0c5d626c9 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -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 ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]