;;; erc-d-self.el --- tests for erc-d -*- lexical-binding: t -*-

;; This file is part of GNU Emacs.
;;
;; This program 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.
;;
;; This program 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 this program.  If not, see
;; <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; This file tests the dumb server itself.  The file name does not end
;; in "-tests.el" because test/Makefile looks for corresponding
;; library files and raises an error when one isn't found.

;;; Code:
(require 'ert-x)
(eval-and-compile (let ((dir (getenv "EMACS_TEST_DIRECTORY")))
                    (when dir
                      (load (concat dir "/lisp/erc/erc-d/erc-d") nil t)
                      (load (concat dir "/lisp/erc/erc-d/erc-d-t") nil t))))

(require 'erc-d)
(require 'erc-d-t)
(require 'erc-backend)

(ert-deftest erc-d-u--canned-load-dialog--basic ()
  (should-not (get-buffer "basic.lispdata"))
  (should-not erc-d-u--canned-buffers)
  (let ((exes (erc-d-u--canned-load-dialog 'basic t)))
    (should (get-buffer "basic.lispdata"))
    (should (memq (get-buffer (get-buffer "basic.lispdata"))
                  erc-d-u--canned-buffers))
    (should (equal (cl-loop for spec iter-by (iter-next exes) collect spec)
                   '((pass 10.0 "PASS " (? ?:) "changeme"))))
    (should (equal (cl-loop for spec iter-by (iter-next exes) collect spec)
                   '((nick 0.2 "NICK tester"))))
    (should (equal (car (cl-loop for s iter-by (iter-next exes) collect s))
                   '(user 0.2 "USER user 0 * :tester")))
    (should (equal (car (cl-loop for s iter-by (iter-next exes) collect s))
                   '(mode-user 1.2 "MODE tester +i")))
    (should (equal (cl-loop for s iter-by (iter-next exes) collect s)
                   '((mode-chan 1.2 "MODE #chan")
                     (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
    ;; See `define-error' site for `iter-end-of-sequence'
    ;; Guess this self-parenting prevents detection by `should-error'
    (ert-info ("End of buffer detected")
      (let (done)
        (condition-case err
            (iter-next exes)
          (iter-end-of-sequence
           (setq done (cdr err))))
        (should-not done))))
  (should-not (get-buffer "basic.lispdata"))
  (should-not erc-d-u--canned-buffers))

;; Fuzzies need to be able to access any non-exhausted genny.
(ert-deftest erc-d-u--canned-load-dialog--intermingled ()
  (should-not (get-buffer "basic.lispdata"))
  (should-not erc-d-u--canned-buffers)
  (let* ((exes (erc-d-u--canned-load-dialog 'basic t))
         (pass (iter-next exes))
         (nick (iter-next exes))
         (user (iter-next exes))
         (modu (iter-next exes))
         (modc (iter-next exes)))

    (should (equal (iter-next user) '(user 0.2 "USER user 0 * :tester")))
    (should (equal (iter-next modu) '(mode-user 1.2 "MODE tester +i")))
    (should (equal (iter-next modc) '(mode-chan 1.2 "MODE #chan")))

    (cl-loop repeat 8 do (iter-next user)) ; skip a few
    (should (equal (iter-next user)
                   '(0 ":irc.example.org 254 tester 1 :channels formed")))
    (should (equal (iter-next modu)
                   '(0 ":irc.example.org 221 tester +Zi")))
    (should (equal (cl-loop for spec iter-by modc collect spec) ; done
                   '((0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))

    (cl-loop repeat 3 do (iter-next user))
    (cl-loop repeat 3 do (iter-next modu))

    (ert-info ("Change up the order")
      (should
       (equal (iter-next modu)
              '(0 ":irc.example.org 366 alice #chan :End of NAMES list")))
      (should
       (equal (iter-next user)
              '(0 ":irc.example.org 422 tester :MOTD File is missing"))))

    ;; Exhaust these
    (should (equal (cl-loop for spec iter-by pass collect spec) ; done
                   '((pass 10.0 "PASS " (? ?:) "changeme"))))
    (should (equal (cl-loop for spec iter-by nick collect spec) ; done
                   '((nick 0.2 "NICK tester"))))

    (ert-info ("End of file but no teardown because hunks outstanding")
      (condition-case err
          (iter-next exes)
        (iter-end-of-sequence (should-not (cdr err))))
      (should (get-buffer "basic.lispdata")))

    ;; Finish
    (should
     (eq t (condition-case _ (iter-next user) (iter-end-of-sequence t))))
    (should
     (eq t (condition-case _ (iter-next modu) (iter-end-of-sequence t)))))

  (should-not (get-buffer "basic.lispdata"))
  (should-not erc-d-u--canned-buffers))

;; This indirectly tests `erc-d-u--canned-read' cleanup/teardown

(ert-deftest erc-d-u--rewrite-for-slow-mo ()
  (should-not (get-buffer "basic.lispdata"))
  (should-not (get-buffer "basic.lispdata<2>"))
  (should-not (get-buffer "basic.lispdata<3>"))
  (should-not erc-d-u--canned-buffers)
  (let ((exes (erc-d-u--canned-load-dialog 'basic)) ; genny in
        (exes-lower (erc-d-u--canned-load-dialog 'basic t)) ; iter in
        (exes-custom (erc-d-u--canned-load-dialog 'basic t)))
    (should (get-buffer "basic.lispdata"))
    (should (get-buffer "basic.lispdata<2>"))
    (should (get-buffer "basic.lispdata<3>"))
    (should (equal (list (get-buffer "basic.lispdata<3>")
                         (get-buffer "basic.lispdata<2>")
                         (get-buffer "basic.lispdata"))
                   erc-d-u--canned-buffers))

    (ert-info ("Rewrite for slowmo basic")
      (setq exes (funcall (erc-d-u--rewrite-for-slow-mo 10 exes))) ; genny out
      (should (equal (cl-loop for s iter-by (iter-next exes) collect s)
                     '((pass 20.0 "PASS " (? ?:)
                             "changeme"))))
      (should (equal (cl-loop for s iter-by (iter-next exes) collect s)
                     '((nick 10.2 "NICK tester"))))
      (should (equal (car (cl-loop for s iter-by (iter-next exes) collect s))
                     '(user 10.2 "USER user 0 * :tester")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes) collect s))
                     '(mode-user 11.2 "MODE tester +i")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes) collect s))
                     '(mode-chan 11.2 "MODE #chan")))
      (ert-info ("End of buffer detected")
        (let (done)
          (condition-case err
              (iter-next exes)
            (iter-end-of-sequence
             (setq done (cdr err))))
          (should-not done))))

    (ert-info ("Rewrite for slowmo bounded")
      (setq exes-lower (erc-d-u--rewrite-for-slow-mo -5 exes-lower)) ; iter out
      (should (equal (cl-loop for s iter-by (iter-next exes-lower) collect s)
                     '((pass 10.0 "PASS " (? ?:) "changeme"))))
      (should (equal (cl-loop for s iter-by (iter-next exes-lower) collect s)
                     '((nick 5 "NICK tester"))))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-lower)
                                   collect s))
                     '(user 5 "USER user 0 * :tester")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-lower)
                                   collect s))
                     '(mode-user 5 "MODE tester +i")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-lower)
                                   collect s))
                     '(mode-chan 5 "MODE #chan")))
      (should-not (ignore-error iter-end-of-sequence (iter-next exes-lower))))

    (ert-info ("Rewrite for slowmo custom")
      (setq exes-custom (erc-d-u--rewrite-for-slow-mo
                         (lambda (n) (* 2 n)) exes-custom))
      (should (equal (cl-loop for s iter-by (iter-next exes-custom) collect s)
                     '((pass 20.0 "PASS " (? ?:) "changeme"))))
      (should (equal (cl-loop for s iter-by (iter-next exes-custom) collect s)
                     '((nick 0.4 "NICK tester"))))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-custom)
                                   collect s))
                     '(user 0.4 "USER user 0 * :tester")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-custom)
                                   collect s))
                     '(mode-user 2.4 "MODE tester +i")))
      (should (equal (car (cl-loop for s iter-by (iter-next exes-custom)
                                   collect s))
                     '(mode-chan 2.4 "MODE #chan")))
      (should-not (ignore-error iter-end-of-sequence
                    (iter-next exes-custom)))))

  (should-not (get-buffer "basic.lispdata"))
  (should-not (get-buffer "basic.lispdata<2>"))
  (should-not (get-buffer "basic.lispdata<3>"))
  (should-not erc-d-u--canned-buffers))

(ert-deftest erc-d--active-ex-p ()
  (let ((ring (make-ring 5)))
    (ert-info ("Empty ring returns nil for not active")
      (should-not (erc-d--active-ex-p ring)))
    (ert-info ("One fuzzy member returns nil for not active")
      (ring-insert ring (make-erc-d-exchange :tag '~foo))
      (should-not (erc-d--active-ex-p ring)))
    (ert-info ("One active member returns t for active")
      (ring-insert-at-beginning ring (make-erc-d-exchange :tag 'bar))
      (should (erc-d--active-ex-p ring)))))

(defun erc-d-self--parse-message-upstream (raw)
  "Hack shim for parsing RAW line recvd from peer."
  (cl-letf (((symbol-function #'erc-handle-parsed-server-response)
             (lambda (_ p) p)))
    (let ((erc-active-buffer nil))
      (erc-parse-server-response nil raw))))

(ert-deftest erc-d-i--validate-tags ()
  (should (erc-d-i--validate-tags
           (concat "batch=4cc99692bf24a4bec4aa03da437364f5;"
                   "time=2021-01-04T00:32:13.839Z")))
  (should (erc-d-i--validate-tags "+foo=bar;baz=spam"))
  (should (erc-d-i--validate-tags "foo=\\:ok;baz=\\s"))
  (should (erc-d-i--validate-tags "foo=\303\247edilla"))
  (should (erc-d-i--validate-tags "foo=\\"))
  (should (erc-d-i--validate-tags "foo=bar\\baz"))
  (should-error (erc-d-i--validate-tags "foo=\\\\;baz=\\\r\\\n"))
  (should-error (erc-d-i--validate-tags "foo=\n"))
  (should-error (erc-d-i--validate-tags "foo=\0ok"))
  (should-error (erc-d-i--validate-tags "foo=bar baz"))
  (should-error (erc-d-i--validate-tags "foo=bar\r"))
  (should-error (erc-d-i--validate-tags "foo=bar;")))

(ert-deftest erc-d-i--parse-message ()
  (let* ((raw (concat "@time=2020-11-23T09:10:33.088Z "
                      ":tilde.chat BATCH +1 chathistory :#meta"))
         (upstream (erc-d-self--parse-message-upstream raw))
         (ours (erc-d-i--parse-message raw)))

    ;; Upstream tags may be nil or (SYM . VAL) or (STR VAL) depending on
    ;; the Emacs version and whether erc-v3 has been loaded.
    (ert-info ("Baseline upstream")
      (should (equal (erc-response.unparsed upstream) raw))
      (should (equal (erc-response.sender upstream) "tilde.chat"))
      (should (equal (erc-response.command upstream) "BATCH"))
      (should (equal (erc-response.command-args upstream)
                     '("+1" "chathistory" "#meta")))
      (should (equal (erc-response.contents upstream) "#meta")))

    (ert-info ("Ours my not compare cl-equalp but is otherwise the same")
      (should (equal (erc-d-i-message.unparsed ours) raw))
      (should (equal (erc-d-i-message.sender ours) "tilde.chat"))
      (should (equal (erc-d-i-message.command ours) "BATCH"))
      (should (equal (erc-d-i-message.command-args ours)
                     '("+1" "chathistory" "#meta")))
      (should (equal (erc-d-i-message.contents ours) "#meta"))
      (should (equal (erc-d-i-message.tags ours)
                     '((time . "2020-11-23T09:10:33.088Z")))))

    (ert-info ("No compat decodes the whole message as utf-8")
      (setq ours (erc-d-i--parse-message
                  "@foo=\303\247edilla TAGMSG #ch\303\240n"
                  'decode))
      (should-not (erc-d-i-message.compat ours))
      (should (equal (erc-d-i-message.command-args ours) '("#chàn")))
      (should (equal (erc-d-i-message.contents ours) ""))
      (should (equal (erc-d-i-message.tags ours) '((foo . "çedilla")))))))

(ert-deftest erc-d-i--unescape-tag-value ()
  (should (equal (erc-d-i--unescape-tag-value
                  "\\sabc\\sdef\\s\\sxyz\\s")
                 " abc def  xyz "))
  (should (equal (erc-d-i--unescape-tag-value
                  "\\\\abc\\\\def\\\\\\\\xyz\\\\")
                 "\\abc\\def\\\\xyz\\"))
  (should (equal (erc-d-i--unescape-tag-value "a\\bc") "abc"))
  (should (equal (erc-d-i--unescape-tag-value
                  "\\\\abc\\\\def\\\\\\\\xyz\\")
                 "\\abc\\def\\\\xyz"))
  (should (equal (erc-d-i--unescape-tag-value "a\\:b\\r\\nc\\sd")
                 "a;b\r\nc d")))

(ert-deftest erc-d-i--escape-tag-value ()
  (should (equal (erc-d-i--escape-tag-value " abc def  xyz ")
                 "\\sabc\\sdef\\s\\sxyz\\s"))
  (should (equal (erc-d-i--escape-tag-value "\\abc\\def\\\\xyz\\")
                 "\\\\abc\\\\def\\\\\\\\xyz\\\\"))
  (should (equal (erc-d-i--escape-tag-value "a;b\r\nc d")
                 "a\\:b\\r\\nc\\sd")))

;; TODO add tests for msg-join, mask-match, userhost-split,
;; validate-hostname

(ert-deftest erc-d-i--parse-message--irc-parser-tests ()
  (let* ((data (with-temp-buffer
                 (insert-file-contents
                  (ert-resource-file "irc-parser-tests.lispdata"))
                 (read (current-buffer))))
         (tests (assoc-default 'tests (assoc-default 'msg-split data)))
         input atoms m ours)
    (dolist (test tests)
      (setq input (assoc-default 'input test)
            atoms (assoc-default 'atoms test)
            m (erc-d-i--parse-message input))
      (ert-info ("Parses tags correctly")
        (setq ours (erc-d-i-message.tags m))
        (if-let ((tags (assoc-default 'tags atoms)))
            (pcase-dolist (`(,key . ,value) ours)
              (should (string= (cdr (assq key tags)) (or value ""))))
          (should-not ours)))
      (ert-info ("Parses verbs correctly")
        (setq ours (erc-d-i-message.command m))
        (if-let ((verbs (assoc-default 'verb atoms)))
            (should (string= (downcase verbs) (downcase ours)))
          (should (string-empty-p ours))))
      (ert-info ("Parses sources correctly")
        (setq ours (erc-d-i-message.sender m))
        (if-let ((source (assoc-default 'source atoms)))
            (should (string= source ours))
          (should (string-empty-p ours))))
      (ert-info ("Parses params correctly")
        (setq ours (erc-d-i-message.command-args m))
        (if-let ((params (assoc-default 'params atoms)))
            (should (equal ours params))
          (should-not ours))))))

(iter-defun erc-d-self--i (form)
  (while form (iter-yield (pop form))))

(ert-deftest erc-d--render-entries ()
  (let ((dialog (make-erc-d-dialog :vars `((:a . 1)
                                           (c . ((a b) (: a space b)))
                                           (d . (c alpha digit))
                                           (bee . 2)
                                           (f . ,(lambda () "3"))
                                           (i . emacs-pid))))
        (exchange (make-erc-d-exchange))
        it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("Baseline Outgoing")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 "abc")))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "abc")))

    (ert-info ("Incoming are regexp escaped")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((i 0.0 "fsf" ".org")))))
      (should (equal (cons (iter-next it) (iter-next it)) '(i . 0.0)))
      (should (equal (iter-next it) "\\`fsf\\.org")))

    (ert-info ("Incoming can access vars via rx-let")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((i 0.0 bee)))))
      (should (equal (cons (iter-next it) (iter-next it)) '(i . 0.0)))
      (should (equal (iter-next it) "\\`\002")))

    (ert-info ("Incoming rx-let params")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((i 0.0 d)))))
      (should (equal (cons (iter-next it) (iter-next it)) '(i . 0.0)))
      (should (equal (iter-next it) "\\`[[:alpha:]][[:space:]][[:digit:]]")))

    (ert-info ("Incoming literal rx forms")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i
                                       '((i 0.0 (= 3 alpha) ".org")))))
      (should (equal (cons (iter-next it) (iter-next it)) '(i . 0.0)))
      (should (equal (iter-next it) "\\`[[:alpha:]]\\{3\\}\\.org")))

    (ert-info ("Self-quoting disallowed")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 :a "abc")))))
      (should (equal (iter-next it) 0))
      (should-error (iter-next it)))

    (ert-info ("Outgoing mixed")
      (let ((s '((0 (format "%s" (not (zerop i))) (string bee) f))))
        (setq it (erc-d--render-entries dialog exchange (erc-d-self--i s))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "t\0023")))

    (ert-info ("Exits clean")
      (when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
        (should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog))))))
      (let (c)
        (condition-case _ (iter-next it) (iter-end-of-sequence (setq c t)))
        (should c))
      (should (equal (erc-d-dialog-vars dialog)
                     `((:a . 1)
                       (c . ((a b) (: a space b)))
                       (d . (c alpha digit))
                       (bee . 2)
                       (f . ,(alist-get 'f (erc-d-dialog-vars dialog)))
                       (i . emacs-pid)))))))

(ert-deftest erc-d--render-entries--matches ()
  (let* ((alist (list
                 (cons 'f (lambda (a) (funcall a :match 1)))
                 (cons 'g (lambda () (match-string 2 "foo bar baz")))
                 (cons 'h (lambda (a) (concat (funcall a :match 0)
                                              (funcall a :request))))
                 (cons 'i (lambda (_ e) (erc-d-exchange-request e)))
                 (cons 'j (lambda ()
                            (set-match-data '(0 1))
                            (match-string 0 "j")))))
         (dialog (make-erc-d-dialog :vars alist))
         (exchange (make-erc-d-exchange
                    :request "foo bar baz"
                    ;;            11  222
                    :match-data '(4 11 4 6 8 11)))
         it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("Baseline outgoing")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 :request)))))
      (should (equal (iter-next it) 0))
      (should-error (iter-next it)))

    (ert-info ("One arg, match")
      (erc-d-exchange-reload dialog exchange)
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 f)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "ba")))

    (ert-info ("No args")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 g)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "baz")))

    (ert-info ("Second arg is exchange object")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 i)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "foo bar baz")))

    (ert-info ("One arg, multiple calls")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 h)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "bar bazfoo bar baz")))

    (ert-info ("Match data restored")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 j)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "j"))

      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 g)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "baz")))

    (ert-info ("Bad signature")
      (let ((qlist (list 'f '(lambda (p q x) (ignore)))))
        (setf (erc-d-dialog-vars dialog) qlist)
        (should-error (erc-d-exchange-reload dialog exchange))))))

(ert-deftest erc-d--render-entries--dynamic ()
  (let* ((alist (list
                 (cons 'foo "foo")
                 '(f . (lambda () foo))
                 (cons 'g '(lambda (a) (funcall a :rebind 'g f) "bar"))
                 (cons 'j (lambda (a) (funcall a :set "123") "abc"))
                 (cons 'k (lambda () "abc"))))
         (dialog (make-erc-d-dialog :vars alist))
         (exchange (make-erc-d-exchange))
         it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("Initial reference calls function")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 j) (0 j)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "abc")))

    (ert-info ("Subsequent reference expands to string")
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "123")))

    (ert-info ("Outside manipulation: initial reference calls function")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 k) (0 k)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "abc")))

    (ert-info ("Outside manipulation: subsequent reference expands to string")
      (erc-d-exchange-rebind dialog exchange 'k "123")
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "123")))

    (ert-info ("Swap one function for another")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 g) (0 g)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "bar"))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "foo")))

    (ert-info ("Bindings accessible inside functions") ; anti-feature?
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i '((0 f)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "foo")))

    (ert-info ("Rebuild alist by sending flag")
      (setq it (erc-d--render-entries dialog exchange
                                      (erc-d-self--i
                                       '((0 f) (1 f) (2 f) (i 3 f)))))
      (should (equal (iter-next it) 0))
      (should (equal (iter-next it) "foo"))
      (erc-d-exchange-rebind dialog exchange 'f "bar")
      (should (equal (iter-next it) 1))
      (should (equal (iter-next it) "bar"))
      (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog))
                        (lambda nil "baz")))
      (should (eq (iter-next it) 2))
      (should (equal (iter-next it 'reload) "baz"))
      (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) "spam"))
      (should (eq (iter-next it) 'i))
      (should (eq (iter-next it 'reload) 3))
      (should (equal (iter-next it) "\\`spam")))))

(ert-deftest erc-d-t-with-cleanup ()
  (should-not (get-buffer "*echo*"))
  (should-not (get-buffer "*foo*"))
  (should-not (get-buffer "*bar*"))
  (should-not (get-buffer "*baz*"))
  (erc-d-t-with-cleanup
      ((echo (start-process "echo" (get-buffer-create "*echo*") "sleep" "1"))
       (buffer-foo (get-buffer-create "*foo*"))
       (buffer-bar (get-buffer-create "*bar*"))
       (clean-up (list (intern (process-name echo)))) ; let*
       buffer-baz)
      (ert-info ("Clean Up")
        (should (equal clean-up '(ran echo)))
        (should (bufferp buffer-baz))
        (should (bufferp buffer-foo))
        (setq buffer-foo nil))
    (setq buffer-baz (get-buffer-create "*baz*"))
    (push 'ran clean-up))
  (ert-info ("Buffers and procs destroyed")
    (should-not (get-buffer "*echo*"))
    (should-not (get-buffer "*bar*"))
    (should-not (get-buffer "*baz*")))
  (ert-info ("Buffer foo spared")
    (should (get-buffer "*foo*"))
    (kill-buffer "*foo*")))

(eval-and-compile
  (defvar erc-d-self-with-server-password "changeme"))

;; Compromise between removing `autojoin' from `erc-modules' entirely
;; and allowing side effects to meddle excessively
(defvar erc-autojoin-channels-alist)

;; This is only meant to be used by tests in this file.
(cl-defmacro erc-d-self-with-server ((dumb-server-var erc-server-buffer-var)
                                     dialog &rest body)
  "Create server for DIALOG and run BODY.
DIALOG may also be a list of dialogs.  ERC-SERVER-BUFFER-VAR and
DUMB-SERVER-VAR are bound accordingly in BODY."
  (declare (indent 2))
  (when (eq '_ dumb-server-var)
    (setq dumb-server-var (make-symbol "dumb-server-var")))
  (when (eq '_ erc-server-buffer-var)
    (setq erc-server-buffer-var (make-symbol "erc-server-buffer-var")))
  (if (listp dialog)
      (setq dialog (mapcar (lambda (f) (list 'quote f)) dialog))
    (setq dialog `((quote ,dialog))))
  `(let* (auth-source-do-cache
          (,dumb-server-var (erc-d-run "localhost" t ,@dialog))
          ,erc-server-buffer-var
          ;;
          (erc-server-flood-penalty 0.05)
          erc-autojoin-channels-alist
          erc-server-auto-reconnect)
     (should-not erc-d--slow-mo)
     (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
     ;; Allow important messages through, even in -batch mode.
     (advice-add #'erc-handle-login :around #'erc-d-t-silence-around)
     (advice-add #'erc-server-connect :around #'erc-d-t-silence-around)
     (unless (or noninteractive erc-debug-irc-protocol)
       (erc-toggle-debug-irc-protocol))
     (setq ,erc-server-buffer-var
           (erc :server "localhost"
                :password erc-d-self-with-server-password
                :port (process-contact ,dumb-server-var :service)
                :nick "tester"
                :full-name "tester"))
     (unwind-protect
         (progn
           ,@body
           (erc-d-t-wait-for 1 "dumb-server death"
             (not (process-live-p ,dumb-server-var))))
       (when (process-live-p erc-server-process)
         (delete-process erc-server-process))
       (advice-remove #'erc-handle-login #'erc-d-t-silence-around)
       (advice-remove #'erc-server-connect #'erc-d-t-silence-around)
       (when noninteractive
         (kill-buffer ,erc-server-buffer-var)
         (erc-d-t-kill-related-buffers)))))

(defmacro erc-d-self-with-failure-spy (found func-syms &rest body)
  "Wrap functions with advice for inspecting errors caused by BODY.
Do this for functions whose names appear in FUNC-SYMS.  When running
advice code, add errors to list FOUND.  Note: the teardown finalizer is
not added by default.  Also, `erc-d-linger-secs' likely has to
be nonzero for this to work."
  (declare (indent 2))
  ;; Catch errors thrown by timers that `should-error'ignores
  `(progn
     (cl-labels ((ad (f o &rest r)
                     (condition-case err
                         (apply o r)
                       (error (push err ,found)
                              (advice-remove f 'spy)))))
       (dolist (sym ,func-syms)
         (advice-add sym :around (apply-partially #'ad sym) '((name . spy))))
       (progn ,@body))
     (setq ,found (nreverse ,found))
     (dolist (sym ,func-syms)
       (advice-remove sym 'spy))))

(ert-deftest erc-d-run-nonstandard-messages ()
  (let* ((erc-d-linger-secs 0.2)
         (dumb-server (erc-d-run "localhost" t 'nonstandard))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (expect (erc-d-t-make-expecter))
         (erc-d-t-use-regeexp-when-searching t)
         client)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client (open-network-stream "erc-d-client" nil
                                      "localhost"
                                      (process-contact dumb-server :service)
                                      :coding 'binary))
    (ert-info ("Server splits CRLF delimited lines")
      (process-send-string client "ONE one\r\nTWO two\r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 "<- nonstandard:[[:digit:]]+ ONE one$")
        (funcall expect 1 "<- nonstandard:[[:digit:]]+ TWO two$")))
    (ert-info ("Server doesn't discard empty lines")
      (process-send-string client "\r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 "<- nonstandard:[[:digit:]]+ $")))
    (ert-info ("Server preserves spaces")
      (process-send-string client " \r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 "<- nonstandard:[[:digit:]]+ \\{2\\}$"))
      (process-send-string client "  \r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 "<- nonstandard:[[:digit:]]+ \\{3\\}$")))
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client)
    (when noninteractive
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-basic ()
  (erc-d-self-with-server (_ _) basic
    (erc-d-t-wait-for 3  "#chan"
      (get-buffer "#chan"))
    (with-current-buffer "#chan"
      (erc-d-t-search-for 2 "hey"))
    (when noninteractive
      (kill-buffer "#chan"))))

(ert-deftest erc-d-run-eof ()
  (skip-unless noninteractive)
  (erc-d-self-with-server (_ erc-s-buf) eof
    (erc-d-t-wait-for 3  "#chan"
      (get-buffer "#chan"))
    (with-current-buffer "#chan"
      (erc-d-t-search-for 2 "hey"))
    (with-current-buffer erc-s-buf
      (process-send-eof erc-server-process))))

(ert-deftest erc-d-run-eof-fail ()
  (let (errors)
    (erc-d-self-with-failure-spy errors '(erc-d--teardown)
      (erc-d-self-with-server (_ _) eof
        (erc-d-t-wait-for 5 "#chan" (get-buffer "#chan"))
        (with-current-buffer "#chan" (erc-d-t-search-for 2 "hey"))
        (erc-d-t-wait-for 10 "Bad match" errors)))
    (should (string-match-p "Timed out awaiting request.*__EOF__"
                            (cadr (pop errors))))))

(ert-deftest erc-d-run-linger ()
  (erc-d-self-with-server (dumb-s _) linger
    (erc-d-t-wait-for 3  "#chan"
      (get-buffer "#chan"))
    (with-current-buffer "#chan"
      (erc-d-t-search-for 2 "hey"))
    (with-current-buffer (process-buffer dumb-s)
      (erc-d-t-search-for 2 "Lingering for 1.00 seconds"))
    (with-current-buffer (process-buffer dumb-s)
      (erc-d-t-search-for 2 "Lingered for 1.00 seconds"))))

(ert-deftest erc-d-run-linger-fail ()
  (let ((erc-server-flood-penalty 0.1)
        errors)
    (erc-d-self-with-failure-spy
        errors '(erc-d--teardown erc-d-command)
      (erc-d-self-with-server (_ _) linger
        (erc-d-t-wait-for 3  "#chan"
          (get-buffer "#chan"))
        (with-current-buffer "#chan"
          (erc-d-t-search-for 2 "hey")
          (erc-cmd-MSG "#chan hi"))
        (erc-d-t-wait-for 10 "Bad match" errors)))
    (should (string-match-p "Match failed.*hi" (cadr (pop errors))))))

(ert-deftest erc-d-run-linger-direct ()
  (let* ((dumb-server (erc-d-run "localhost" t
                                 'linger-multi-a 'linger-multi-b))
         (port (process-contact dumb-server :service))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
         (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
         (start (current-time))
         client-a client-b)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
                                        "localhost" port
                                        :coding 'binary)
          client-b (open-network-stream "erc-d-client-b" client-buffer-b
                                        "localhost" port
                                        :coding 'binary))
    (process-send-string client-a "PASS :a\r\n")
    (sleep-for 0.01)
    (process-send-string client-b "PASS :b\r\n")
    (sleep-for 0.01)
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (ert-info ("Ensure linger of one second")
      (should (time-less-p 1 (time-subtract (current-time) start)))
      (should (time-less-p (time-subtract (current-time) start) 1.5)))
    (delete-process client-a)
    (delete-process client-b)
    (when noninteractive
      (kill-buffer client-buffer-a)
      (kill-buffer client-buffer-b)
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-drop-direct ()
  (let* ((dumb-server (erc-d-run "localhost" t 'drop-a 'drop-b))
         (port (process-contact dumb-server :service))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
         (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
         (start (current-time))
         client-a client-b)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
                                        "localhost" port
                                        :coding 'binary)
          client-b (open-network-stream "erc-d-client-b" client-buffer-b
                                        "localhost" port
                                        :coding 'binary))
    (process-send-string client-a "PASS :a\r\n")
    (sleep-for 0.01)
    (process-send-string client-b "PASS :b\r\n")
    (erc-d-t-wait-for 3 "client-a dies" (not (process-live-p client-a)))
    (should (time-less-p (time-subtract (current-time) start) 0.32))
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (ert-info ("Ensure linger of one second")
      (should (time-less-p 1 (time-subtract (current-time) start))))
    (delete-process client-a)
    (delete-process client-b)
    (when noninteractive
      (kill-buffer client-buffer-a)
      (kill-buffer client-buffer-b)
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-no-match ()
  (let ((erc-d-linger-secs 1)
        erc-server-auto-reconnect
        errors)
    (erc-d-self-with-failure-spy errors '(erc-d--teardown erc-d-command)
      (erc-d-self-with-server (_ erc-server-buffer) no-match
        (with-current-buffer erc-server-buffer
          (erc-d-t-search-for 2 "away")
          (erc-cmd-JOIN "#foo")
          (erc-d-t-wait-for 10 "Bad match" errors))))
    (should (string-match-p "Match failed.*foo.*chan" (cadr (pop errors))))
    (should-not (get-buffer "#foo"))))

(ert-deftest erc-d-run-timeout ()
  (let ((erc-d-linger-secs 1)
        err errors)
    (erc-d-self-with-failure-spy errors '(erc-d--teardown)
      (erc-d-self-with-server (_ _) timeout
        (erc-d-t-wait-for 10 "error caught" errors)))
    (setq err (pop errors))
    (should (eq (car err) 'erc-d-timeout))
    (should (string-match-p "Timed out" (cadr err)))))

(ert-deftest erc-d-run-unexpected ()
  (let ((erc-d-linger-secs 2)
        errors)
    (erc-d-self-with-failure-spy
        errors '(erc-d--teardown erc-d-command)
      (erc-d-self-with-server (_ _) unexpected
        (ert-info ("All specs consumed when more input arrives")
          (erc-d-t-wait-for 10 "error caught"
            (= 2 (length errors))))))
    (should (string-match-p "unexpected.*MODE" (cadr (pop errors))))
    ;; Nonsensical normally because func would have already exited when
    ;; first error was thrown
    (should (string-match-p "Match failed" (cadr (pop errors))))))

(ert-deftest erc-d-run-unexpected-depleted ()
  (let ((erc-d-linger-secs 3)
        errors)
    (erc-d-self-with-failure-spy errors '(erc-d--teardown erc-d-command)
      (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
             (dumb-server (erc-d-run "localhost" t 'depleted))
             (expect (erc-d-t-make-expecter))
             (client-buf (get-buffer-create "*erc-d-client*"))
             client-proc)
        (with-current-buffer dumb-server-buffer
          (erc-d-t-search-for 3 "Starting"))
        (setq client-proc (make-network-process
                           :buffer client-buf
                           :name "erc-d-client"
                           :family 'ipv4
                           :noquery t
                           :coding 'binary
                           :service (process-contact dumb-server :service)
                           :host "localhost"))
        (with-current-buffer dumb-server-buffer
          (funcall expect 3 "Connection"))
        (process-send-string client-proc "PASS :changeme\r\n")
        (sleep-for 0.01)
        (process-send-string client-proc "NICK tester\r\n")
        (sleep-for 0.01)
        (process-send-string client-proc "USER user 0 * :tester\r\n")
        (sleep-for 0.01)
        (process-send-string client-proc "BLAH :too much\r\n")
        (sleep-for 0.01)
        (with-current-buffer client-buf
          (funcall expect 3 "Welcome to the Internet"))
        (erc-d-t-wait-for 2 "dumb-server death"
          (not (process-live-p dumb-server)))
        (delete-process client-proc)
        (when noninteractive
          (kill-buffer client-buf)
          (kill-buffer dumb-server-buffer))))
    (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
    ;; Wouldn't happen IRL
    (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
    (should-not errors)))

(defun erc-d-self--dynamic-match-user (_dialog exchange)
  "Shared pattern/response handler for canned dynamic DIALOG test."
  (should (string= (match-string 1 (erc-d-exchange-request exchange))
                   "tester")))

(defun erc-d-self--run-dynamic ()
  "Perform common assertions for \"dynamic\" dialog."
  (erc-d-self-with-server (dumb-server erc-server-buffer) dynamic
    (erc-d-t-wait-for 3 "#chan"
      (get-buffer "#chan"))
    (with-current-buffer "#chan"
      (erc-d-t-search-for 2 "tester: hey"))
    (with-current-buffer erc-server-buffer
      (let ((expect (erc-d-t-make-expecter)))
        (funcall expect 2 "host is irc.fsf.org")
        (funcall expect 2 "modes for tester")))
    (with-current-buffer (process-buffer dumb-server)
      (erc-d-t-search-for 2 "irc.fsf.org"))
    (when noninteractive
      (kill-buffer "#chan"))))

(ert-deftest erc-d-run-dynamic-default-match ()
  (let* (dynamic-tally
         (erc-d-spec-vars '((user . "user")
                            (ignored . ((a b) (: a space b)))
                            (realname . (group (+ graph)))))
         (nick (lambda (a)
                 (push '(nick . match-user) dynamic-tally)
                 (funcall a :set (funcall a :match 1) 'export)))
         (dom (lambda (a)
                (push '(dom . match-user) dynamic-tally)
                (funcall a :set erc-d-server-fqdn)))
         (erc-d-match-handlers
          (list :user (lambda (d e)
                        (erc-d-exchange-rebind d e 'nick nick)
                        (erc-d-exchange-rebind d e 'dom dom)
                        (erc-d-self--dynamic-match-user d e))
                :mode-user (lambda (d e)
                             (erc-d-exchange-rebind d e 'nick "tester")
                             (erc-d-exchange-rebind d e 'dom dom))))
         (erc-d-server-fqdn "irc.fsf.org"))
    (erc-d-self--run-dynamic)
    (should (equal '((dom . match-user) (nick . match-user) (dom . match-user))
                   dynamic-tally))))

(ert-deftest erc-d-run-dynamic-default-match-rebind ()
  (let* (tally
         ;;
         (erc-d-spec-vars '((user . "user")
                            (ignored . ((a b) (: a space b)))
                            (realname . (group (+ graph)))))
         (erc-d-match-handlers
          (list :user
                (lambda (d e)
                  (erc-d-exchange-rebind
                   d e 'nick
                   (lambda (a)
                     (push 'bind-nick tally)
                     (funcall a :rebind 'nick (funcall a :match 1) 'export)))
                  (erc-d-exchange-rebind
                   d e 'dom
                   (lambda ()
                     (push 'bind-dom tally)
                     (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn)))
                  (erc-d-self--dynamic-match-user d e))
                :mode-user
                (lambda (d e)
                  (erc-d-exchange-rebind d e 'nick "tester")
                  (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn))))
         (erc-d-server-fqdn "irc.fsf.org"))
    (erc-d-self--run-dynamic)
    (should (equal '(bind-nick bind-dom) tally))))

(ert-deftest erc-d-run-dynamic-runtime-stub ()
  (let ((erc-d-spec-vars '((token . (group (or "barnet" "foonet")))))
        (erc-d-match-handlers
         (list :pass (lambda (d _e)
                       (erc-d-load-replacement-dialog d 'dynamic-foonet))))
        (erc-d-self-with-server-password "foonet:changeme"))
    (erc-d-self-with-server (_ erc-server-buffer)
        (dynamic-stub dynamic-foonet)
      (erc-d-t-wait-for 3 "#chan"
        (get-buffer "#chan"))
      (with-current-buffer "#chan"
        (erc-d-t-search-for 2 "alice:")
        (erc-d-t-search-for -0.1 "joe"))
      (with-current-buffer erc-server-buffer
        (let ((expect (erc-d-t-make-expecter)))
          (funcall expect 2 "host is irc.foonet.org")
          (funcall expect 2 "NETWORK=FooNet")))
      (when noninteractive
        (kill-buffer "#chan")))))

(ert-deftest erc-d-run-dynamic-runtime-stub-skip ()
  (let ((erc-d-spec-vars '((token . "barnet")))
        (erc-d-match-handlers
         (list :pass (lambda (d _e)
                       (erc-d-load-replacement-dialog
                        d 'dynamic-barnet 1))))
        (erc-d-self-with-server-password "barnet:changeme"))
    (erc-d-self-with-server (_ erc-server-buffer)
        (dynamic-stub dynamic-barnet)
      (erc-d-t-wait-for 3 "#chan"
        (get-buffer "#chan"))
      (with-current-buffer "#chan"
        (erc-d-t-search-for 2 "joe:")
        (erc-d-t-search-for -0.1 "alice"))
      (with-current-buffer erc-server-buffer
        (let ((expect (erc-d-t-make-expecter)))
          (funcall expect 2 "host is irc.barnet.org")
          (funcall expect 2 "NETWORK=BarNet")))
      (when noninteractive
        (kill-buffer "#chan")))))

;; This can be removed; only exists to get a baseline for next test
(ert-deftest erc-d-run-fuzzy-direct ()
  (let* ((erc-d-linger-secs 0.1)
         (erc-d-spec-vars
          `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
         (dumb-server (erc-d-run "localhost" t 'fuzzy))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer (get-buffer-create "*erc-d-client*"))
         client)
    (with-current-buffer "*erc-d-server*"
      (erc-d-t-search-for 4 "Starting"))
    (setq client (make-network-process
                  :buffer client-buffer
                  :name "erc-d-client"
                  :family 'ipv4
                  :noquery t
                  :coding 'binary
                  :service (process-contact dumb-server :service)
                  :host "localhost"))
    ;; We could also just send this as a single fatty
    (process-send-string client "PASS :changeme\r\n")
    (sleep-for 0.01)
    (process-send-string client "NICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE tester +i\r\n")
    (sleep-for 0.01)
    (process-send-string client "JOIN #bar\r\n")
    (sleep-for 0.01)
    (process-send-string client "JOIN #foo\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE #bar\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE #foo\r\n")
    (sleep-for 0.01)
    (erc-d-t-wait-for 1 "dumb-server death"
      (not (process-live-p dumb-server)))
    (when noninteractive
      (kill-buffer client-buffer)
      (kill-buffer dumb-server-buffer))))

;; Without adjusting penalty, takes ~15 secs. With is comprable to direct ^.
(ert-deftest erc-d-run-fuzzy ()
  (let ((erc-server-flood-penalty 1.2) ; penalty < margin/sends is basically 0
        (erc-d-linger-secs 0.1)
        (erc-d-spec-vars
         `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
        erc-server-auto-reconnect)
    (erc-d-self-with-server (_ erc-server-buffer) fuzzy
      (with-current-buffer erc-server-buffer
        (erc-d-t-search-for 2 "away")
        (goto-char erc-input-marker)
        (erc-cmd-JOIN "#bar"))
      (erc-d-t-wait-for 2 "#bar"
        (get-buffer "#bar"))
      (with-current-buffer erc-server-buffer
        (erc-cmd-JOIN "#foo"))
      (erc-d-t-wait-for 20 "#foo"
        (get-buffer "#foo"))
      (with-current-buffer "#bar"
        (erc-d-t-search-for 1 "was created on"))
      (with-current-buffer "#foo"
        (erc-d-t-search-for 5 "was created on")))))

(ert-deftest erc-d-run-no-block ()
  (let ((erc-server-flood-penalty 1)
        (erc-d-linger-secs 1.2)
        (expect (erc-d-t-make-expecter))
        erc-server-auto-reconnect)
    (erc-d-self-with-server (_ erc-server-buffer) no-block
      (with-current-buffer erc-server-buffer
        (funcall expect 2 "away")
        (funcall expect 1 erc-prompt)
        (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#foo")))
      (erc-d-t-wait-for 2 "#foo" (get-buffer "#foo"))
      (with-current-buffer "#foo" (funcall expect 2 "was created on"))

      (ert-info ("Join #bar")
        (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#bar"))
        (erc-d-t-wait-for 2 "#bar" (get-buffer "#bar")))

      (with-current-buffer "#bar" (funcall expect 1 "was created on"))

      (ert-info ("Server expects next pattern but keeps sending")
        (with-current-buffer "#foo" (funcall expect 2 "Rosalind"))
        (with-current-buffer "#bar" (funcall expect 1 "hi"))
        (with-current-buffer "#foo"
          (should-not (search-forward "<bob> I am heard" nil t))
          (funcall expect 1.5 "<bob> I am heard"))))))

(defun erc-d-self--run-proxy-direct (dumb-server dumb-server-buffer port)
  "Start DUMB-SERVER with DUMB-SERVER-BUFFER and PORT.
These are steps shared by in-proc and subproc variants testing a
bouncer-like setup."
  (when (version< emacs-version "28") (ert-skip "TODO connection refused"))
  (let ((client-buffer-foo (get-buffer-create "*erc-d-client-foo*"))
        (client-buffer-bar (get-buffer-create "*erc-d-client-bar*"))
        (expect (erc-d-t-make-expecter))
        client-foo
        client-bar)
    (setq client-foo (make-network-process
                      :buffer client-buffer-foo
                      :name "erc-d-client-foo"
                      :family 'ipv4
                      :noquery t
                      :coding 'binary
                      :service port
                      :host "localhost")
          client-bar (make-network-process
                      :buffer client-buffer-bar
                      :name "erc-d-client-bar"
                      :family 'ipv4
                      :noquery t
                      :coding 'binary
                      :service port
                      :host "localhost"))
    (with-current-buffer dumb-server-buffer
      (funcall expect 3 "Connection"))
    (process-send-string client-foo "PASS :foo:changeme\r\n")
    (process-send-string client-bar "PASS :bar:changeme\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "NICK tester\r\n")
    (process-send-string client-bar "NICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "USER user 0 * :tester\r\n")
    (process-send-string client-bar "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "MODE tester +i\r\n")
    (process-send-string client-bar "MODE tester +i\r\n")
    (sleep-for 0.01)
    (with-current-buffer client-buffer-foo
      (funcall expect 3 "FooNet")
      (funcall expect 3 "irc.foo.net")
      (funcall expect 3 "marked as being away")
      (goto-char (point-min))
      (should-not (search-forward "bar" nil t)))
    (with-current-buffer client-buffer-bar
      (funcall expect 3 "BarNet")
      (funcall expect 3 "irc.bar.net")
      (funcall expect 3 "marked as being away")
      (goto-char (point-min))
      (should-not (search-forward "foo" nil t)))
    (erc-d-t-wait-for 2 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client-foo)
    (delete-process client-bar)
    (when noninteractive
      (kill-buffer client-buffer-foo)
      (kill-buffer client-buffer-bar)
      (kill-buffer dumb-server-buffer))))

;; This test shows the simplest way to set up template variables: put
;; everything needed for the whole session in `erc-d-spec-vars' before
;; starting the server.

(ert-deftest erc-d-run-proxy-direct-spec-vars ()
  (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
         (erc-d-linger-secs 0.5)
         (erc-d-spec-vars
          `((network . (group (+ alpha)))
            (fqdn . ,(lambda (a)
                       (let ((network (funcall a :match 1 'pass)))
                         (should (member network '("foo" "bar")))
                         (funcall a :set (concat "irc." network ".net")))))
            (net . ,(lambda (a)
                      (let ((network (funcall a :match 1 'pass)))
                        (should (member network '("foo" "bar")))
                        (concat (capitalize network) "Net"))))))
         (dumb-server (erc-d-run "localhost" t 'proxy-foonet 'proxy-barnet))
         (port (process-contact dumb-server :service)))
    (with-current-buffer dumb-server-buffer
      (erc-d-t-search-for 3 "Starting"))
    (erc-d-self--run-proxy-direct dumb-server dumb-server-buffer port)))

(cl-defun erc-d-self--start-server (&key dialogs buffer linger program libs)
  "Start and return a server in a subprocess using BUFFER and PORT.
DIALOGS are symbols representing the base names of dialog files in
`erc-d-u-canned-dialog-dir'.  LIBS are extra files to load."
  (push (locate-library "erc-d" nil (list erc-d-u--library-directory)) libs)
  (cl-assert (car libs))
  (let* ((args `("erc-d-server" ,buffer
                 ,(concat invocation-directory invocation-name)
                 "-Q" "-batch" "-L" ,erc-d-u--library-directory
                 ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o)
                 "-eval" ,(format "%S" program) "-f" "erc-d-serve"
                 ,@(when linger (list "--linger" (number-to-string linger)))
                 ,@(mapcar #'erc-d-u--expand-dialog-symbol dialogs)))
         (proc (apply #'start-process args)))
    (set-process-query-on-exit-flag proc nil)
    (with-current-buffer buffer
      (erc-d-t-search-for 5 "Starting")
      (search-forward " (")
      (backward-char))
    (let ((pair (read buffer)))
      (cons proc (cdr pair)))))

(ert-deftest erc-d-run-proxy-direct-subprocess ()
  (let* ((buffer (get-buffer-create "*erc-d-server*"))
         ;; These are quoted because they're passed as printed forms to subproc
         (fqdn '(lambda (a e)
                  (let* ((d (erc-d-exchange-dialog e))
                         (name (erc-d-dialog-name d)))
                    (funcall a :set (if (eq name 'proxy-foonet)
                                        "irc.foo.net"
                                      "irc.bar.net")))))
         (net '(lambda (a)
                 (funcall a :rebind 'net
                          (if (eq (funcall a :dialog-name) 'proxy-foonet)
                              "FooNet"
                            "BarNet"))))
         (program `(setq erc-d-spec-vars '((fqdn . ,fqdn)
                                           (net . ,net)
                                           (network . (group (+ alpha))))))
         (port (erc-d-self--start-server
                :linger 0.3
                :program program
                :buffer buffer
                :dialogs '(proxy-foonet proxy-barnet)))
         (server (pop port)))
    (erc-d-self--run-proxy-direct server buffer port)))

(ert-deftest erc-d-run-proxy-direct-subprocess-lib ()
  (let* ((buffer (get-buffer-create "*erc-d-server*"))
         (lib (ert-resource-file "proxy-subprocess.el"))
         (port (erc-d-self--start-server :linger 0.3
                                         :buffer buffer
                                         :dialogs '(proxy-foonet proxy-barnet)
                                         :libs (list lib)))
         (server (pop port)))
    (erc-d-self--run-proxy-direct server buffer port)))

(ert-deftest erc-d-run-no-pong ()
  (let* (erc-d-auto-pong
         ;;
         (erc-d-spec-vars
          `((nonce . (group (: digit digit)))
            (echo . ,(lambda (a)
                       (should (string= (funcall a :match 1) "42")) "42"))))
         (dumb-server-buffer (get-buffer-create "*erc-d-server*"))
         (dumb-server (erc-d-run "localhost" t 'no-pong))
         (expect (erc-d-t-make-expecter))
         (client-buf (get-buffer-create "*erc-d-client*"))
         client-proc)
    (with-current-buffer dumb-server-buffer
      (erc-d-t-search-for 3 "Starting"))
    (setq client-proc (make-network-process
                       :buffer client-buf
                       :name "erc-d-client"
                       :family 'ipv4
                       :noquery t
                       :coding 'binary
                       :service (process-contact dumb-server :service)
                       :host "localhost"))
    (with-current-buffer dumb-server-buffer
      (funcall expect 3 "Connection"))
    (process-send-string client-proc "PASS :changeme\r\nNICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-proc "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-proc "MODE tester +i\r\n")
    (sleep-for 0.01)
    (with-current-buffer client-buf
      (funcall expect 3 "ExampleOrg")
      (funcall expect 3 "irc.example.org")
      (funcall expect 3 "marked as being away"))
    (ert-info ("PING is not intercepted by specialized method")
      (process-send-string client-proc "PING 42\r\n")
      (with-current-buffer client-buf
        (funcall expect 3 "PONG")))
    (erc-d-t-wait-for 2 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client-proc)
    (when noninteractive
      (kill-buffer client-buf)
      (kill-buffer dumb-server-buffer))))

;; Inspect replies as they arrive within a single exchange, i.e., ensure we
;; don't regress to prior buggy version in which inspection wasn't possible
;; until all replies had been sent by the server.
(ert-deftest erc-d-run-incremental ()
  (let ((erc-server-flood-penalty 0)
        (expect (erc-d-t-make-expecter))
        erc-d-linger-secs)
    (erc-d-self-with-server (_ erc-server-buffer) incremental
      (with-current-buffer erc-server-buffer
        (funcall expect 3 "marked as being away"))
      (with-current-buffer erc-server-buffer
        (erc-cmd-JOIN "#foo"))
      (erc-d-t-wait-for 1 "#foo exists"
        (get-buffer "#foo"))
      (with-current-buffer "#foo"
        (funcall expect 1 "Users on #foo")
        (funcall expect 1 "Look for me")
        (not (search-forward "Done" nil t))
        (funcall expect 10 "Done")
        (erc-send-message "Hi")))))

(ert-deftest erc-d-unix-socket-direct ()
  (skip-unless (featurep 'make-network-process '(:family local)))
  (let* ((erc-d-linger-secs 0.1)
         (sock (expand-file-name "erc-d.sock" temporary-file-directory))
         (dumb-server (erc-d-run nil sock 'basic))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer (get-buffer-create "*erc-d-client*"))
         client)
    (with-current-buffer "*erc-d-server*"
      (erc-d-t-search-for 4 "Starting"))
    (unwind-protect
        (progn
          (setq client (make-network-process
                        :buffer client-buffer
                        :name "erc-d-client"
                        :family 'local
                        :noquery t
                        :coding 'binary
                        :service sock))
          (process-send-string client "PASS :changeme\r\n")
          (sleep-for 0.01)
          (process-send-string client "NICK tester\r\n")
          (sleep-for 0.01)
          (process-send-string client "USER user 0 * :tester\r\n")
          (sleep-for 0.1)
          (process-send-string client "MODE tester +i\r\n")
          (sleep-for 0.01)
          (process-send-string client "MODE #chan\r\n")
          (sleep-for 0.01)
          (erc-d-t-wait-for 1 "dumb-server death"
            (not (process-live-p dumb-server)))
          (when noninteractive
            (kill-buffer client-buffer)
            (kill-buffer dumb-server-buffer)))
      (delete-file sock))))

;;; erc-d-self.el ends here