c356f86b51
* lisp/erc/erc-backend (erc--isupport-params): Add new variable to hold a hashmap of parsed `erc-server-parameters' in a more useful format. But keep `erc-server-parameters' around for public use. We currently lack dedicated local variables for certain discovered IRC session properties, such as what prefix characters are supported for channels, etc. And the truth of this needs querying many times per second at various points. As such, caching here seems justified but can be easily removed if deemed otherwise because all ingredients are internal. (erc--parse-isupport-value): Add helper function that parses an ISUPPORT value and returns the component parts with backslash-x hex escapes removed. This can probably use some streamlining. (erc--with-memoization): Add compat alias for use in internal ISUPPORT getter. Should be moved to `erc-compat.el' when that library is fully reincorporated. (erc--get-isupport-entry): Add internal getter to look up ISUPPORT items. (erc-server-005): Treat `erc-server-response' "command args" field as read-only. Previously, this field was set to nil after processing, which was unhelpful to other parts of the library. Also call above mentioned helper to parse values. And add some bookkeeping to handle negation. * lisp/erc/erc-capab.el (erc-capab-identify-send-messages): Use internal ISUPPORT getter. * lisp/erc/erc.el (erc-cmd-NICK, erc-parse-prefix, erc-nickname-in-use): Use internal ISUPPORT getter. * test/lisp/erc/erc-tests.el: Add tests for the above mentioned changes in erc-backend.el.
613 lines
24 KiB
EmacsLisp
613 lines
24 KiB
EmacsLisp
;;; erc-tests.el --- Tests for erc. -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
|
|
|
|
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
|
|
|
|
;; 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/>.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert-x)
|
|
(require 'erc)
|
|
(require 'erc-ring)
|
|
(require 'erc-networks)
|
|
|
|
(ert-deftest erc--read-time-period ()
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
|
|
(should (equal (erc--read-time-period "foo: ") nil)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")))
|
|
(should (equal (erc--read-time-period "foo: ") nil)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 432 ")))
|
|
(should (equal (erc--read-time-period "foo: ") 432)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "432")))
|
|
(should (equal (erc--read-time-period "foo: ") 432)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h")))
|
|
(should (equal (erc--read-time-period "foo: ") 3600)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h10s")))
|
|
(should (equal (erc--read-time-period "foo: ") 3610)))
|
|
|
|
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
|
|
(should (equal (erc--read-time-period "foo: ") 86400))))
|
|
|
|
(ert-deftest erc--meta--backend-dependencies ()
|
|
(with-temp-buffer
|
|
(insert-file-contents-literally
|
|
(concat (file-name-sans-extension (symbol-file 'erc)) ".el"))
|
|
(let ((beg (search-forward ";; Defined in erc-backend"))
|
|
(end (search-forward "\n\n"))
|
|
vars)
|
|
(save-excursion
|
|
(save-restriction
|
|
(narrow-to-region beg end)
|
|
(goto-char (point-min))
|
|
(with-syntax-table lisp-data-mode-syntax-table
|
|
(condition-case _
|
|
(while (push (cadr (read (current-buffer))) vars))
|
|
(end-of-file)))))
|
|
(should (= (point) end))
|
|
(dolist (var vars)
|
|
(setq var (concat "\\_<" (symbol-name var) "\\_>"))
|
|
(ert-info (var)
|
|
(should (save-excursion (search-forward-regexp var nil t))))))))
|
|
|
|
(ert-deftest erc-with-all-buffers-of-server ()
|
|
(let (proc-exnet
|
|
proc-onet
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
(with-current-buffer (get-buffer-create "OtherNet")
|
|
(erc-mode)
|
|
(setq proc-onet (start-process "sleep" (current-buffer) "sleep" "1")
|
|
erc-server-process proc-onet
|
|
erc-network 'OtherNet)
|
|
(set-process-query-on-exit-flag erc-server-process nil))
|
|
|
|
(with-current-buffer (get-buffer-create "ExampleNet")
|
|
(erc-mode)
|
|
(setq proc-exnet (start-process "sleep" (current-buffer) "sleep" "1")
|
|
erc-server-process proc-exnet
|
|
erc-network 'ExampleNet)
|
|
(set-process-query-on-exit-flag erc-server-process nil))
|
|
|
|
(with-current-buffer (get-buffer-create "#foo")
|
|
(erc-mode)
|
|
(setq erc-server-process proc-exnet)
|
|
(setq erc-default-recipients '("#foo")))
|
|
|
|
(with-current-buffer (get-buffer-create "#spam")
|
|
(erc-mode)
|
|
(setq erc-server-process proc-onet)
|
|
(setq erc-default-recipients '("#spam")))
|
|
|
|
(with-current-buffer (get-buffer-create "#bar")
|
|
(erc-mode)
|
|
(setq erc-server-process proc-onet)
|
|
(setq erc-default-recipients '("#bar")))
|
|
|
|
(with-current-buffer (get-buffer-create "#baz")
|
|
(erc-mode)
|
|
(setq erc-server-process proc-exnet)
|
|
(setq erc-default-recipients '("#baz")))
|
|
|
|
(should (eq (get-buffer-process "ExampleNet") proc-exnet))
|
|
(erc-with-all-buffers-of-server (get-buffer-process "ExampleNet")
|
|
nil
|
|
(kill-buffer))
|
|
|
|
(should-not (get-buffer "ExampleNet"))
|
|
(should-not (get-buffer "#foo"))
|
|
(should-not (get-buffer "#baz"))
|
|
(should (get-buffer "OtherNet"))
|
|
(should (get-buffer "#bar"))
|
|
(should (get-buffer "#spam"))
|
|
|
|
(let* ((test (lambda () (not (string= (buffer-name) "#spam"))))
|
|
(calls 0)
|
|
(get-test (lambda () (cl-incf calls) test)))
|
|
|
|
(erc-with-all-buffers-of-server proc-onet
|
|
(funcall get-test)
|
|
(kill-buffer))
|
|
|
|
(should (= calls 1)))
|
|
|
|
(should-not (get-buffer "OtherNet"))
|
|
(should-not (get-buffer "#bar"))
|
|
(should (get-buffer "#spam"))
|
|
(kill-buffer "#spam")))
|
|
|
|
(defun erc-tests--send-prep ()
|
|
;; Caller should probably shadow `erc-insert-modify-hook' or
|
|
;; populate user tables for erc-button.
|
|
(erc-mode)
|
|
(insert "\n\n")
|
|
(setq erc-input-marker (make-marker)
|
|
erc-insert-marker (make-marker))
|
|
(set-marker erc-insert-marker (point-max))
|
|
(erc-display-prompt)
|
|
(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-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
(with-current-buffer (get-buffer-create "ServNet")
|
|
(erc-tests--send-prep)
|
|
(goto-char erc-insert-marker)
|
|
(should (looking-at-p (regexp-quote erc-prompt)))
|
|
(erc-tests--set-fake-server-process "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)
|
|
(goto-char erc-insert-marker)
|
|
(should (looking-at-p (regexp-quote erc-prompt)))
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "ServNet"))
|
|
erc-default-recipients '("#chan")))
|
|
|
|
(with-current-buffer (get-buffer-create "bob")
|
|
(erc-tests--send-prep)
|
|
(goto-char erc-insert-marker)
|
|
(should (looking-at-p (regexp-quote erc-prompt)))
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "ServNet"))
|
|
erc-default-recipients '("bob")))
|
|
|
|
(ert-info ("Value: t (default)")
|
|
(should (eq erc-hide-prompt t))
|
|
(with-current-buffer "ServNet"
|
|
(should (= (point) erc-insert-marker))
|
|
(erc--hide-prompt erc-server-process)
|
|
(should (string= ">" (get-text-property (point) 'display))))
|
|
|
|
(with-current-buffer "#chan"
|
|
(goto-char erc-insert-marker)
|
|
(should (string= ">" (get-text-property (point) 'display)))
|
|
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
|
|
(goto-char erc-input-marker)
|
|
(ert-simulate-command '(self-insert-command 1 ?/))
|
|
(goto-char erc-insert-marker)
|
|
(should-not (get-text-property (point) 'display))
|
|
(should-not (memq #'erc--unhide-prompt-on-self-insert
|
|
pre-command-hook)))
|
|
|
|
(with-current-buffer "bob"
|
|
(goto-char erc-insert-marker)
|
|
(should (string= ">" (get-text-property (point) 'display)))
|
|
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
|
|
(goto-char erc-input-marker)
|
|
(ert-simulate-command '(self-insert-command 1 ?/))
|
|
(goto-char erc-insert-marker)
|
|
(should-not (get-text-property (point) 'display))
|
|
(should-not (memq #'erc--unhide-prompt-on-self-insert
|
|
pre-command-hook)))
|
|
|
|
(with-current-buffer "ServNet"
|
|
(should (get-text-property erc-insert-marker 'display))
|
|
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
|
|
(erc--unhide-prompt)
|
|
(should-not (memq #'erc--unhide-prompt-on-self-insert
|
|
pre-command-hook))
|
|
(should-not (get-text-property erc-insert-marker 'display))))
|
|
|
|
(ert-info ("Value: server")
|
|
(setq erc-hide-prompt '(server))
|
|
(with-current-buffer "ServNet"
|
|
(erc--hide-prompt erc-server-process)
|
|
(should (string= ">" (get-text-property erc-insert-marker 'display))))
|
|
|
|
(with-current-buffer "#chan"
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "bob"
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "ServNet"
|
|
(erc--unhide-prompt)
|
|
(should-not (get-text-property erc-insert-marker 'display))))
|
|
|
|
(ert-info ("Value: channel")
|
|
(setq erc-hide-prompt '(channel))
|
|
(with-current-buffer "ServNet"
|
|
(erc--hide-prompt erc-server-process)
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "bob"
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "#chan"
|
|
(should (string= ">" (get-text-property erc-insert-marker 'display)))
|
|
(erc--unhide-prompt)
|
|
(should-not (get-text-property erc-insert-marker 'display))))
|
|
|
|
(ert-info ("Value: query")
|
|
(setq erc-hide-prompt '(query))
|
|
(with-current-buffer "ServNet"
|
|
(erc--hide-prompt erc-server-process)
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "bob"
|
|
(should (string= ">" (get-text-property erc-insert-marker 'display)))
|
|
(erc--unhide-prompt)
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "#chan"
|
|
(should-not (get-text-property erc-insert-marker 'display))))
|
|
|
|
(ert-info ("Value: nil")
|
|
(setq erc-hide-prompt nil)
|
|
(with-current-buffer "ServNet"
|
|
(erc--hide-prompt erc-server-process)
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "bob"
|
|
(should-not (get-text-property erc-insert-marker 'display)))
|
|
|
|
(with-current-buffer "#chan"
|
|
(should-not (get-text-property erc-insert-marker 'display))
|
|
(erc--unhide-prompt) ; won't blow up when prompt already showing
|
|
(should-not (get-text-property erc-insert-marker 'display))))
|
|
|
|
(when noninteractive
|
|
(kill-buffer "#chan")
|
|
(kill-buffer "bob")
|
|
(kill-buffer "ServNet"))))
|
|
|
|
(ert-deftest erc--switch-to-buffer ()
|
|
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
|
|
|
|
(let ((proc (start-process "aNet" (current-buffer) "true"))
|
|
(erc-modified-channels-alist `(("fake") (,(messages-buffer))))
|
|
(inhibit-message noninteractive)
|
|
(completion-fail-discreetly t) ; otherwise ^G^G printed to .log file
|
|
;;
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
(with-current-buffer (get-buffer-create "server")
|
|
(erc-mode)
|
|
(set-process-buffer (setq erc-server-process proc) (current-buffer))
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-server-process proc))
|
|
(with-current-buffer (get-buffer-create "#foo")
|
|
(erc-mode)
|
|
(setq erc-server-process proc))
|
|
|
|
(ert-info ("Channel #chan selectable from server buffer")
|
|
(ert-simulate-keys (list ?# ?c ?h ?a ?n ?\C-m)
|
|
(should (string= "#chan" (erc--switch-to-buffer))))))
|
|
|
|
(ert-info ("Channel #foo selectable from non-ERC buffer")
|
|
(ert-simulate-keys (list ?# ?f ?o ?o ?\C-m)
|
|
(should (string= "#foo" (erc--switch-to-buffer)))))
|
|
|
|
(ert-info ("Default selectable")
|
|
(ert-simulate-keys (list ?\C-m)
|
|
(should (string= "*Messages*" (erc--switch-to-buffer)))))
|
|
|
|
(ert-info ("Extant but non-ERC buffer not selectable")
|
|
(get-buffer-create "#fake") ; not ours
|
|
(ert-simulate-keys (kbd "#fake C-m C-a C-k C-m")
|
|
;; Initial query fails ~~~~~~^; clearing input accepts default
|
|
(should (string= "*Messages*" (erc--switch-to-buffer)))))
|
|
|
|
(with-current-buffer (get-buffer-create "other")
|
|
(erc-mode)
|
|
(setq erc-server-process (start-process "bNet" (current-buffer) "true"))
|
|
(set-process-query-on-exit-flag erc-server-process nil))
|
|
|
|
(ert-info ("Foreign ERC buffer not selectable")
|
|
(ert-simulate-keys (kbd "other C-m C-a C-k C-m")
|
|
(with-current-buffer "server"
|
|
(should (string= "*Messages*" (erc--switch-to-buffer))))))
|
|
|
|
(ert-info ("Any ERC-buffer selectable from non-ERC buffer")
|
|
(should-not (eq major-mode 'erc-mode))
|
|
(ert-simulate-keys (list ?o ?t ?h ?e ?r ?\C-m)
|
|
(should (string= "other" (erc--switch-to-buffer)))))
|
|
|
|
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
|
|
(kill-buffer b))))
|
|
|
|
(ert-deftest erc-lurker-maybe-trim ()
|
|
(let (erc-lurker-trim-nicks
|
|
(erc-lurker-ignore-chars "_`"))
|
|
|
|
(should (string= "nick`" (erc-lurker-maybe-trim "nick`")))
|
|
|
|
(setq erc-lurker-trim-nicks t)
|
|
(should (string= "nick" (erc-lurker-maybe-trim "nick`")))
|
|
(should (string= "ni`_ck" (erc-lurker-maybe-trim "ni`_ck__``")))
|
|
|
|
(setq erc-lurker-ignore-chars "_-`") ; set of chars, not character alts
|
|
(should (string= "nick" (erc-lurker-maybe-trim "nick-_`")))))
|
|
|
|
(ert-deftest erc--parse-isupport-value ()
|
|
(should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
|
|
(should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))
|
|
|
|
(should (equal (erc--parse-isupport-value "abc") '("abc")))
|
|
(should (equal (erc--parse-isupport-value "\\x20foo") '(" foo")))
|
|
(should (equal (erc--parse-isupport-value "foo\\x20") '("foo ")))
|
|
(should (equal (erc--parse-isupport-value "a\\x20b\\x20c") '("a b c")))
|
|
(should (equal (erc--parse-isupport-value "a\\x20b\\x20c\\x20") '("a b c ")))
|
|
(should (equal (erc--parse-isupport-value "\\x20a\\x20b\\x20c") '(" a b c")))
|
|
(should (equal (erc--parse-isupport-value "a\\x20\\x20c") '("a c")))
|
|
(should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" ")))
|
|
(should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/")))
|
|
(should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19")))
|
|
(should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c"))))
|
|
|
|
(ert-deftest erc--get-isupport-entry ()
|
|
(let ((erc--isupport-params (make-hash-table))
|
|
(erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
|
|
(items (lambda ()
|
|
(cl-loop for k being the hash-keys of erc--isupport-params
|
|
using (hash-values v) collect (cons k v)))))
|
|
|
|
(should-not (erc--get-isupport-entry 'FAKE))
|
|
(should-not (erc--get-isupport-entry 'FAKE 'single))
|
|
(should (zerop (hash-table-count erc--isupport-params)))
|
|
|
|
(should (equal (erc--get-isupport-entry 'BAR) '(BAR)))
|
|
(should-not (erc--get-isupport-entry 'BAR 'single))
|
|
(should (= 1 (hash-table-count erc--isupport-params)))
|
|
|
|
(should (equal (erc--get-isupport-entry 'BAZ) '(BAZ "A" "B" "C")))
|
|
(should (equal (erc--get-isupport-entry 'BAZ 'single) "A"))
|
|
(should (= 2 (hash-table-count erc--isupport-params)))
|
|
|
|
(should (equal (erc--get-isupport-entry 'FOO 'single) "1"))
|
|
(should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
|
|
|
|
(should (equal (funcall items)
|
|
'((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
|
|
|
|
(ert-deftest erc-server-005 ()
|
|
(let* ((hooked 0)
|
|
(verify #'ignore)
|
|
(hook (lambda (_ _) (funcall verify) (cl-incf hooked)))
|
|
(erc-server-005-functions (list #'erc-server-005 hook #'ignore))
|
|
erc-server-parameters
|
|
erc--isupport-params
|
|
erc-timer-hook
|
|
calls
|
|
args
|
|
parsed)
|
|
|
|
(cl-letf (((symbol-function 'erc-display-message)
|
|
(lambda (_ _ _ line) (push line calls))))
|
|
|
|
(ert-info ("Baseline")
|
|
(setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
|
|
parsed (make-erc-response :command-args args :command "005"))
|
|
|
|
(setq verify
|
|
(lambda ()
|
|
(should (equal erc-server-parameters
|
|
'(("PREFIX" . "(ov)@+") ("EXCEPTS")
|
|
("BOT" . "B"))))
|
|
(should (zerop (hash-table-count erc--isupport-params)))
|
|
(should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
|
|
(should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
|
|
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
|
|
(should (string= (pop calls)
|
|
"BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
|
|
(should (equal args (erc-response.command-args parsed)))))
|
|
|
|
(erc-call-hooks nil parsed))
|
|
|
|
(ert-info ("Negated, updated")
|
|
(setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
|
|
parsed (make-erc-response :command-args args :command "005"))
|
|
|
|
(setq verify
|
|
(lambda ()
|
|
(should (equal erc-server-parameters
|
|
'(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
|
|
(should (string= (pop calls)
|
|
"-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
|
|
(should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
|
|
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
|
|
(should-not (erc--get-isupport-entry 'EXCEPTS))
|
|
(should (equal args (erc-response.command-args parsed)))))
|
|
|
|
(erc-call-hooks nil parsed))
|
|
(should (= hooked 2)))))
|
|
|
|
(ert-deftest erc-ring-previous-command-base-case ()
|
|
(ert-info ("Create ring when nonexistent and do nothing")
|
|
(let (erc-input-ring
|
|
erc-input-ring-index)
|
|
(erc-previous-command)
|
|
(should (ring-p erc-input-ring))
|
|
(should (zerop (ring-length erc-input-ring)))
|
|
(should-not erc-input-ring-index)))
|
|
(should-not erc-input-ring))
|
|
|
|
(ert-deftest erc-ring-previous-command ()
|
|
(with-current-buffer (get-buffer-create "*#fake*")
|
|
(erc-mode)
|
|
(erc-tests--send-prep)
|
|
(setq-local erc-last-input-time 0)
|
|
(should-not (local-variable-if-set-p 'erc-send-completed-hook))
|
|
(set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
|
|
;; Just in case erc-ring-mode is already on
|
|
(setq-local erc-pre-send-functions nil)
|
|
(add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
|
|
;;
|
|
(cl-letf (((symbol-function 'erc-process-input-line)
|
|
(lambda (&rest _)
|
|
(insert-before-markers
|
|
(erc-display-message-highlight 'notice "echo: one\n"))))
|
|
((symbol-function 'erc-command-no-process-p)
|
|
(lambda (&rest _) t)))
|
|
(ert-info ("Create ring, populate, recall")
|
|
(insert "/one")
|
|
(erc-send-current-line)
|
|
(should (ring-p erc-input-ring))
|
|
(should (zerop (ring-member erc-input-ring "/one"))) ; equal
|
|
(should (save-excursion (forward-line -1) (goto-char (point-at-bol))
|
|
(looking-at-p "[*]+ echo: one")))
|
|
(should-not erc-input-ring-index)
|
|
(erc-bol)
|
|
(should (looking-at "$"))
|
|
(erc-previous-command)
|
|
(erc-bol)
|
|
(should (looking-at "/one"))
|
|
(should (zerop erc-input-ring-index)))
|
|
(ert-info ("Back to one")
|
|
(should (= (ring-length erc-input-ring) (1+ erc-input-ring-index)))
|
|
(erc-previous-command)
|
|
(should-not erc-input-ring-index)
|
|
(erc-bol)
|
|
(should (looking-at "$"))
|
|
(should (equal (ring-ref erc-input-ring 0) "/one")))
|
|
(ert-info ("Swap input after prompt with previous (#bug46339)")
|
|
(insert "abc")
|
|
(erc-previous-command)
|
|
(should (= 1 erc-input-ring-index))
|
|
(erc-bol)
|
|
(should (looking-at "/one"))
|
|
(should (equal (ring-ref erc-input-ring 0) "abc"))
|
|
(should (equal (ring-ref erc-input-ring 1) "/one"))
|
|
(erc-next-command)
|
|
(erc-bol)
|
|
(should (looking-at "abc")))))
|
|
(when noninteractive
|
|
(kill-buffer "*#fake*")))
|
|
|
|
(ert-deftest erc-log-irc-protocol ()
|
|
(should-not erc-debug-irc-protocol)
|
|
(with-temp-buffer
|
|
(setq erc-server-process (start-process "fake" (current-buffer) "true")
|
|
erc-server-current-nick "tester"
|
|
erc-session-server "myproxy.localhost"
|
|
erc-session-port 6667)
|
|
(let ((inhibit-message noninteractive))
|
|
(erc-toggle-debug-irc-protocol)
|
|
(erc-log-irc-protocol "PASS changeme\r\n" 'outgoing)
|
|
(setq erc-server-announced-name "irc.gnu.org")
|
|
(erc-log-irc-protocol ":irc.gnu.org 001 tester :Welcome")
|
|
(erc-log-irc-protocol ":irc.gnu.org 002 tester :Your host is irc.gnu.org")
|
|
(setq erc-network 'FooNet)
|
|
(erc-log-irc-protocol ":irc.gnu.org 422 tester :MOTD missing")
|
|
(setq erc-network 'BarNet)
|
|
(erc-log-irc-protocol ":irc.gnu.org 221 tester +i")
|
|
(set-process-query-on-exit-flag erc-server-process nil)))
|
|
(with-current-buffer "*erc-protocol*"
|
|
(goto-char (point-min))
|
|
(search-forward "Version")
|
|
(search-forward "\r\n\r\n")
|
|
(search-forward "myproxy.localhost:6667 >> PASS" (line-end-position))
|
|
(forward-line)
|
|
(search-forward "irc.gnu.org << :irc.gnu.org 001" (line-end-position))
|
|
(forward-line)
|
|
(search-forward "irc.gnu.org << :irc.gnu.org 002" (line-end-position))
|
|
(forward-line)
|
|
(search-forward "FooNet << :irc.gnu.org 422" (line-end-position))
|
|
(forward-line)
|
|
(search-forward "BarNet << :irc.gnu.org 221" (line-end-position)))
|
|
(when noninteractive
|
|
(kill-buffer "*erc-protocol*")
|
|
(should-not erc-debug-irc-protocol)))
|
|
|
|
|
|
;; The point of this test is to ensure output is handled identically
|
|
;; regardless of whether a command handler is summoned.
|
|
|
|
(ert-deftest erc-process-input-line ()
|
|
(let (erc-server-last-sent-time
|
|
erc-server-flood-queue
|
|
(orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
|
|
(erc-default-recipients '("#chan"))
|
|
calls)
|
|
(with-temp-buffer
|
|
(cl-letf (((symbol-function 'erc-cmd-MSG)
|
|
(lambda (line)
|
|
(push line calls)
|
|
(funcall orig-erc-cmd-MSG line)))
|
|
((symbol-function 'erc-server-buffer)
|
|
(lambda () (current-buffer)))
|
|
((symbol-function 'erc-server-process-alive)
|
|
(lambda () t))
|
|
((symbol-function 'erc-server-send-queue)
|
|
#'ignore))
|
|
|
|
(ert-info ("Dispatch to user command handler")
|
|
|
|
(ert-info ("Baseline")
|
|
(erc-process-input-line "/msg #chan hi\n")
|
|
(should (equal (pop calls) " #chan hi"))
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :hi\r\n" . utf-8))))
|
|
|
|
(ert-info ("Quote preserves line intact")
|
|
(erc-process-input-line "/QUOTE FAKE foo bar\n")
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("FAKE foo bar\r\n" . utf-8))))
|
|
|
|
(ert-info ("Unknown command respected")
|
|
(erc-process-input-line "/FAKE foo bar\n")
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("FAKE foo bar\r\n" . utf-8))))
|
|
|
|
(ert-info ("Spaces preserved")
|
|
(erc-process-input-line "/msg #chan hi you\n")
|
|
(should (equal (pop calls) " #chan hi you"))
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
|
|
|
|
(ert-info ("Empty line honored")
|
|
(erc-process-input-line "/msg #chan\n")
|
|
(should (equal (pop calls) " #chan"))
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :\r\n" . utf-8)))))
|
|
|
|
(ert-info ("Implicit cmd via `erc-send-input-line-function'")
|
|
|
|
(ert-info ("Baseline")
|
|
(erc-process-input-line "hi")
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :hi\r\n" . utf-8))))
|
|
|
|
(ert-info ("Spaces preserved")
|
|
(erc-process-input-line "hi you")
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
|
|
|
|
(ert-info ("Empty line transmitted without injected-space kludge")
|
|
(erc-process-input-line "")
|
|
(should (equal (pop erc-server-flood-queue)
|
|
'("PRIVMSG #chan :\r\n" . utf-8))))
|
|
|
|
(should-not calls))))))
|
|
|
|
;;; erc-tests.el ends here
|