1826 lines
76 KiB
EmacsLisp
1826 lines
76 KiB
EmacsLisp
;;; erc-networks-tests.el --- Tests for erc-networks. -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2020-2024 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/>.
|
|
|
|
;;; Code:
|
|
(require 'erc-compat)
|
|
|
|
(require 'ert-x) ; cl-lib
|
|
(eval-and-compile
|
|
(let ((load-path (cons (ert-resource-directory) load-path)))
|
|
(require 'erc-tests-common)))
|
|
|
|
(defun erc-networks-tests--create-dead-proc (&optional buf)
|
|
(let ((p (start-process "true" (or buf (current-buffer)) "true")))
|
|
(while (process-live-p p) (sit-for 0.1))
|
|
p))
|
|
|
|
(defun erc-networks-tests--create-live-proc ()
|
|
(erc-tests-common-init-server-proc "sleep" "1"))
|
|
|
|
;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS.
|
|
(defun erc-networks-tests--clean-bufs ()
|
|
(erc-tests-common-kill-buffers))
|
|
|
|
(defun erc-networks-tests--bufnames (prefix)
|
|
(let* ((case-fold-search)
|
|
(pred (lambda (b) (string-prefix-p prefix (buffer-name b))))
|
|
(prefixed (seq-filter pred (buffer-list))))
|
|
(sort (mapcar #'buffer-name prefixed) #'string<)))
|
|
|
|
(ert-deftest erc-networks--id ()
|
|
(cl-letf (((symbol-function 'float-time)
|
|
(lambda (&optional _) 0.0)))
|
|
|
|
;; Fixed
|
|
(should (equal (erc-networks--id-fixed-create 'foo)
|
|
(make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol 'foo)))
|
|
|
|
;; Eliding
|
|
(let* ((erc-network 'FooNet)
|
|
(erc-server-current-nick "Joe")
|
|
(identity (erc-networks--id-create nil)))
|
|
|
|
(should (equal identity #s(erc-networks--id-qualifying
|
|
0.0 FooNet [FooNet "joe"] 1)))
|
|
(should (equal (erc-networks--id-qualifying-grow-id identity)
|
|
'FooNet/joe))
|
|
(should (equal identity #s(erc-networks--id-qualifying
|
|
0.0 FooNet/joe [FooNet "joe"] 2)))
|
|
(should-not (erc-networks--id-qualifying-grow-id identity))
|
|
(should (equal identity #s(erc-networks--id-qualifying
|
|
0.0 FooNet/joe [FooNet "joe"] 2))))
|
|
|
|
;; Compat
|
|
(with-current-buffer (get-buffer-create "fake.chat")
|
|
(with-suppressed-warnings ((obsolete erc-rename-buffers))
|
|
(let (erc-rename-buffers)
|
|
(should (equal (erc-networks--id-create nil)
|
|
(make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol 'fake.chat)))))
|
|
(kill-buffer))))
|
|
|
|
(ert-deftest erc-networks--id-string ()
|
|
(should (equal (erc-networks--id-string (erc-networks--id-fixed-create 'foo))
|
|
"foo"))
|
|
(should (equal (let* ((erc-network 'FooNet)
|
|
(erc-server-current-nick "Joe")) ; needs letstar
|
|
(erc-networks--id-string (erc-networks--id-create nil)))
|
|
"FooNet")))
|
|
|
|
(ert-deftest erc-networks--id-create ()
|
|
(cl-letf (((symbol-function 'float-time)
|
|
(lambda (&optional _) 0.0)))
|
|
|
|
(should (equal (erc-networks--id-create 'foo)
|
|
(make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol 'foo)))
|
|
(should (equal (erc-networks--id-create "foo")
|
|
(make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol 'foo)))
|
|
(should (equal (erc-networks--id-create [h i])
|
|
(make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol (quote \[h\ \i\]))))
|
|
|
|
(with-current-buffer (get-buffer-create "foo")
|
|
(let ((expected (make-erc-networks--id-fixed :ts (float-time)
|
|
:symbol 'foo)))
|
|
(with-suppressed-warnings ((obsolete erc-rename-buffers))
|
|
(let (erc-rename-buffers)
|
|
(should (equal (erc-networks--id-create nil) expected))))
|
|
(with-suppressed-warnings ((obsolete erc-reuse-buffers))
|
|
(let (erc-reuse-buffers)
|
|
(should (equal (erc-networks--id-create nil) expected))
|
|
(should (equal (erc-networks--id-create 'bar) expected)))))
|
|
(kill-buffer))))
|
|
|
|
(ert-deftest erc-networks--id-qualifying-prefix-length ()
|
|
(should-not (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying)
|
|
(make-erc-networks--id-qualifying)))
|
|
|
|
(should-not (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying :parts [1 2])
|
|
(make-erc-networks--id-qualifying :parts [2 3])))
|
|
|
|
(should (= 1 (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying :parts [1])
|
|
(make-erc-networks--id-qualifying :parts [1 2]))))
|
|
|
|
(should (= 1 (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying :parts [1 2])
|
|
(make-erc-networks--id-qualifying :parts [1 3]))))
|
|
|
|
(should (= 2 (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying :parts [1 2])
|
|
(make-erc-networks--id-qualifying :parts [1 2]))))
|
|
|
|
(should (= 1 (erc-networks--id-qualifying-prefix-length
|
|
(make-erc-networks--id-qualifying :parts ["1"])
|
|
(make-erc-networks--id-qualifying :parts ["1"])))))
|
|
|
|
(ert-deftest erc-networks--id-sort-buffers ()
|
|
(let (oldest middle newest)
|
|
|
|
(with-temp-buffer
|
|
(setq erc-networks--id (erc-networks--id-fixed-create 'oldest)
|
|
oldest (current-buffer))
|
|
(sleep-for 0.02)
|
|
|
|
(with-temp-buffer
|
|
(setq erc-networks--id (erc-networks--id-fixed-create 'middle)
|
|
middle (current-buffer))
|
|
(sleep-for 0.02)
|
|
|
|
(with-temp-buffer
|
|
(setq erc-networks--id (erc-networks--id-fixed-create 'newest)
|
|
newest (current-buffer))
|
|
|
|
(should (equal (erc-networks--id-sort-buffers
|
|
(list oldest newest middle))
|
|
(list newest middle oldest))))))))
|
|
|
|
(ert-deftest erc-networks-rename-surviving-target-buffer--channel ()
|
|
(should (memq #'erc-networks-rename-surviving-target-buffer
|
|
erc-kill-channel-hook))
|
|
|
|
(let ((chan-foonet-buffer (get-buffer-create "#chan@foonet")))
|
|
|
|
(with-current-buffer chan-foonet-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [barnet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(kill-buffer "#chan@barnet")
|
|
(should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))
|
|
(should (eq chan-foonet-buffer (get-buffer "#chan"))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks-rename-surviving-target-buffer--query ()
|
|
(should (memq #'erc-networks-rename-surviving-target-buffer
|
|
erc-kill-buffer-hook))
|
|
|
|
(let ((bob-foonet (get-buffer-create "bob@foonet")))
|
|
|
|
(with-current-buffer bob-foonet
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "bob")))
|
|
|
|
(with-current-buffer (get-buffer-create "bob@barnet")
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [barnet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "bob")))
|
|
|
|
(kill-buffer "bob@barnet")
|
|
(should (equal (erc-networks-tests--bufnames "bob") '("bob")))
|
|
(should (eq bob-foonet (get-buffer "bob"))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
;; A non-ERC buffer exists named "bob", and we're killing one of two
|
|
;; ERC target buffers named "bob@<netid>". The surviving buffer
|
|
;; retains its suffix.
|
|
|
|
(ert-deftest erc-networks-rename-surviving-target-buffer--query-non-target ()
|
|
(should (memq #'erc-networks-rename-surviving-target-buffer
|
|
erc-kill-buffer-hook))
|
|
|
|
(let ((existing (get-buffer-create "bob"))
|
|
(bob-foonet (get-buffer-create "bob@foonet")))
|
|
|
|
(with-current-buffer bob-foonet
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "bob")))
|
|
|
|
(with-current-buffer (get-buffer-create "bob@barnet")
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [barnet "bob"] :len 1)
|
|
erc--target (erc--target-from-string "bob")))
|
|
|
|
(kill-buffer "bob@barnet")
|
|
(should (buffer-live-p existing))
|
|
(should (buffer-live-p bob-foonet))
|
|
(kill-buffer existing))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks-rename-surviving-target-buffer--multi ()
|
|
|
|
(ert-info ("Multiple leftover channels untouched")
|
|
(with-current-buffer (get-buffer-create "#chan@foonet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")))
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")))
|
|
(with-current-buffer (get-buffer-create "#chan@baznet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")))
|
|
(kill-buffer "#chan@baznet")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@barnet" "#chan@foonet")))
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-info ("Multiple leftover queries untouched")
|
|
(with-current-buffer (get-buffer-create "bob@foonet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "bob")))
|
|
(with-current-buffer (get-buffer-create "bob@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "bob")))
|
|
(with-current-buffer (get-buffer-create "bob@baznet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "bob")))
|
|
(kill-buffer "bob@baznet")
|
|
(should (equal (erc-networks-tests--bufnames "bob")
|
|
'("bob@barnet" "bob@foonet")))
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
;; As of May 2022, this "shrink" stuff runs whenever an ERC buffer is
|
|
;; killed because `erc-networks-shrink-ids-and-buffer-names' is a
|
|
;; default member of all three erc-kill-* functions.
|
|
|
|
;; Note: this overlaps a fair bit with the "hook" variants, i.e.,
|
|
;; `erc-networks--shrink-ids-and-buffer-names--hook-outstanding-*' If
|
|
;; this ever fails, just delete this and fix those. But please copy
|
|
;; over and adapt the comments first.
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-outstanding ()
|
|
;; While some buffer #a@barnet/dummy is being killed, its display ID
|
|
;; is not collapsed because collisions still exist.
|
|
;;
|
|
;; Note that we don't have to set `erc-server-connected' because
|
|
;; this function is intentionally connectivity agnostic.
|
|
(with-current-buffer (get-buffer-create "foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-server-current-nick "tester" ; Always set (`erc-open')
|
|
;; Set when transport connected
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
;; Both set just before IRC (logically) connected (post MOTD)
|
|
erc-network 'foonet
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/tester
|
|
:parts [foonet "tester"]
|
|
:len 2))) ; is/was a plain foonet collision
|
|
|
|
;; Presumably, some server buffer named foonet/dummy was just
|
|
;; killed, hence the length 2 display ID.
|
|
|
|
;; A target buffer for chan #a exists for foonet/tester. The
|
|
;; precise form of its name should not affect shrinking.
|
|
(with-current-buffer (get-buffer-create
|
|
(elt ["#a" "#a@foonet" "#a@foonet/tester"] (random 3)))
|
|
(erc-mode)
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet/tester"))
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/tester"))
|
|
erc--target (erc--target-from-string "#a")))
|
|
|
|
;; Another network context exists (so we have buffers to iterate
|
|
;; over), and it's also part of a collision group.
|
|
(with-current-buffer (get-buffer-create "barnet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/tester
|
|
:parts [barnet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/dummy
|
|
:parts [barnet "dummy"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
;; The buffer being killed is not part of the foonet collision
|
|
;; group, which contains one display ID eligible for shrinkage.
|
|
(with-current-buffer (get-buffer-create
|
|
(elt ["#a@barnet" "#a@barnet/tester"] (random 2)))
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet/tester"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "barnet/tester"))
|
|
erc--target (erc--target-from-string "#a")))
|
|
|
|
(with-temp-buffer ; doesn't matter what the current buffer is
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying)) ; mock
|
|
(erc-networks--shrink-ids-and-buffer-names))
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet" ; shrunk
|
|
"#a@foonet" ; shrunk
|
|
"barnet/tester"
|
|
"barnet/dummy"
|
|
"#a@barnet/tester")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
;; This likewise overlaps with the "hook" variants below. If this
|
|
;; should ever fail, just delete it and optionally fix those.
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-collapse ()
|
|
;; This is similar to the "outstanding" variant above, but both
|
|
;; groups are eligible for renaming, which is abnormal but possible
|
|
;; when recovering from some mishap.
|
|
(with-current-buffer (get-buffer-create "foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/tester
|
|
:parts [foonet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer
|
|
(get-buffer-create (elt ["#a" "#a@foonet/tester"] (random 2)))
|
|
(erc-mode)
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet/tester"))
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/tester"))
|
|
erc--target (erc--target-from-string "#a")))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/tester
|
|
:parts [barnet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer
|
|
(get-buffer-create (elt ["#b" "#b@foonet/tester"] (random 2)))
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet/tester"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "barnet/tester"))
|
|
erc--target (erc--target-from-string "#b")))
|
|
|
|
(with-temp-buffer
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying))
|
|
(erc-networks--shrink-ids-and-buffer-names))
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet" "#a" "barnet" "#b")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(defun erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common ()
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/tester
|
|
:parts [foonet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "#a@foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet/tester"))
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/tester"))
|
|
erc--target (erc--target-from-string "#a")))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/tester
|
|
:parts [barnet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/dummy
|
|
:parts [barnet "dummy"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "#a@barnet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet/tester"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "barnet/tester"))
|
|
erc--target (erc--target-from-string "#a"))))
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-srv ()
|
|
(erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
|
|
(with-current-buffer (get-buffer-create "foonet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/dummy
|
|
:parts [foonet "dummy"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc))
|
|
(kill-buffer))
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet"
|
|
"#a@foonet"
|
|
"barnet/tester"
|
|
"barnet/dummy"
|
|
"#a@barnet/tester")))
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-tgt ()
|
|
(erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
|
|
(with-current-buffer (get-buffer-create "#a@foonet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/dummy
|
|
:parts [foonet "dummy"]
|
|
:len 2)
|
|
erc--target (erc--target-from-string "#a")
|
|
erc-server-process (with-temp-buffer
|
|
(erc-networks-tests--create-dead-proc))))
|
|
|
|
(with-current-buffer "#a@foonet/dummy" (kill-buffer))
|
|
|
|
;; Identical to *-server variant above
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet"
|
|
"#a@foonet"
|
|
"barnet/tester"
|
|
"barnet/dummy"
|
|
"#a@barnet/tester")))
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks-rename-surviving-target-buffer--shrink ()
|
|
(erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
|
|
|
|
;; This buffer isn't "#a@foonet" (yet) because the shrink-ids hook
|
|
;; hasn't run. However, when it's the rename hook runs, its network
|
|
;; id *is* "foonet", not "foonet/tester".
|
|
(with-current-buffer "#a@foonet/tester" (kill-buffer))
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet"
|
|
"barnet/tester"
|
|
"barnet/dummy"
|
|
"#a")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--server ()
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/tester
|
|
:parts [foonet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/dummy
|
|
:parts [foonet "dummy"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-dead-proc))
|
|
(kill-buffer))
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list)) '("foonet")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(defun erc-networks--shrink-ids-and-buffer-names--hook-collapse (check)
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/tester
|
|
:parts [foonet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "#a@foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet/tester"))
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/tester"))
|
|
erc--target (erc--target-from-string "#a")))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'barnet/tester
|
|
:parts [barnet "tester"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "#b@foonet/tester")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet/tester"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "barnet/tester"))
|
|
erc--target (erc--target-from-string "#b")))
|
|
|
|
(funcall check)
|
|
|
|
(should (equal (mapcar #'buffer-name (erc-buffer-list))
|
|
'("foonet" "#a" "barnet" "#b")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-server ()
|
|
(erc-networks--shrink-ids-and-buffer-names--hook-collapse
|
|
(lambda ()
|
|
(with-current-buffer (get-buffer-create "foonet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/dummy
|
|
:parts [foonet "dummy"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc))
|
|
(kill-buffer)))))
|
|
|
|
(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-target ()
|
|
(erc-networks--shrink-ids-and-buffer-names--hook-collapse
|
|
(lambda ()
|
|
(with-current-buffer (get-buffer-create "#a@foonet/dummy")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "dummy"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/dummy
|
|
:parts [foonet "dummy"]
|
|
:len 2)
|
|
erc--target (erc--target-from-string "#a")
|
|
erc-server-process (with-temp-buffer
|
|
(erc-networks-tests--create-dead-proc)))
|
|
(kill-buffer)))))
|
|
|
|
;; FIXME this test is old and may describe impossible states:
|
|
;; leftover identities being qual-equal but not eq (implies
|
|
;; `erc-networks--reclaim-orphaned-target-buffers' is somehow broken).
|
|
;;
|
|
;; Otherwise, the point of this test is to show that server process
|
|
;; identity does not impact the hunt for duplicates.
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates (start)
|
|
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc-server-process (funcall start)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan") ; prior session
|
|
(erc-mode)
|
|
(setq erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet"))
|
|
erc--target (erc--target-from-string "#chan")
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(ert-info ("Conflicts not recognized as ERC buffers and not renamed")
|
|
(get-buffer-create "#chan@foonet")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan" "#chan@foonet"))))
|
|
|
|
;; These are dupes (not "collisions")
|
|
|
|
(with-current-buffer "#chan@foonet" ; same proc
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet"))
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@foonet<dead>")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@foonet<live>")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(let ((created (list (get-buffer "#chan@foonet<live>")
|
|
(get-buffer "#chan@foonet<dead>")
|
|
(get-buffer "#chan@foonet"))))
|
|
|
|
(with-current-buffer "foonet"
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan")))
|
|
|
|
(ert-info ("All buffers considered dupes renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan" "#chan<2>" "#chan<3>" "#chan<4>"))))
|
|
|
|
(ert-info ("All buffers renamed from newest to oldest")
|
|
(should (equal created (list (get-buffer "#chan<2>")
|
|
(get-buffer "#chan<3>")
|
|
(get-buffer "#chan<4>"))))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given (go)
|
|
|
|
;; The connection's network is discovered before target buffers are
|
|
;; created. This shows that the network doesn't matter when only
|
|
;; "given" IDs are present.
|
|
(with-current-buffer (get-buffer-create "oofnet")
|
|
(erc-mode)
|
|
(setq erc-networks--id (erc-networks--id-create 'oofnet)
|
|
erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (funcall go)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan") ; prior session
|
|
(erc-mode)
|
|
(setq erc-networks--id (erc-networks--id-create 'oofnet)
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "oofnet"))
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@oofnet") ;dupe/not collision
|
|
(erc-mode)
|
|
(setq erc-networks--id (erc-networks--id-create 'oofnet)
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "oofnet"))
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(with-current-buffer "oofnet"
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan")))
|
|
|
|
(ert-info ("All buffers matching target and network renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan" "#chan<2>"))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--duplicates ()
|
|
(ert-info ("Process live, no error")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
|
|
#'erc-networks-tests--create-live-proc))
|
|
|
|
(ert-info ("Process live, no error, given ID")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
|
|
#'erc-networks-tests--create-live-proc))
|
|
|
|
(ert-info ("Process dead")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
|
|
#'erc-networks-tests--create-dead-proc))
|
|
|
|
(ert-info ("Process dead, given ID")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
|
|
#'erc-networks-tests--create-dead-proc)))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf (check)
|
|
(let ((foonet-proc (with-temp-buffer
|
|
(erc-networks-tests--create-dead-proc))))
|
|
(with-current-buffer (get-buffer-create "barnet")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
;; Different proc and not "qual-equal" (different elts)
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc--target (erc--target-from-string "#chan")
|
|
erc-server-process foonet-proc))
|
|
(funcall check)
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf ()
|
|
(ert-info ("Existing #chan buffer respected")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
|
|
(lambda ()
|
|
(with-current-buffer "barnet"
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan@barnet")))
|
|
(ert-info ("Existing #chan buffer found and renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@foonet")))))))
|
|
|
|
(ert-info ("Existing #chan buffer")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
|
|
(lambda ()
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc-server-process (erc-networks-tests--create-dead-proc))
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan")))
|
|
(ert-info ("Nothing renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))))))
|
|
|
|
(ert-info ("Existing #chan@foonet and #chan@barnet buffers")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
|
|
(lambda ()
|
|
(with-current-buffer "#chan"
|
|
(rename-buffer "#chan@foonet"))
|
|
(should-not (get-buffer "#chan@barnet"))
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet"))
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan@foonet")))
|
|
(ert-info ("Nothing renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@barnet" "#chan@foonet"))))))))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
|
|
(check)
|
|
(let ((oofnet-proc (with-temp-buffer
|
|
(erc-networks-tests--create-dead-proc))))
|
|
|
|
(with-current-buffer (get-buffer-create "rabnet")
|
|
(erc-mode)
|
|
;; Again, given name preempts network lookup (unrealistic but
|
|
;; highlights priorities)
|
|
(setq erc-networks--id (erc-networks--id-create 'rabnet)
|
|
erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
;; Identity is not "qual-equal" to above
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-networks--id (erc-networks--id-create 'oofnet)
|
|
erc-network 'foonet
|
|
erc--target (erc--target-from-string "#chan")
|
|
erc-server-process oofnet-proc))
|
|
(funcall check)
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf-given ()
|
|
|
|
(ert-info ("Existing #chan buffer respected")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
|
|
(lambda ()
|
|
(with-current-buffer "rabnet"
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan@rabnet")))
|
|
|
|
(ert-info ("Existing #chan buffer found and renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@oofnet")))))))
|
|
|
|
(ert-info ("Existing #chan@oofnet and #chan@rabnet buffers")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
|
|
(lambda ()
|
|
;; #chan has already been uniquified (but not grown)
|
|
(with-current-buffer "#chan" (rename-buffer "#chan@oofnet"))
|
|
(should-not (get-buffer "#chan@rabnet"))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@rabnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "rabnet"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "rabnet"))))
|
|
|
|
(with-current-buffer (get-buffer-create "oofnet")
|
|
(erc-mode)
|
|
(setq erc-network 'oofnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create 'oofnet)) ; given
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan@oofnet")))
|
|
|
|
(ert-info ("Nothing renamed")
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@oofnet" "#chan@rabnet"))))))))
|
|
|
|
;; This shows a corner case where a user explicitly assigns a "given"
|
|
;; ID via `erc-tls' but later connects again without one. It would
|
|
;; actually probably be better if the given identity were to win and
|
|
;; the derived one got an <n>-suffix.
|
|
;;
|
|
;; If we just compared net identities, the two would match, but they
|
|
;; don't here because one has a given name and the other a
|
|
;; discovered/assembled one; so they are *not* qual-equal.
|
|
(ert-deftest erc-networks--reconcile-buffer-names--no-srv-buf-given-mismatch ()
|
|
;; Existing #chan buffer *not* respected
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
|
|
(lambda ()
|
|
(with-current-buffer (get-buffer-create "oofnet")
|
|
(erc-mode)
|
|
(setq erc-network 'oofnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc-networks--id (erc-networks--id-create nil)) ; derived
|
|
(should (string= (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)
|
|
"#chan@oofnet")))
|
|
|
|
(ert-info ("Collision renamed but not grown (because it's a given)")
|
|
;; Original chan uniquified and moved out of the way
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@oofnet<2>")))))))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net (check)
|
|
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc-networks--id (erc-networks--id-create nil))) ; derived
|
|
|
|
(with-current-buffer (get-buffer-create "barnet")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc-networks--id (erc-networks--id-create nil))) ; derived
|
|
|
|
(with-current-buffer
|
|
(get-buffer-create (elt ["#chan" "#chan@foonet"] (random 2)))
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "foonet"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "barnet"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(funcall check)
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--multi-net ()
|
|
(ert-info ("Same network rename")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
|
|
(lambda ()
|
|
(with-current-buffer "foonet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@foonet"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@barnet" "#chan@foonet"))))))
|
|
|
|
(ert-info ("Same network keep name")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
|
|
(lambda ()
|
|
(with-current-buffer "barnet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@barnet"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@barnet" "#chan@foonet")))))))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
|
|
(check)
|
|
|
|
(with-current-buffer (get-buffer-create "oofnet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create 'oofnet) ; one given
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "rabnet")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create 'rabnet) ; another given
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create (elt ["chan" "#chan@oofnet"]
|
|
(random 2)))
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "oofnet"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "rabnet"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(funcall check)
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--multi-net-given ()
|
|
(ert-info ("Same network rename")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
|
|
(lambda ()
|
|
(with-current-buffer "oofnet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@oofnet"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@oofnet" "#chan@rabnet"))))))
|
|
|
|
(ert-info ("Same network keep name")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
|
|
(lambda ()
|
|
(with-current-buffer "rabnet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@rabnet"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@oofnet" "#chan@rabnet")))))))
|
|
|
|
(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
|
|
(check)
|
|
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create nil) ; one derived
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "my-conn")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick "tester"
|
|
erc-networks--id (erc-networks--id-create 'my-conn) ; one given
|
|
erc-server-process (erc-networks-tests--create-dead-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create (elt ["#chan" "#chan@foonet"]
|
|
(random 2)))
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "foonet"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@my-conn")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan"))
|
|
(cl-multiple-value-setq (erc-server-process erc-networks--id)
|
|
(with-current-buffer "my-conn"
|
|
(list erc-server-process erc-networks--id))))
|
|
|
|
(funcall check)
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--multi-net-existing ()
|
|
|
|
(ert-info ("Buf name derived from network")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
|
|
(lambda ()
|
|
(with-current-buffer "foonet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@foonet"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@foonet" "#chan@my-conn"))))))
|
|
|
|
(ert-info ("Buf name given")
|
|
(erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
|
|
(lambda ()
|
|
(with-current-buffer "my-conn"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@my-conn"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@foonet" "#chan@my-conn")))))))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--multi-net-suffixed ()
|
|
;; Two networks, same channel. One network has two connections.
|
|
;; When the same channel is joined on the latter under a different
|
|
;; nick, all buffer names involving that network are suffixed with
|
|
;; the network identity.
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/bob")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "bob"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/bob
|
|
:parts [foonet "bob"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create
|
|
(elt ["#chan@foonet" "#chan@foonet/bob"] (random 2)))
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "foonet/bob"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/bob"))))
|
|
|
|
(with-current-buffer (get-buffer-create "barnet")
|
|
(erc-mode)
|
|
(setq erc-network 'barnet
|
|
erc-server-current-nick (elt ["alice" "bob"] (random 2))
|
|
erc-networks--id (erc-networks--id-create 'barnet)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@barnet")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-server-process (buffer-local-value 'erc-server-process
|
|
(get-buffer "barnet"))
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "barnet"))))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/alice")
|
|
(erc-mode)
|
|
(setq erc-network 'foonet
|
|
erc-server-current-nick "alice"
|
|
erc-networks--id (make-erc-networks--id-qualifying
|
|
:symbol 'foonet/alice
|
|
:parts [foonet "alice"]
|
|
:len 2)
|
|
erc-server-process (erc-networks-tests--create-live-proc)))
|
|
|
|
(with-current-buffer "foonet/alice"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "#chan") erc-networks--id)))
|
|
(should (string= result "#chan@foonet/alice"))))
|
|
|
|
(should (equal (erc-networks-tests--bufnames "#chan")
|
|
'("#chan@barnet" "#chan@foonet/bob")))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--reconcile-buffer-names--local ()
|
|
(with-current-buffer (get-buffer-create "DALnet")
|
|
(erc-mode)
|
|
(setq erc-network 'DALnet
|
|
erc-server-announced-name "elysium.ga.us.dal.net"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc--isupport-params (make-hash-table)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(puthash 'CHANTYPES '("&#") erc--isupport-params))
|
|
|
|
(ert-info ("Local chan buffer from older, disconnected identity")
|
|
(with-current-buffer (get-buffer-create "&chan")
|
|
(erc-mode)
|
|
;; Cheat here because localp is determined on identity init
|
|
(setq erc--target (with-current-buffer "DALnet"
|
|
(erc--target-from-string "&chan"))
|
|
erc-network 'DALnet
|
|
erc-server-announced-name "twisted.ma.us.dal.net"
|
|
erc-server-process (erc-networks-tests--create-dead-proc)
|
|
erc-networks--id (erc-networks--id-create nil))))
|
|
|
|
(ert-info ("Local channels renamed using network server names")
|
|
(with-current-buffer "DALnet"
|
|
(let ((result (erc-networks--reconcile-buffer-names
|
|
(erc--target-from-string "&chan") erc-networks--id)))
|
|
(should (string= result "&chan@elysium.ga.us.dal.net")))))
|
|
|
|
(should (get-buffer "&chan@twisted.ma.us.dal.net"))
|
|
(should-not (get-buffer "&chan"))
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--set-name ()
|
|
(with-current-buffer (get-buffer-create "localhost:6667")
|
|
(let (erc-server-announced-name
|
|
(erc--isupport-params (make-hash-table))
|
|
erc-network
|
|
erc-quit-hook
|
|
(erc-server-process (erc-networks-tests--create-live-proc))
|
|
calls)
|
|
(erc-mode)
|
|
|
|
(cl-letf (((symbol-function 'erc--route-insertion)
|
|
(lambda (&rest r) (ignore (push r calls)))))
|
|
|
|
(ert-info ("Signals when `erc-server-announced-name' unset")
|
|
(should-error (erc-networks--set-name nil (make-erc-response)))
|
|
(should-not calls))
|
|
|
|
(ert-info ("Signals when table empty and NETWORK param unset")
|
|
(setq erc-server-announced-name "irc.fake.gnu.org")
|
|
(should (eq 'error (erc-networks--set-name nil (make-erc-response))))
|
|
(should (string-match-p (rx "*** Failed") (car (pop calls)))))))
|
|
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
(ert-deftest erc-networks--ensure-announced ()
|
|
(with-current-buffer (get-buffer-create "localhost:6667")
|
|
(should (local-variable-if-set-p 'erc-server-announced-name))
|
|
(let (erc-insert-modify-hook
|
|
(erc-server-process (erc-networks-tests--create-live-proc))
|
|
(parsed (make-erc-response
|
|
:unparsed ":irc.barnet.org 422 tester :MOTD File is missing"
|
|
:sender "irc.barnet.org"
|
|
:command "422"
|
|
:command-args '("tester" "MOTD File is missing")
|
|
:contents "MOTD File is missing")))
|
|
|
|
(erc-mode) ; boilerplate displayable start (needs `erc-server-process')
|
|
(erc--initialize-markers (point) nil)
|
|
|
|
(erc-networks--ensure-announced erc-server-process parsed)
|
|
(goto-char (point-min))
|
|
(search-forward "Failed")
|
|
(should (string= erc-server-announced-name "irc.barnet.org")))
|
|
(when noninteractive (kill-buffer))))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--no-existing--orphan ()
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc--target (erc--target-from-string "#chan")
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(with-current-buffer (get-buffer-create "irc.foonet.org")
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "FooNet")))
|
|
|
|
(ert-info ("Channel buffer reassociated")
|
|
(erc-server-process-alive "#chan")
|
|
(with-current-buffer "#chan"
|
|
(should erc-server-connected)
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "FooNet")))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--existing--reuse ()
|
|
(let* ((old-buf (get-buffer-create "FooNet"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf)))
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(insert "*** Old buf")
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(ert-info ("New buffer steals name, content")
|
|
(with-current-buffer (get-buffer-create "irc.foonet.org")
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "FooNet"))
|
|
(goto-char (point-min))
|
|
(should (search-forward "Old buf"))))
|
|
|
|
(ert-info ("Channel buffer reassociated")
|
|
(erc-server-process-alive "#chan")
|
|
(with-current-buffer "#chan"
|
|
(should erc-server-connected)
|
|
(should-not (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "FooNet")))))
|
|
|
|
(ert-info ("Original buffer killed off")
|
|
(should-not (buffer-live-p old-buf))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
;; This is for compatibility with pre-28.1 behavior. Basically, we're
|
|
;; trying to match the behavior bug for bug. All buffers were always
|
|
;; suffixed and never reassociated. 28.1 introduced a regression that
|
|
;; reversed the latter, but we've reverted that.
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--existing--noreuse ()
|
|
(with-suppressed-warnings ((obsolete erc-reuse-buffers))
|
|
(should erc-reuse-buffers) ; default
|
|
(let* ((old-buf (get-buffer-create "irc.foonet.org:6697/irc.foonet.org"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf))
|
|
erc-reuse-buffers)
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(insert "*** Old buf")
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc-networks--id (buffer-local-value 'erc-networks--id old-buf)
|
|
erc--target (erc--target-from-string "#chan"))
|
|
(rename-buffer (erc-networks--construct-target-buffer-name erc--target)))
|
|
|
|
(ert-info ("Server buffer uniquely renamed")
|
|
(with-current-buffer
|
|
(get-buffer-create "irc.foonet.org:6697/irc.foonet.org<2>")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name)
|
|
"irc.foonet.org:6697/irc.foonet.org<2>"))
|
|
(goto-char (point-min))
|
|
(should-not (search-forward "Old buf" nil t))))
|
|
|
|
(ert-info ("Channel buffer not reassociated")
|
|
(should-not
|
|
(erc-server-process-alive
|
|
(should (get-buffer "#chan/irc.foonet.org"))))
|
|
(with-current-buffer "#chan/irc.foonet.org"
|
|
(should-not erc-server-connected)
|
|
(should (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name)
|
|
"irc.foonet.org:6697/irc.foonet.org")))))
|
|
|
|
(ert-info ("Old buffer still around")
|
|
(should (buffer-live-p old-buf)))))
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--reconnecting ()
|
|
(let* ((old-buf (get-buffer-create "FooNet"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf)))
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(insert "*** Old buf")
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc--target (erc--target-from-string "#chan")
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(ert-info ("No new buffer")
|
|
(with-current-buffer old-buf
|
|
(setq erc-server-process (erc-networks-tests--create-live-proc))
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "FooNet"))
|
|
(goto-char (point-min))
|
|
(should (search-forward "Old buf"))))
|
|
|
|
(ert-info ("Channel buffer updated with live proc")
|
|
(erc-server-process-alive "#chan")
|
|
(with-current-buffer "#chan"
|
|
(should erc-server-connected)
|
|
(should-not (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "FooNet"))))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--id ()
|
|
(let* ((old-buf (get-buffer-create "MySession"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf)))
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(insert "*** Old buf")
|
|
(setq erc-network 'FooNet
|
|
erc-networks--id (erc-networks--id-create 'MySession)
|
|
erc-server-process old-proc))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-networks--id (erc-networks--id-create 'MySession)
|
|
erc-server-process old-proc
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(ert-info ("No new buffer")
|
|
(with-current-buffer old-buf
|
|
(setq erc-server-process (erc-networks-tests--create-live-proc))
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "MySession"))
|
|
(goto-char (point-min))
|
|
(should (search-forward "Old buf"))))
|
|
|
|
(ert-info ("Channel buffer updated with live proc")
|
|
(erc-server-process-alive "#chan")
|
|
(with-current-buffer "#chan"
|
|
(should erc-server-connected)
|
|
(should-not (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "MySession"))))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--existing--live ()
|
|
(let* (erc-kill-server-hook
|
|
erc-insert-modify-hook
|
|
(old-buf (get-buffer-create "FooNet"))
|
|
;;
|
|
old-proc) ; live
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(setq old-proc (erc-networks-tests--create-live-proc))
|
|
(erc--initialize-markers (point) nil)
|
|
(insert "*** Old buf")
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(should (erc-server-process-alive)))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc-networks--id (erc-networks--id-create nil)
|
|
erc-server-connected t
|
|
erc--target (erc--target-from-string "#chan")))
|
|
|
|
(ert-info ("New buffer rejected, abandoned, not killed")
|
|
(with-current-buffer (get-buffer-create "irc.foonet.org")
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(set-process-sentinel erc-server-process #'ignore)
|
|
(erc-display-message nil 'notice (current-buffer) "notice")
|
|
(with-silent-modifications
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process)))
|
|
(should (eq erc-active-buffer old-buf))
|
|
(should-not (erc-server-process-alive))
|
|
(should (string= (buffer-name) "irc.foonet.org"))
|
|
(goto-char (point-min))
|
|
(search-forward "still connected")))
|
|
|
|
(ert-info ("Channel buffer updated with live proc")
|
|
(should (erc-server-process-alive "#chan"))
|
|
(with-current-buffer "#chan"
|
|
(should erc-server-connected)
|
|
(should (erc-server-buffer-live-p))
|
|
(should (eq erc-server-process old-proc))
|
|
(should (buffer-live-p (process-buffer erc-server-process)))
|
|
(with-current-buffer (process-buffer erc-server-process)
|
|
(should (eq (current-buffer) (get-buffer "FooNet")))
|
|
(should (eq (current-buffer) old-buf))))))
|
|
|
|
(should (get-buffer "FooNet"))
|
|
(should (get-buffer "irc.foonet.org"))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--local-match ()
|
|
(let* ((old-buf (get-buffer-create "FooNet"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf)))
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(insert "*** Old buf")
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-announced-name "us-east.foonet.org"
|
|
erc-server-process old-proc
|
|
erc--isupport-params (make-hash-table)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(puthash 'CHANTYPES '("&#") erc--isupport-params))
|
|
|
|
(with-current-buffer (get-buffer-create "&chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc-server-announced-name "us-east.foonet.org"
|
|
erc--target (erc--target-from-string "&chan")
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(ert-info ("New server buffer steals name, content")
|
|
(with-current-buffer (get-buffer-create "irc.foonet.org")
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-announced-name "us-east.foonet.org"
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc--isupport-params (make-hash-table)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(puthash 'CHANTYPES '("&#") erc--isupport-params)
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "FooNet"))
|
|
(goto-char (point-min))
|
|
(should (search-forward "Old buf"))))
|
|
|
|
(ert-info ("Channel buffer reassociated when &local server matches")
|
|
(should (erc-server-process-alive "&chan"))
|
|
(with-current-buffer "&chan"
|
|
(should erc-server-connected)
|
|
(should-not (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "FooNet")))))
|
|
|
|
(ert-info ("Original buffer killed off")
|
|
(should-not (buffer-live-p old-buf)))
|
|
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
(ert-deftest erc-networks--rename-server-buffer--local-nomatch ()
|
|
(let* ((old-buf (get-buffer-create "FooNet"))
|
|
(old-proc (erc-networks-tests--create-dead-proc old-buf)))
|
|
|
|
(with-current-buffer old-buf
|
|
(erc-mode)
|
|
(insert "*** Old buf")
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-announced-name "us-west.foonet.org"
|
|
erc-server-process old-proc
|
|
erc--isupport-params (make-hash-table)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
(puthash 'CHANTYPES '("&#") erc--isupport-params))
|
|
|
|
(with-current-buffer (get-buffer-create "&chan")
|
|
(erc-mode)
|
|
(setq erc-network 'FooNet
|
|
erc-server-process old-proc
|
|
erc-server-announced-name "us-west.foonet.org" ; west
|
|
erc--target (erc--target-from-string "&chan")
|
|
erc-networks--id (erc-networks--id-create nil)))
|
|
|
|
(ert-info ("New server buffer steals name, content")
|
|
(with-current-buffer (get-buffer-create "irc.foonet.org")
|
|
(erc-mode)
|
|
(erc--initialize-markers (point) nil)
|
|
(setq erc-network 'FooNet
|
|
erc-server-current-nick "tester"
|
|
erc-server-announced-name "us-east.foonet.org" ; east
|
|
erc-server-process (erc-networks-tests--create-live-proc)
|
|
erc--isupport-params (make-hash-table)
|
|
erc-networks--id (erc-networks--id-create nil))
|
|
|
|
(puthash 'CHANTYPES '("&#") erc--isupport-params)
|
|
(should-not (erc-networks--rename-server-buffer erc-server-process))
|
|
(should (string= (buffer-name) "FooNet"))
|
|
(goto-char (point-min))
|
|
(should (search-forward "Old buf"))))
|
|
|
|
(ert-info ("Channel buffer now orphaned even though network matches")
|
|
(should-not (erc-server-process-alive "&chan"))
|
|
(with-current-buffer "&chan"
|
|
(should-not erc-server-connected)
|
|
(should (eq erc-server-process old-proc))
|
|
(erc-with-server-buffer
|
|
(should (string= (buffer-name) "FooNet")))))
|
|
|
|
(ert-info ("Original buffer killed off")
|
|
(should-not (buffer-live-p old-buf)))
|
|
|
|
(erc-networks-tests--clean-bufs)))
|
|
|
|
(ert-deftest erc-networks--update-server-identity--double-existing ()
|
|
(with-temp-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1))
|
|
|
|
(with-current-buffer (get-buffer-create "#chan@foonet/bob")
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 2)))
|
|
(with-current-buffer (get-buffer-create "foonet/alice")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
|
|
|
|
(ert-info ("Adopt equivalent identity")
|
|
(should (eq (erc-networks--update-server-identity)
|
|
(buffer-local-value 'erc-networks--id
|
|
(get-buffer "#chan@foonet/bob")))))
|
|
|
|
(ert-info ("Ignore non-matches")
|
|
(should-not (erc-networks--update-server-identity))
|
|
(should (eq erc-networks--id
|
|
(buffer-local-value 'erc-networks--id
|
|
(get-buffer "#chan@foonet/bob"))))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--update-server-identity--double-new ()
|
|
(with-temp-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/alice")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
|
|
(with-current-buffer (get-buffer-create "#chan@foonet/alice")
|
|
(erc-mode)
|
|
(setq erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/alice"))))
|
|
|
|
(ert-info ("Evolve identity to prevent ambiguity")
|
|
(should-not (erc-networks--update-server-identity))
|
|
(should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
|
|
(should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--update-server-identity--double-bounded ()
|
|
(with-temp-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "bob"] :len 1))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/alice/home")
|
|
(erc-mode)
|
|
(setq erc-networks--id (make-erc-networks--id-qualifying
|
|
:parts [foonet "alice" home] :len 3)))
|
|
(with-current-buffer (get-buffer-create "#chan@foonet/alice/home")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/alice/home"))))
|
|
|
|
(ert-info ("Evolve identity to prevent ambiguity")
|
|
(should-not (erc-networks--update-server-identity))
|
|
(should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
|
|
(should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--update-server-identity--double-even ()
|
|
(with-temp-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "bob"] :len 1))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "alice"] :len 1)))
|
|
(with-current-buffer (get-buffer-create "#chan")
|
|
(erc-mode)
|
|
(setq erc--target (erc--target-from-string "#chan")
|
|
erc-networks--id (buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet"))))
|
|
|
|
(ert-info ("Evolve identity to prevent ambiguity")
|
|
(should-not (erc-networks--update-server-identity))
|
|
(should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
|
|
(should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob)))
|
|
|
|
(ert-info ("Collision renamed")
|
|
(with-current-buffer "foonet/alice"
|
|
(should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/alice)))
|
|
|
|
(with-current-buffer "#chan@foonet/alice"
|
|
(should (eq (erc-networks--id-symbol erc-networks--id)
|
|
'foonet/alice)))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--update-server-identity--triple-new ()
|
|
(with-temp-buffer
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "bob" home] :len 1))
|
|
|
|
(with-current-buffer (get-buffer-create "foonet/bob/office")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(make-erc-networks--id-qualifying :parts [foonet "bob" office]
|
|
:len 3)))
|
|
(with-current-buffer (get-buffer-create "#chan@foonet/bob/office")
|
|
(erc-mode)
|
|
(setq erc-networks--id
|
|
(buffer-local-value 'erc-networks--id
|
|
(get-buffer "foonet/bob/office"))))
|
|
|
|
(ert-info ("Extend our identity's canonical ID so that it's unique")
|
|
(should-not (erc-networks--update-server-identity))
|
|
(should (= (erc-networks--id-qualifying-len erc-networks--id) 3))))
|
|
|
|
(erc-networks-tests--clean-bufs))
|
|
|
|
(ert-deftest erc-networks--determine ()
|
|
(should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat))
|
|
(should (eq (erc-networks--determine "irc.oftc.net") 'OFTC))
|
|
(should (eq (erc-networks--determine "irc.dal.net") 'DALnet))
|
|
|
|
(let ((erc-server-announced-name "zirconium.libera.chat"))
|
|
(should (eq (erc-networks--determine) 'Libera.Chat)))
|
|
(let ((erc-server-announced-name "weber.oftc.net"))
|
|
(should (eq (erc-networks--determine) 'OFTC)))
|
|
(let ((erc-server-announced-name "redemption.ix.us.dal.net"))
|
|
(should (eq (erc-networks--determine) 'DALnet)))
|
|
|
|
;; Failure
|
|
(let ((erc-server-announced-name "irc-us2.alphachat.net"))
|
|
(should (eq (erc-networks--determine)
|
|
erc-networks--name-missing-sentinel))))
|
|
|
|
(ert-deftest erc-ports-list ()
|
|
(with-suppressed-warnings ((obsolete erc-server-alist))
|
|
(let* ((srv (assoc "Libera.Chat: Random server" erc-server-alist)))
|
|
(should (equal (erc-ports-list (nth 3 srv))
|
|
'(6665 6666 6667 8000 8001 8002)))
|
|
(should (equal (erc-ports-list (nth 4 srv))
|
|
'(6697 7000 7070))))
|
|
|
|
(let* ((srv (assoc "Libera.Chat: Random Europe server" erc-server-alist)))
|
|
(should (equal (erc-ports-list (nth 3 srv)) '(6667)))
|
|
(should (equal (erc-ports-list (nth 4 srv)) '(6697))))
|
|
|
|
(let* ((srv (assoc "OFTC: Random server" erc-server-alist)))
|
|
(should (equal (erc-ports-list (nth 3 srv))
|
|
'(6667 6668 6669 6670 7000)))
|
|
(should (equal (erc-ports-list (nth 4 srv))
|
|
'(6697 9999))))))
|
|
|
|
(ert-deftest erc-networks--examine-targets ()
|
|
(with-current-buffer (erc-tests-common-make-server-buf "foonet")
|
|
(erc--open-target "#chan")
|
|
(erc--open-target "#spam"))
|
|
|
|
(with-current-buffer (erc-tests-common-make-server-buf "barnet")
|
|
(with-current-buffer (erc--open-target "*query")
|
|
(setq erc-networks--id nil))
|
|
(with-current-buffer (erc--open-target "#chan")
|
|
(let ((calls ())
|
|
(snap (lambda (parameter)
|
|
(list parameter
|
|
(erc-target)
|
|
(erc-networks--id-symbol erc-networks--id)))))
|
|
|
|
;; Search for "#chan" dupes among targets of all servers.
|
|
(should (equal
|
|
(erc-networks--examine-targets erc-networks--id erc--target
|
|
(lambda () (push (funcall snap 'ON-DUPE) calls))
|
|
(lambda () (push (funcall snap 'ON-COLL) calls)))
|
|
(list (get-buffer "#chan@foonet")
|
|
(get-buffer "#chan@barnet"))))
|
|
|
|
(should (equal (pop calls) '(ON-DUPE "#chan" barnet)))
|
|
(should (equal (pop calls) '(ON-COLL "#chan" foonet)))
|
|
(should-not calls)
|
|
(should-not (get-buffer "#chan"))
|
|
(should (get-buffer "#chan@barnet"))
|
|
(should (get-buffer "#chan@foonet"))
|
|
|
|
;; Search for "*query" dupes among targets of all servers.
|
|
(should (equal (erc-networks--examine-targets erc-networks--id
|
|
(buffer-local-value 'erc--target
|
|
(get-buffer "*query"))
|
|
(lambda () (push (funcall snap 'ON-DUPE) calls))
|
|
(lambda () (push (funcall snap 'ON-COLL) calls)))
|
|
(list (get-buffer "*query"))))
|
|
|
|
(should (equal (pop calls) '(ON-DUPE "*query" barnet)))
|
|
(should-not calls)))
|
|
|
|
(goto-char (point-min))
|
|
(should (search-forward "Missing network session" nil t)))
|
|
|
|
(erc-tests-common-kill-buffers))
|
|
|
|
;;; erc-networks-tests.el ends here
|