diff options
Diffstat (limited to 'test/lisp/erc/resources/erc-d/erc-d-tests.el')
| -rw-r--r-- | test/lisp/erc/resources/erc-d/erc-d-tests.el | 1373 |
1 files changed, 1373 insertions, 0 deletions
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el new file mode 100644 index 00000000000..a4befd96b5e --- /dev/null +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -0,0 +1,1373 @@ +;;; erc-d-tests.el --- tests for erc-d -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. +;; +;; 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: + +;;; Code: +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (expand-file-name ".." (ert-resource-directory)) + load-path))) + (require 'erc-d) + (require 'erc-d-t))) + +(require 'erc) + +;; Temporary kludge to silence warning +(put 'erc-parse-tags 'erc-v3-warned-p t) + +(ert-deftest erc-d-u--canned-load-dialog--basic () + (should-not (get-buffer "basic.eld")) + (should-not erc-d-u--canned-buffers) + (let* ((exes (erc-d-u--canned-load-dialog 'basic)) + (reap (lambda () + (cl-loop with e = (erc-d-u--read-dialog exes) + for s = (erc-d-u--read-exchange e) + while s collect s)))) + (should (get-buffer "basic.eld")) + (should (memq (get-buffer "basic.eld") erc-d-u--canned-buffers)) + (should (equal (funcall reap) '((pass 10.0 "PASS " (? ?:) "changeme")))) + (should (equal (funcall reap) '((nick 0.2 "NICK tester")))) + (let ((r (funcall reap))) + (should (equal (car r) '(user 0.2 "USER user 0 * :tester"))) + (should (equal + (car (last r)) + '(0 ":irc.example.org 422 tester :MOTD File is missing")))) + (should (equal (car (funcall reap)) '(mode-user 5 "MODE tester +i"))) + (should (equal (funcall reap) + '((mode-chan 1.2 "MODE #chan") + (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")))) + ;; See `define-error' site for `iter-end-of-sequence' + (ert-info ("EOB detected") (should-not (erc-d-u--read-dialog exes)))) + (should-not (get-buffer "basic.eld")) + (should-not erc-d-u--canned-buffers)) + +(defun erc-d-tests--make-hunk-reader (hunks) + (let ((p (erc-d-u--read-dialog hunks))) + (lambda () (erc-d-u--read-exchange p)))) + +;; 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.eld")) + (should-not erc-d-u--canned-buffers) + (let* ((exes (erc-d-u--canned-load-dialog 'basic)) + (pass (erc-d-tests--make-hunk-reader exes)) + (nick (erc-d-tests--make-hunk-reader exes)) + (user (erc-d-tests--make-hunk-reader exes)) + (modu (erc-d-tests--make-hunk-reader exes)) + (modc (erc-d-tests--make-hunk-reader exes))) + + (should (equal (funcall user) '(user 0.2 "USER user 0 * :tester"))) + (should (equal (funcall modu) '(mode-user 5 "MODE tester +i"))) + (should (equal (funcall modc) '(mode-chan 1.2 "MODE #chan"))) + + (cl-loop repeat 8 do (funcall user)) ; skip a few + (should (equal (funcall user) + '(0 ":irc.example.org 254 tester 1 :channels formed"))) + (should (equal (funcall modu) + '(0 ":irc.example.org 221 tester +Zi"))) + (should (equal (cl-loop for s = (funcall modc) while s collect s) ; done + '((0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")))) + + (cl-loop repeat 3 do (funcall user)) + (cl-loop repeat 3 do (funcall modu)) + + (ert-info ("Change up the order") + (should + (equal (funcall modu) + '(0 ":irc.example.org 366 alice #chan :End of NAMES list"))) + (should + (equal (funcall user) + '(0 ":irc.example.org 422 tester :MOTD File is missing")))) + + ;; Exhaust these + (should (equal (cl-loop for s = (funcall pass) while s collect s) ; done + '((pass 10.0 "PASS " (? ?:) "changeme")))) + (should (equal (cl-loop for s = (funcall nick) while s collect s) ; done + '((nick 0.2 "NICK tester")))) + + (ert-info ("End of file but no teardown because hunks outstanding") + (should-not (erc-d-u--read-dialog exes)) + (should (get-buffer "basic.eld"))) + + ;; Finish + (should-not (funcall user)) + (should-not (funcall modu))) + + (should-not (get-buffer "basic.eld")) + (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.eld")) + (should-not (get-buffer "basic.eld<2>")) + (should-not (get-buffer "basic.eld<3>")) + (should-not erc-d-u--canned-buffers) + (let ((exes (erc-d-u--canned-load-dialog 'basic)) + (exes-lower (erc-d-u--canned-load-dialog 'basic)) + (exes-custom (erc-d-u--canned-load-dialog 'basic)) + (reap (lambda (e) (cl-loop with p = (erc-d-u--read-dialog e) + for s = (erc-d-u--read-exchange p) + while s collect s)))) + (should (get-buffer "basic.eld")) + (should (get-buffer "basic.eld<2>")) + (should (get-buffer "basic.eld<3>")) + (should (equal (list (get-buffer "basic.eld<3>") + (get-buffer "basic.eld<2>") + (get-buffer "basic.eld")) + erc-d-u--canned-buffers)) + + (ert-info ("Rewrite for slowmo basic") + (setq exes (erc-d-u--rewrite-for-slow-mo 10 exes)) + (should (equal (funcall reap exes) + '((pass 20.0 "PASS " (? ?:) "changeme")))) + (should (equal (funcall reap exes) + '((nick 10.2 "NICK tester")))) + (let ((r (funcall reap exes))) + (should (equal (car r) '(user 10.2 "USER user 0 * :tester"))) + (should (equal + (car (last r)) + '(0 ":irc.example.org 422 tester :MOTD File is missing")))) + (should (equal (car (funcall reap exes)) + '(mode-user 15 "MODE tester +i"))) + (should (equal (car (funcall reap exes)) + '(mode-chan 11.2 "MODE #chan"))) + (should-not (erc-d-u--read-dialog exes))) + + (ert-info ("Rewrite for slowmo bounded") + (setq exes-lower (erc-d-u--rewrite-for-slow-mo -5 exes-lower)) + (should (equal (funcall reap exes-lower) + '((pass 10.0 "PASS " (? ?:) "changeme")))) + (should (equal (funcall reap exes-lower) + '((nick 5 "NICK tester")))) + (should (equal (car (funcall reap exes-lower)) + '(user 5 "USER user 0 * :tester"))) + (should (equal (car (funcall reap exes-lower)) + '(mode-user 5 "MODE tester +i"))) + (should (equal (car (funcall reap exes-lower)) + '(mode-chan 5 "MODE #chan"))) + (should-not (erc-d-u--read-dialog 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 (funcall reap exes-custom) + '((pass 20.0 "PASS " (? ?:) "changeme")))) + (should (equal (funcall reap exes-custom) + '((nick 0.4 "NICK tester")))) + (should (equal (car (funcall reap exes-custom)) + '(user 0.4 "USER user 0 * :tester"))) + (should (equal (car (funcall reap exes-custom)) + '(mode-user 10 "MODE tester +i"))) + (should (equal (car (funcall reap exes-custom)) + '(mode-chan 2.4 "MODE #chan"))) + (should-not (erc-d-u--read-dialog exes-custom)))) + + (should-not (get-buffer "basic.eld")) + (should-not (get-buffer "basic.eld<2>")) + (should-not (get-buffer "basic.eld<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-tests--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-tests--parse-message-upstream raw)) + (ours (erc-d-i--parse-message raw))) + + (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 + (expand-file-name "irc-parser-tests.eld" + (ert-resource-directory))) + (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)))))) + +(defun erc-d-tests--new-ex (existing raw-hunk) + (let* ((f (lambda (_) (pop raw-hunk))) + (sd (make-erc-d-u-scan-d :f f))) + (setf (erc-d-exchange-hunk existing) (make-erc-d-u-scan-e :sd sd) + (erc-d-exchange-spec existing) (make-erc-d-spec))) + (erc-d--iter existing)) + +(ert-deftest erc-d--render-entries () + (let* ((erc-nick "foo") + (dialog (make-erc-d-dialog :vars `((:a . 1) + (c . ((a b) (: a space b))) + (d . (c alpha digit)) + (bee . 2) + (f . ,(lambda () "3")) + (i . erc-nick)))) + (exchange (make-erc-d-exchange :dialog dialog)) + (mex (apply-partially #'erc-d-tests--new-ex exchange)) + it) + + (erc-d-exchange-reload dialog exchange) + + (ert-info ("Baseline Outgoing") + (setq it (funcall mex '((0 "abc")))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "abc"))) + + (ert-info ("Incoming are regexp escaped") + (setq it (funcall mex '((i 0.0 "fsf" ".org")))) + (should (equal (cons (funcall it) (funcall it)) '(i . 0.0))) + (should (equal (funcall it) "\\`fsf\\.org"))) + + (ert-info ("Incoming can access vars via rx-let") + (setq it (funcall mex '((i 0.0 bee)))) + (should (equal (cons (funcall it) (funcall it)) '(i . 0.0))) + (should (equal (funcall it) "\\`\002"))) + + (ert-info ("Incoming rx-let params") + (setq it (funcall mex '((i 0.0 d)))) + (should (equal (cons (funcall it) (funcall it)) '(i . 0.0))) + (should (equal (funcall it) "\\`[[:alpha:]][[:space:]][[:digit:]]"))) + + (ert-info ("Incoming literal rx forms") + (setq it (funcall mex '((i 0.0 (= 3 alpha) ".org")))) + (should (equal (cons (funcall it) (funcall it)) '(i . 0.0))) + (should (equal (funcall it) "\\`[[:alpha:]]\\{3\\}\\.org"))) + + (ert-info ("Self-quoting disallowed") + (setq it (funcall mex '((0 :a "abc")))) + (should (equal (funcall it) 0)) + (should-error (funcall it))) + + (ert-info ("Global vars and short vars") + (setq it (funcall mex '((0 i f erc-nick)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "foo3foo"))) + + (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)))))) + (should-not (funcall it)) + (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 . erc-nick))))))) + +(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 :dialog dialog + :request "foo bar baz" + ;; 11 222 + :match-data '(4 11 4 6 8 11))) + (mex (apply-partially #'erc-d-tests--new-ex exchange)) + it) + + (erc-d-exchange-reload dialog exchange) + + (ert-info ("One arg, match") + (setq it (funcall mex '((0 f)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "ba"))) + + (ert-info ("No args") + (setq it (funcall mex '((0 g)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "baz"))) + + (ert-info ("Second arg is exchange object") + (setq it (funcall mex '((0 i)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "foo bar baz"))) + + (ert-info ("One arg, multiple calls") + (setq it (funcall mex '((0 h)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "bar bazfoo bar baz"))) + + (ert-info ("Match data restored") + (setq it (funcall mex '((0 j)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "j")) + + (setq it (funcall mex '((0 g)))) + (should (equal (funcall it) 0)) + (should (equal (funcall 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") + (cons 'f (lambda (a) (funcall a :get-binding 'foo))) + (cons 'h (lambda (a) (upcase (funcall a :get-var 'foo)))) + (cons 'g (lambda (a) + (funcall a :rebind 'g (funcall a :get-var '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 :dialog dialog)) + (mex (apply-partially #'erc-d-tests--new-ex exchange)) + it) + + (erc-d-exchange-reload dialog exchange) + + (ert-info ("Initial reference calls function") + (setq it (funcall mex '((0 j) (0 j)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "abc"))) + + (ert-info ("Subsequent reference expands to string") + (should (equal (funcall it) 0)) + (should (equal (funcall it) "123"))) + + (ert-info ("Outside manipulation: initial reference calls function") + (setq it (funcall mex '((0 k) (0 k)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "abc"))) + + (ert-info ("Outside manipulation: subsequent reference expands to string") + (erc-d-exchange-rebind dialog exchange 'k "123") + (should (equal (funcall it) 0)) + (should (equal (funcall it) "123"))) + + (ert-info ("Swap one function for another") + (setq it (funcall mex '((0 g) (0 g)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "bar")) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "foo"))) + + (ert-info ("Bindings accessible inside functions") + (setq it (funcall mex '((0 f h)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "fooFOO"))) + + (ert-info ("Rebuild alist by sending flag") + (setq it (funcall mex '((0 f) (1 f) (2 f) (i 3 f)))) + (should (equal (funcall it) 0)) + (should (equal (funcall it) "foo")) + (erc-d-exchange-rebind dialog exchange 'f "bar") + (should (equal (funcall it) 1)) + (should (equal (funcall it) "bar")) + (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) + (lambda nil "baz"))) + (should (eq (funcall it) 2)) + (should (equal (funcall it 'reload) "baz")) + (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) "spam")) + (should (eq (funcall it) 'i)) + (should (eq (funcall it 'reload) 3)) + (should (equal (funcall 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*"))) + +(ert-deftest erc-d-t-wait-for () + :tags '(:unstable) + (let (v) + (run-at-time 0.2 nil (lambda () (setq v t))) + (should (erc-d-t-wait-for 0.4 "result becomes non-nil" v)) + (should-error (erc-d-t-wait-for 0.4 "result stays nil" (not v))) + (setq v nil) + (should-not (erc-d-t-wait-for -0.4 "inverted stays nil" v)) + (run-at-time 0.2 nil (lambda () (setq v t))) + (setq v nil) + (should-error (erc-d-t-wait-for -0.4 "inverted becomes non-nil" v)))) + +(defvar erc-d-tests-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-tests-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-tests-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-tests-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 + (let ((ad (lambda (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) + (dolist (sym ,func-syms) + (advice-remove sym 'spy)) + (setq ,found (nreverse ,found)))) + +(ert-deftest erc-d-run-nonstandard-messages () + :tags '(:expensive-test) + (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)) + 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" eol)) + (funcall expect 1 '(regex "<- 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 '(regex "<- nonstandard:[[:digit:]]+ $")))) + (ert-info ("Server preserves spaces") + (process-send-string client " \r\n") + (with-current-buffer dumb-server-buffer + (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{2\\}$"))) + (process-send-string client " \r\n") + (with-current-buffer dumb-server-buffer + (funcall expect 1 '(regex "<- 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 () + :tags '(:expensive-test) + (erc-d-tests-with-server (_ _) basic + (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan")) + (erc-d-t-search-for 2 "hey")) + (when noninteractive + (kill-buffer "#chan")))) + +(ert-deftest erc-d-run-eof () + :tags '(:expensive-test) + (skip-unless noninteractive) + (erc-d-tests-with-server (_ erc-s-buf) eof + (with-current-buffer (erc-d-t-wait-for 3 (get-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 () + :tags '(:expensive-test) + (let (errors) + (erc-d-tests-with-failure-spy errors '(erc-d--teardown) + (erc-d-tests-with-server (_ _) eof + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (erc-d-t-search-for 2 "hey")) + (erc-d-t-wait-for 10 errors))) + (should (string-match-p "Timed out awaiting request.*__EOF__" + (cadr (pop errors)))))) + +(ert-deftest erc-d-run-linger () + :tags '(:unstable :expensive-test) + (erc-d-tests-with-server (dumb-s _) linger + (with-current-buffer (erc-d-t-wait-for 6 (get-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 3 "Lingered for 1.00 seconds")))) + +(ert-deftest erc-d-run-linger-fail () + :tags '(:unstable :expensive-test) + (let ((erc-server-flood-penalty 0.1) + errors) + (erc-d-tests-with-failure-spy + errors '(erc-d--teardown erc-d-command) + (erc-d-tests-with-server (_ _) linger + (with-current-buffer (erc-d-t-wait-for 5 (get-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 () + :tags '(:unstable :expensive-test) + (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 () + :tags '(:unstable) + (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 () + :tags '(:expensive-test) + (let ((erc-d-linger-secs 1) + erc-server-auto-reconnect + errors) + (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command) + (erc-d-tests-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 () + :tags '(:expensive-test) + (let ((erc-d-linger-secs 1) + err errors) + (erc-d-tests-with-failure-spy errors '(erc-d--teardown) + (erc-d-tests-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 () + :tags '(:expensive-test) + (let ((erc-d-linger-secs 2) + errors) + (erc-d-tests-with-failure-spy + errors '(erc-d--teardown erc-d-command) + (erc-d-tests-with-server (_ _) unexpected + (ert-info ("All specs consumed when more input arrives") + (erc-d-t-wait-for 10 "error caught" (cdr 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 () + :tags '(:expensive-test) + (let ((erc-d-linger-secs 3) + errors) + (erc-d-tests-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 "open from")) + (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) + (when (process-live-p client-proc) + (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-tests--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-tests--run-dynamic () + "Perform common assertions for \"dynamic\" dialog." + (erc-d-tests-with-server (dumb-server erc-server-buffer) dynamic + (with-current-buffer (erc-d-t-wait-for 10 (get-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 () + :tags '(:expensive-test) + (let* (dynamic-tally + (erc-d-tmpl-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-tests--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-tests--run-dynamic) + (should (equal '((dom . match-user) (nick . match-user) (dom . match-user)) + dynamic-tally)))) + +(ert-deftest erc-d-run-dynamic-default-match-rebind () + :tags '(:expensive-test) + (let* (tally + ;; + (erc-d-tmpl-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-tests--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-tests--run-dynamic) + (should (equal '(bind-nick bind-dom) tally)))) + +(ert-deftest erc-d-run-dynamic-runtime-stub () + :tags '(:expensive-test) + (let ((erc-d-tmpl-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-tests-with-server-password "foonet:changeme")) + (erc-d-tests-with-server (_ erc-server-buffer) + (dynamic-stub dynamic-foonet) + (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan")) + (erc-d-t-search-for 2 "alice:") + (erc-d-t-absent-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 () + :tags '(:expensive-test) + (let ((erc-d-tmpl-vars '((token . "barnet"))) + (erc-d-match-handlers + (list :pass (lambda (d _e) + (erc-d-load-replacement-dialog + d 'dynamic-barnet 1)))) + (erc-d-tests-with-server-password "barnet:changeme")) + (erc-d-tests-with-server (_ erc-server-buffer) + (dynamic-stub dynamic-barnet) + (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan")) + (erc-d-t-search-for 2 "joe:") + (erc-d-t-absent-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"))))) + +;; Two servers, in-process, one client per +(ert-deftest erc-d-run-dual-direct () + :tags '(:expensive-test) + (let* ((erc-d--slow-mo -1) + (server-a (erc-d-run "localhost" t "erc-d-server-a" 'dynamic-foonet)) + (server-b (erc-d-run "localhost" t "erc-d-server-b" 'dynamic-barnet)) + (server-a-buffer (get-buffer "*erc-d-server-a*")) + (server-b-buffer (get-buffer "*erc-d-server-b*")) + (client-a-buffer (get-buffer-create "*erc-d-client-a*")) + (client-b-buffer (get-buffer-create "*erc-d-client-b*")) + client-a client-b) + (with-current-buffer server-a-buffer (erc-d-t-search-for 4 "Starting")) + (with-current-buffer server-b-buffer (erc-d-t-search-for 4 "Starting")) + (setq client-a (make-network-process + :buffer client-a-buffer + :name "erc-d-client-a" + :family 'ipv4 + :noquery t + :coding 'binary + :service (process-contact server-a :service) + :host "localhost") + client-b (make-network-process + :buffer client-b-buffer + :name "erc-d-client-b" + :family 'ipv4 + :noquery t + :coding 'binary + :service (process-contact server-b :service) + :host "localhost")) + ;; Also tests slo-mo indirectly because FAKE would fail without it + (process-send-string client-a "NICK tester\r\n") + (process-send-string client-b "FAKE noop\r\nNICK tester\r\n") + (sleep-for 0.01) + (process-send-string client-a "USER user 0 * :tester\r\n") + (process-send-string client-b "USER user 0 * :tester\r\n") + (sleep-for 0.01) + (process-send-string client-a "MODE tester +i\r\n") + (process-send-string client-b "MODE tester +i\r\n") + (sleep-for 0.01) + (process-send-string client-a "MODE #chan\r\n") + (process-send-string client-b "MODE #chan\r\n") + (sleep-for 0.01) + (erc-d-t-wait-for 2 "server-a death" (not (process-live-p server-a))) + (erc-d-t-wait-for 2 "server-b death" (not (process-live-p server-b))) + (when noninteractive + (kill-buffer client-a-buffer) + (kill-buffer client-b-buffer) + (kill-buffer server-a-buffer) + (kill-buffer server-b-buffer)))) + +;; This can be removed; only exists to get a baseline for next test +(ert-deftest erc-d-run-fuzzy-direct () + :tags '(:expensive-test) + (let* ((erc-d-tmpl-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 comparable to direct ^. +(ert-deftest erc-d-run-fuzzy () + :tags '(:expensive-test) + (let ((erc-server-flood-penalty 1.2) ; penalty < margin/sends is basically 0 + (erc-d-linger-secs 0.1) + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + erc-server-auto-reconnect) + (erc-d-tests-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 (get-buffer "#bar")) + (with-current-buffer erc-server-buffer + (erc-cmd-JOIN "#foo")) + (erc-d-t-wait-for 20 (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 () + :tags '(:expensive-test) + (let ((erc-server-flood-penalty 1) + (erc-d-linger-secs 1.2) + (expect (erc-d-t-make-expecter)) + erc-server-auto-reconnect) + (erc-d-tests-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"))) + (with-current-buffer (erc-d-t-wait-for 2 (get-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 (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, I will ")) + (with-current-buffer "#bar" (funcall expect 1 "hi 123")) + (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-tests--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 "open from")) + (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-tmpl-vars' before +;; starting the server. + +(ert-deftest erc-d-run-proxy-direct-spec-vars () + :tags '(:expensive-test) + (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*")) + (erc-d-linger-secs 0.5) + (erc-d-tmpl-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-tests--run-proxy-direct dumb-server dumb-server-buffer port))) + +(cl-defun erc-d-tests--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 () + :tags '(:expensive-test) + (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-tmpl-vars '((fqdn . ,fqdn) + (net . ,net) + (network . (group (+ alpha)))))) + (port (erc-d-tests--start-server + :linger 0.3 + :program program + :buffer buffer + :dialogs '(proxy-foonet proxy-barnet))) + (server (pop port))) + (erc-d-tests--run-proxy-direct server buffer port))) + +(ert-deftest erc-d-run-proxy-direct-subprocess-lib () + :tags '(:expensive-test) + (let* ((buffer (get-buffer-create "*erc-d-server*")) + (lib (expand-file-name "proxy-subprocess.el" + (ert-resource-directory))) + (port (erc-d-tests--start-server :linger 0.3 + :buffer buffer + :dialogs '(proxy-foonet proxy-barnet) + :libs (list lib))) + (server (pop port))) + (erc-d-tests--run-proxy-direct server buffer port))) + +(ert-deftest erc-d-run-no-pong () + :tags '(:expensive-test) + (let* (erc-d-auto-pong + ;; + (erc-d-tmpl-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 "open from")) + (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 () + :tags '(:expensive-test) + (let ((erc-server-flood-penalty 0) + (expect (erc-d-t-make-expecter)) + erc-d-linger-secs) + (erc-d-tests-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")) + (with-current-buffer (erc-d-t-wait-for 1 (get-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 () + :tags '(:expensive-test) + (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)))) + +(ert-deftest erc-d-run-direct-foreign-protocol () + :tags '(:expensive-test) + (let* ((server (erc-d-run "localhost" t "erc-d-server" 'foreign + :ending "\n")) + (server-buffer (get-buffer "*erc-d-server*")) + (client-buffer (get-buffer-create "*erc-d-client*")) + client) + (with-current-buffer server-buffer (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 server :service) + :host "localhost")) + (process-send-string client "ONE one\n") + (with-current-buffer client-buffer + (erc-d-t-search-for 5 "echo ONE one")) + (process-send-string client "TWO two\n") + (with-current-buffer client-buffer + (erc-d-t-search-for 2 "echo TWO two")) + (erc-d-t-wait-for 2 "server death" (not (process-live-p server))) + (when noninteractive + (kill-buffer client-buffer) + (kill-buffer server-buffer)))) + +;;; erc-d-tests.el ends here |