diff options
Diffstat (limited to 'test')
120 files changed, 4007 insertions, 965 deletions
diff --git a/test/Makefile.in b/test/Makefile.in index 720f5c7ff8c..3cbdbec4414 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -92,6 +92,10 @@ export TEST_LOAD_EL ?= \ # Additional settings for ert. ert_opts = +# Supply a path to local tree-sitter installations, as we run tests +# without a valid HOME. +ert_opts += --eval "(setq treesit-extra-load-path '(\"$(HOME)/.emacs.d/tree-sitter\"))" + # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). TEST_BACKTRACE_LINE_LENGTH = diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 8e583fade9f..d79072b06b5 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -126,7 +126,7 @@ RUN src/emacs -Q --batch \ (java "https://github.com/tree-sitter/tree-sitter-java") \ (javascript "https://github.com/tree-sitter/tree-sitter-javascript") \ (json "https://github.com/tree-sitter/tree-sitter-json") \ - (lua "https://github.com/MunifTanjim/tree-sitter-lua") \ + (lua "https://github.com/tree-sitter-grammars/tree-sitter-lua") \ (python "https://github.com/tree-sitter/tree-sitter-python") \ (ruby "https://github.com/tree-sitter/tree-sitter-ruby") \ (tsx "https://github.com/tree-sitter/tree-sitter-typescript" "master" "tsx/src") \ diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index bfdfac8be1b..cdd1a7832d3 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -57,12 +57,10 @@ (ert-deftest abbrev-make-abbrev-table-test () ;; Table without properties: (let ((table (make-abbrev-table))) - (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size))) + (should (abbrev-table-p table))) ;; Table with one property 'foo with value 'bar: (let ((table (make-abbrev-table '(foo bar)))) (should (abbrev-table-p table)) - (should (= (length table) obarray-default-size)) (should (eq (abbrev-table-get table 'foo) 'bar)))) (ert-deftest abbrev--table-symbols-test () diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 5452501b861..c091a7dd060 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -33,8 +33,8 @@ (require 'secrets) (defun auth-source-ensure-ignored-backend (source) - (auth-source-validate-backend source '((:source . "") - (:type . ignore)))) + (auth-source-validate-backend source '((source . "") + (type . ignore)))) (defun auth-source-validate-backend (source validation-alist) (let ((backend (auth-source-backend-parse source))) @@ -44,84 +44,101 @@ (ert-deftest auth-source-backend-parse-macos-keychain () (auth-source-validate-backend '(:source (:macos-keychain-generic foobar)) - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function . auth-source-macos-keychain-search) + (create-function . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-string () (auth-source-validate-backend "macos-keychain-generic:foobar" - '((:source . "foobar") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-string () (auth-source-validate-backend "macos-keychain-internet:foobar" - '((:source . "foobar") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "foobar") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol () (auth-source-validate-backend 'macos-keychain-generic - '((:source . "default") - (:type . macos-keychain-generic) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-generic) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string () (auth-source-validate-backend 'macos-keychain-internet - '((:source . "default") - (:type . macos-keychain-internet) - (:search-function . auth-source-macos-keychain-search) - (:create-function . auth-source-macos-keychain-create)))) + '((source . "default") + (type . macos-keychain-internet) + (search-function + . auth-source-macos-keychain-search) + (create-function + . auth-source-macos-keychain-create)))) (ert-deftest auth-source-backend-parse-plstore () (auth-source-validate-backend '(:source "foo.plist") - '((:source . "foo.plist") - (:type . plstore) - (:search-function . auth-source-plstore-search) - (:create-function . auth-source-plstore-create)))) + '((source . "foo.plist") + (type . plstore) + (search-function . auth-source-plstore-search) + (create-function + . auth-source-plstore-create)))) (ert-deftest auth-source-backend-parse-netrc () (auth-source-validate-backend '(:source "foo") - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-netrc-string () (auth-source-validate-backend "foo" - '((:source . "foo") - (:type . netrc) - (:search-function . auth-source-netrc-search) - (:create-function . auth-source-netrc-create)))) + '((source . "foo") + (type . netrc) + (search-function . auth-source-netrc-search) + (create-function + . auth-source-netrc-create)))) (ert-deftest auth-source-backend-parse-secrets () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend '(:source (:secrets "foo")) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-strings () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) (auth-source-validate-backend "secrets:foo" - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create))))) (ert-deftest auth-source-backend-parse-secrets-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -129,10 +146,12 @@ ;; Redefine `secrets-get-alias' to map 'foo to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-symbol () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -140,10 +159,12 @@ ;; Redefine `secrets-get-alias' to map 'default to "foo" (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo"))) (auth-source-validate-backend 'default - '((:source . "foo") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "foo") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-secrets-no-alias () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -152,10 +173,12 @@ ;; "Login" is used by default (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil))) (auth-source-validate-backend '(:source (:secrets foo)) - '((:source . "Login") - (:type . secrets) - (:search-function . auth-source-secrets-search) - (:create-function . auth-source-secrets-create)))))) + '((source . "Login") + (type . secrets) + (search-function + . auth-source-secrets-search) + (create-function + . auth-source-secrets-create)))))) (ert-deftest auth-source-backend-parse-invalid-or-nil-source () (provide 'secrets) ; simulates the presence of the `secrets' package @@ -411,7 +434,7 @@ machine c1 port c2 user c3 password c4\n" ;; this is actually the same as `auth-source-search'. (should (equal found expected))))) -(ert-deftest test-netrc-credentials () +(ert-deftest auth-source-test-netrc-credentials () (let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo")))) (should data) (let ((imap (seq-find (lambda (elem) @@ -427,7 +450,7 @@ machine c1 port c2 user c3 password c4\n" (should (equal (cdr (assoc "login" imap)) "jrh")) (should (equal (cdr (assoc "password" imap)) "*baz*"))))) -(ert-deftest test-netrc-credentials-2 () +(ert-deftest auth-source-test-netrc-credentials-2 () (let ((data (auth-source-netrc-parse-all (ert-resource-file "netrc-folding")))) (should @@ -435,25 +458,33 @@ machine c1 port c2 user c3 password c4\n" '((("machine" . "XM") ("login" . "XL") ("password" . "XP")) (("machine" . "YM") ("login" . "YL") ("password" . "YP"))))))) -(ert-deftest test-macos-keychain-search () +(ert-deftest auth-source-test-macos-keychain-search () "Test if the constructed command line arglist is correct." (let ((auth-sources '(macos-keychain-internet macos-keychain-generic))) ;; Redefine `call-process' to check command line arguments. (cl-letf (((symbol-function 'call-process) (lambda (_program _infile _destination _display &rest args) - ;; Arguments must be all strings + ;; Arguments must be all strings. (should (cl-every #'stringp args)) - ;; Argument number should be even + ;; Argument number should be even. (should (cl-evenp (length args))) - (should (cond ((string= (car args) "find-internet-password") - (let ((protocol (cl-member "-r" args :test #'string=))) - (if protocol - (= 4 (length (cadr protocol))) - t))) - ((string= (car args) "find-generic-password") - t)))))) - (auth-source-search :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https"))))) + (should + (cond + ((string= (car args) "find-internet-password") + (let ((protocol-r (cl-member "-r" args :test #'string=)) + (protocol-P (cl-member "-P" args :test #'string=))) + (cond (protocol-r + (= 4 (length (cadr protocol-r)))) + (protocol-P + (string-match-p + "\\`[[:digit:]]+\\'" (cadr protocol-P))) + (t)))) + ((string= (car args) "find-generic-password") + t)))))) + (auth-source-search + :user '("a" "b") :host '("example.org") + :port '("irc" "ftp" "https" 123))))) (provide 'auth-source-tests) ;;; auth-source-tests.el ends here diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index a44a5898055..b64c1682efe 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -734,6 +734,31 @@ An existing calc stack is reused, otherwise a new one is created." (var c var-c)))))) (calc-set-language nil))) +(ert-deftest calc-frac-input () + ;; precomposed fraction + (should (equal (math-read-expr "Ā½") + '(frac 1 2))) + ;; ascii solidus + (should (equal (math-read-expr "123/456") + '(/ 123 456))) + (should (equal (math-read-expr "a/b") + '(/ (var a var-a) (var b var-b)))) + ;; fraction slash + (should (equal (math-read-expr "123ā456") + '(frac 41 152))) + (should (equal (math-read-expr "aāb") + '(error 1 "Syntax error"))) + ;; division slash + (should (equal (math-read-expr "123ā456") + '(/ 123 456))) + (should (equal (math-read-expr "aāb") + '(/ (var a var-a) (var b var-b)))) + ;; division sign + (should (equal (math-read-expr "123Ć·456") + '(frac 41 152))) + (should (equal (math-read-expr "aĆ·b") ; I think this one is wrong + '(error 1 "Syntax error")))) + (defvar var-g) ;; Test `let'. @@ -836,7 +861,7 @@ An existing calc stack is reused, otherwise a new one is created." ;; exponent/subscript (should (string= (concat "+/-*:-/*inf<=>=<=>=Ī¼(1:4)(1:2)(3:4)(1:3)(2:3)" "(1:5)(2:5)(3:5)(4:5)(1:6)(5:6)" - "(1:8)(3:8)(5:8)(7:8)1:^(0123456789+-()ni)" + "(1:8)(3:8)(5:8)(7:8)1::^(0123456789+-()ni)" "_(0123456789+-())") (math-read-preprocess-string (mapconcat #'car math-read-replacement-list)))) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 7d3af25ea49..39ad735a789 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -68,7 +68,7 @@ (with-temp-buffer (insert diary-string) (icalendar-export-region (point-min) (point-max) file)) - (with-current-buffer (get-buffer "*icalendar-errors*") + (with-current-buffer "*icalendar-errors*" (buffer-string)))) ;; ====================================================================== diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 190764e9125..5b2c28bd3dd 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -181,4 +181,19 @@ instead." (completion-preview--post-command)) (completion-preview-tests--check-preview "barbaz" 'exact))) +(ert-deftest completion-preview-mid-symbol-cycle () + "Test cycling the completion preview with point at the middle of a symbol." + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar" "foobaz")))) + (insert "fooba") + (forward-char -2) + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "r") + (completion-preview-next-candidate 1) + (completion-preview-tests--check-preview "z"))) + ;;; completion-preview-tests.el ends here diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 8cbfb9ad9df..a4e913541bf 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -209,6 +209,16 @@ child results in an error." (dom-pp node t) (should (equal (buffer-string) "(\"foo\" nil)"))))) +(ert-deftest dom-tests-print () + "Test that `dom-print' correctly encodes HTML reserved characters." + (with-temp-buffer + (dom-print '(samp ((class . "samp")) "<div class=\"default\"> </div>")) + (should (equal + (buffer-string) + (concat "<samp class=\"samp\">" + "<div class="default"> </div>" + "</samp>"))))) + (ert-deftest dom-test-search () (let ((dom '(a nil (b nil (c nil))))) (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a))) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el index 94b0e80c979..571f7f6f095 100644 --- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el @@ -1,3 +1,4 @@ ;;; -*- lexical-binding: t -*- (defun foo () - "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + nil) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 293d3025420..26408e8685a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -800,6 +800,9 @@ inner loops respectively." ;; Aristotelian identity optimization (let ((x (bytecomp-test-identity 1))) (list (eq x x) (eql x x) (equal x x))) + + ;; Legacy single-arg `apply' call + (apply '(* 2 3)) ) "List of expressions for cross-testing interpreted and compiled code.") @@ -848,6 +851,22 @@ byte-compiled. Run with dynamic binding." (should (equal (bytecomp-tests--eval-interpreted form) (bytecomp-tests--eval-compiled form))))))) +(ert-deftest bytecomp--fun-value-as-head () + ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931). + ;; (There is also a warning but this test does not check that.) + (dolist (lb '(nil t)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let* ((lexical-binding lb) + (s-int '(lambda (x) (1+ x))) + (s-comp (byte-compile s-int)) + (v-int (lambda (x) (1+ x))) + (v-comp (byte-compile v-int)) + (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3))))))) + (should (equal (funcall comp s-int) 4)) + (should (equal (funcall comp s-comp) 4)) + (should (equal (funcall comp v-int) 4)) + (should (equal (funcall comp v-comp) 4)))))) + (defmacro bytecomp-tests--with-fresh-warnings (&rest body) `(let ((macroexp--warned ; oh dear (make-hash-table :test #'equal :weakness 'key))) @@ -2087,18 +2106,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (defun bytecomp-tests--error-frame (fun args) "Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)." - (let* ((debugger - (lambda (&rest args) - ;; Make sure Emacs doesn't think our debugger is buggy. - (cl-incf num-nonmacro-input-events) - (throw 'bytecomp-tests--backtrace - (cons args (cadr (backtrace-get-frames debugger)))))) - (debug-on-error t) - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - (debug-ignored-errors nil)) + (letrec ((handler (lambda (e) + (throw 'bytecomp-tests--backtrace + (cons e (cadr (backtrace-get-frames handler))))))) (catch 'bytecomp-tests--backtrace - (apply fun args)))) + (handler-bind ((error handler)) + (apply fun args))))) (defconst bytecomp-tests--byte-op-error-cases '(((car a) (wrong-type-argument listp a)) @@ -2143,7 +2156,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ `(lambda ,formals (,fun-sym ,@formals))))))) (error-frame (bytecomp-tests--error-frame fun actuals))) (should (consp error-frame)) - (should (equal (car error-frame) (list 'error expected-error))) + (should (equal (car error-frame) expected-error)) (let ((frame (cdr error-frame))) (should (equal (type-of frame) 'backtrace-frame)) (should (equal (cons (backtrace-frame-fun frame) diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 086ac399352..1241d28ab74 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -319,5 +319,18 @@ Edebug symbols (Bug#42672)." (and (eq 'error (car err)) (string-match "Stray.*declare" (cadr err))))))) +(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4))) + (+ function 1)) + +(ert-deftest cl-generic-tests--print-quoted () + (with-temp-buffer + (cl--generic-describe 'cl-generic-tests--print-quoted-method) + (goto-char (point-min)) + ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4) + (should-not (re-search-forward "#'" nil t)) + (goto-char (point-min)) + ;; But we don't want (eql '4) to turn into (eql (quote 4)) either. + (should (re-search-forward "(eql '4)" nil t)))) + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index fb1770f1f4a..b823a190d5a 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -29,218 +29,211 @@ (require 'cl-lib) (require 'comp-cstr) -(cl-eval-when (compile eval load) - - (defun comp-cstr-test-ts (type-spec) - "Create a constraint from TYPE-SPEC and convert it back to type specifier." - (let ((comp-ctxt (make-comp-cstr-ctxt))) - (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) - - (defun comp-cstr-typespec-test (number type-spec expected-type-spec) - `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) () - (should (equal (comp-cstr-test-ts ',type-spec) - ',expected-type-spec)))) - - (defconst comp-cstr-typespec-tests-alist - '(;; 1 - (symbol . symbol) - ;; 2 - ((or string array) . array) - ;; 3 - ((or symbol number) . (or number symbol)) - ;; 4 - ((or cons atom) . t) ;; SBCL return T - ;; 5 - ((or integer number) . number) - ;; 6 - ((or (or integer symbol) number) . (or number symbol)) - ;; 7 - ((or (or integer symbol) (or number list)) . (or list number symbol)) - ;; 8 - ((or (or integer number) nil) . number) - ;; 9 - ((member foo) . (member foo)) - ;; 10 - ((member foo bar) . (member bar foo)) - ;; 11 - ((or (member foo) (member bar)) . (member bar foo)) - ;; 12 - ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) - ;; 13 - ((or (member foo) number) . (or (member foo) number)) - ;; 14 - ((or (integer 1 3) number) . number) - ;; 15 - (integer . integer) - ;; 16 - ((integer 1 2) . (integer 1 2)) - ;; 17 - ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) - ;; 18 - ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) - ;; 19 - ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) - ;; 20 - ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) - ;; 21 - ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) - ;; 22 - ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) - ;; 23 - ((or (integer -1 2) (integer * 4)) . (integer * 4)) - ;; 24 - ((and string array) . string) - ;; 25 - ((and cons atom) . nil) - ;; 26 - ((and (member foo) (member foo bar baz)) . (member foo)) - ;; 27 - ((and (member foo) (member bar)) . nil) - ;; 28 - ((and (member foo) symbol) . (member foo)) - ;; 29 - ((and (member foo) string) . nil) - ;; 30 - ((and (member foo) (integer 1 2)) . nil) - ;; 31 - ((and (member 1 2) (member 3 2)) . (integer 2 2)) - ;; 32 - ((and number (integer 1 2)) . (integer 1 2)) - ;; 33 - ((and integer (integer 1 2)) . (integer 1 2)) - ;; 34 - ((and (integer -1 0) (integer 3 5)) . nil) - ;; 35 - ((and (integer -1 2) (integer 3 5)) . nil) - ;; 36 - ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) - ;; 37 - ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) - ;; 38 - ((and (integer -1 5) nil) . nil) - ;; 39 - ((not symbol) . (not symbol)) - ;; 40 - ((or (member foo) (not (member foo bar))) . (not (member bar))) - ;; 41 - ((or (member foo bar) (not (member foo))) . t) - ;; 42 - ((or symbol (not sequence)) . (not sequence)) - ;; 43 - ((or symbol (not symbol)) . t) - ;; 44 - ((or symbol (not sequence)) . (not sequence)) - ;; 45 Conservative. - ((or vector (not sequence)) . t) - ;; 46 - ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 47 - ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) - ;; 48 - ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) - ;; 49 - ((or symbol (not (member foo))) . (not (member foo))) - ;; 50 - ((or (not symbol) (not (member foo))) . (not symbol)) - ;; 51 Conservative. - ((or (not (member foo)) string) . (not (member foo))) - ;; 52 Conservative. - ((or (member foo) (not string)) . (not string)) - ;; 53 - ((or (not (integer 1 2)) integer) . t) - ;; 54 - ((or (not (integer 1 2)) (not integer)) . (not integer)) - ;; 55 - ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) - ;; 56 - ((or number (not (integer 1 2))) . t) - ;; 57 - ((or atom (not (integer 1 2))) . t) - ;; 58 - ((or atom (not (member foo))) . t) - ;; 59 - ((and symbol (not cons)) . symbol) - ;; 60 - ((and symbol (not symbol)) . nil) - ;; 61 - ((and atom (not symbol)) . atom) - ;; 62 - ((and atom (not string)) . (or array sequence atom)) - ;; 63 Conservative - ((and symbol (not (member foo))) . symbol) - ;; 64 Conservative - ((and symbol (not (member 3))) . symbol) - ;; 65 - ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) - ;; 66 - ((and (member foo) (not (integer 1 10))) . (member foo)) - ;; 67 - ((and t (not (member foo))) . (not (member foo))) - ;; 68 - ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) - ;; 69 - ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) - ;; 70 - ((and (not (member a)) (not (member b))) . (not (member a b))) - ;; 71 - ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) - ;; 72 - ((and t (integer 1 1)) . (integer 1 1)) - ;; 73 - ((not (integer -1 5)) . (not (integer -1 5))) - ;; 74 - ((and boolean (or number marker)) . nil) - ;; 75 - ((and atom (or number marker)) . number-or-marker) - ;; 76 - ((and symbol (or number marker)) . nil) - ;; 77 - ((and (or symbol string) (or number marker)) . nil) - ;; 78 - ((and t t) . t) - ;; 79 - ((and (or marker number) (integer 0 0)) . (integer 0 0)) - ;; 80 - ((and t (not t)) . nil) - ;; 81 - ((or (integer 1 1) (not (integer 1 1))) . t) - ;; 82 - ((not t) . nil) - ;; 83 - ((not nil) . t) - ;; 84 - ((or (not string) t) . t) - ;; 85 - ((or (not vector) sequence) . sequence) - ;; 86 - ((or (not symbol) null) . t) - ;; 87 - ((and (or null integer) (not (or null integer))) . nil) - ;; 88 - ((and (or (member a b c)) (not (or (member a b)))) . (member c)) - ;; 89 - ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'? - ;; 90 - ((or string char-table bool-vector vector) . array) - ;; 91 - ((or string char-table bool-vector vector number) . (or array number)) - ;; 92 - ((or string char-table bool-vector vector cons symbol number) . - (or number sequence symbol)) - ;; 93? - ;; FIXME: I get `cons' rather than `list'? - ;;((or null cons) . list) - ) - "Alist type specifier -> expected type specifier.")) - -(defmacro comp-cstr-synthesize-tests () - "Generate all tests from `comp-cstr-typespec-tests-alist'." +(defun comp-cstr-test-ts (type-spec) + "Create a constraint from TYPE-SPEC and convert it back to type specifier." + (let ((comp-ctxt (make-comp-cstr-ctxt))) + (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec)))) + +(defmacro comp-cstr-synthesize-tests (typespec-tests-alist) + "Generate all tests from TYPESPEC-TESTS-ALIST. +The arg is an alist of: type specifier -> expected type specifier." `(progn ,@(cl-loop for i from 1 - for (ts . exp-ts) in comp-cstr-typespec-tests-alist - append (list (comp-cstr-typespec-test i ts exp-ts))))) - -(comp-cstr-synthesize-tests) + for (type-spec . expected-type-spec) in typespec-tests-alist + collect + `(ert-deftest ,(intern (format "comp-cstr-test-%d" i)) () + (should (equal (comp-cstr-test-ts ',type-spec) + ',expected-type-spec)))))) + +(comp-cstr-synthesize-tests + (;; 1 + (symbol . symbol) + ;; 2 + ((or string array) . array) + ;; 3 + ((or symbol number) . (or number symbol)) + ;; 4 + ((or cons atom) . t) ;; Like SBCL + ;; 5 + ((or integer number) . number) + ;; 6 + ((or (or integer symbol) number) . (or number symbol)) + ;; 7 + ((or (or integer symbol) (or number list)) . (or list number symbol)) + ;; 8 + ((or (or integer number) nil) . number) + ;; 9 + ((member foo) . (member foo)) + ;; 10 + ((member foo bar) . (member bar foo)) + ;; 11 + ((or (member foo) (member bar)) . (member bar foo)) + ;; 12 + ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO)) + ;; 13 + ((or (member foo) number) . (or (member foo) number)) + ;; 14 + ((or (integer 1 3) number) . number) + ;; 15 + (integer . integer) + ;; 16 + ((integer 1 2) . (integer 1 2)) + ;; 17 + ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4))) + ;; 18 + ((or (integer -1 2) (integer 3 4)) . (integer -1 4)) + ;; 19 + ((or (integer -1 3) (integer 3 4)) . (integer -1 4)) + ;; 20 + ((or (integer -1 4) (integer 3 4)) . (integer -1 4)) + ;; 21 + ((or (integer -1 5) (integer 3 4)) . (integer -1 5)) + ;; 22 + ((or (integer -1 *) (integer 3 4)) . (integer -1 *)) + ;; 23 + ((or (integer -1 2) (integer * 4)) . (integer * 4)) + ;; 24 + ((and string array) . string) + ;; 25 + ((and cons atom) . nil) + ;; 26 + ((and (member foo) (member foo bar baz)) . (member foo)) + ;; 27 + ((and (member foo) (member bar)) . nil) + ;; 28 + ((and (member foo) symbol) . (member foo)) + ;; 29 + ((and (member foo) string) . nil) + ;; 30 + ((and (member foo) (integer 1 2)) . nil) + ;; 31 + ((and (member 1 2) (member 3 2)) . (integer 2 2)) + ;; 32 + ((and number (integer 1 2)) . (integer 1 2)) + ;; 33 + ((and integer (integer 1 2)) . (integer 1 2)) + ;; 34 + ((and (integer -1 0) (integer 3 5)) . nil) + ;; 35 + ((and (integer -1 2) (integer 3 5)) . nil) + ;; 36 + ((and (integer -1 3) (integer 3 5)) . (integer 3 3)) + ;; 37 + ((and (integer -1 4) (integer 3 5)) . (integer 3 4)) + ;; 38 + ((and (integer -1 5) nil) . nil) + ;; 39 + ((not symbol) . (not symbol)) + ;; 40 + ((or (member foo) (not (member foo bar))) . (not (member bar))) + ;; 41 + ((or (member foo bar) (not (member foo))) . t) + ;; 42 + ((or symbol (not sequence)) . (not sequence)) + ;; 43 + ((or symbol (not symbol)) . t) + ;; 44 + ((or symbol (not sequence)) . (not sequence)) + ;; 45 Conservative. + ((or vector (not sequence)) . t) + ;; 46 + ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 47 + ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0))) + ;; 48 + ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0)))) + ;; 49 + ((or symbol (not (member foo))) . (not (member foo))) + ;; 50 + ((or (not symbol) (not (member foo))) . (not symbol)) + ;; 51 Conservative. + ((or (not (member foo)) string) . (not (member foo))) + ;; 52 Conservative. + ((or (member foo) (not string)) . (not string)) + ;; 53 + ((or (not (integer 1 2)) integer) . t) + ;; 54 + ((or (not (integer 1 2)) (not integer)) . (not integer)) + ;; 55 + ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *)))) + ;; 56 + ((or number (not (integer 1 2))) . t) + ;; 57 + ((or atom (not (integer 1 2))) . t) + ;; 58 + ((or atom (not (member foo))) . t) + ;; 59 + ((and symbol (not cons)) . symbol) + ;; 60 + ((and symbol (not symbol)) . nil) + ;; 61 + ((and atom (not symbol)) . atom) + ;; 62 Conservative FIXME + ((and atom (not string)) . (or array sequence atom)) + ;; 63 Conservative + ((and symbol (not (member foo))) . symbol) + ;; 64 Conservative + ((and symbol (not (member 3))) . symbol) + ;; 65 + ((and (not (member foo)) (integer 1 10)) . (integer 1 10)) + ;; 66 + ((and (member foo) (not (integer 1 10))) . (member foo)) + ;; 67 + ((and t (not (member foo))) . (not (member foo))) + ;; 68 + ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *))) + ;; 69 + ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20))) + ;; 70 + ((and (not (member a)) (not (member b))) . (not (member a b))) + ;; 71 + ((and (not boolean) (not (member b))) . (not (or (member b) boolean))) + ;; 72 + ((and t (integer 1 1)) . (integer 1 1)) + ;; 73 + ((not (integer -1 5)) . (not (integer -1 5))) + ;; 74 + ((and boolean (or number marker)) . nil) + ;; 75 + ((and atom (or number marker)) . number-or-marker) + ;; 76 + ((and symbol (or number marker)) . nil) + ;; 77 + ((and (or symbol string) (or number marker)) . nil) + ;; 78 + ((and t t) . t) + ;; 79 + ((and (or marker number) (integer 0 0)) . (integer 0 0)) + ;; 80 + ((and t (not t)) . nil) + ;; 81 + ((or (integer 1 1) (not (integer 1 1))) . t) + ;; 82 + ((not t) . nil) + ;; 83 + ((not nil) . t) + ;; 84 + ((or (not string) t) . t) + ;; 85 + ((or (not vector) sequence) . sequence) + ;; 86 + ((or (not symbol) null) . t) + ;; 87 + ((and (or null integer) (not (or null integer))) . nil) + ;; 88 + ((and (or (member a b c)) (not (or (member a b)))) . (member c)) + ;; 89 + ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'? + ;; 90 + ((or string char-table bool-vector vector) . array) + ;; 91 + ((or string char-table bool-vector vector number) . (or array number)) + ;; 92 + ((or string char-table bool-vector vector cons symbol number) . + (or number sequence symbol)) + ;; 93 + ((or list (not null)) . t) + )) ;;; comp-cstr-tests.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 8c0f729dc39..29adbcff947 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -860,8 +860,7 @@ test and possibly others should be updated." (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (insert "`1")) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun nil)) + (eval-defun nil) ;; `eval-defun' outputs its message to the echo area in a rather ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed ;; there in separate pieces (via `print' rather than via `message'). @@ -871,18 +870,21 @@ test and possibly others should be updated." (setq edebug-initial-mode 'go) ;; In Bug#23651 Edebug would hang reading `1. - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (edebug-eval-defun t)))) + (eval-defun t) + (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") + edebug-tests-messages)))) (ert-deftest edebug-tests-trivial-comma () "Edebug can read a trivial comma expression (Bug#23651)." (edebug-tests-with-normal-env - (read-only-mode -1) - (delete-region (point-min) (point-max)) - (insert ",1") - (read-only-mode) - (with-suppressed-warnings ((obsolete edebug-eval-defun)) - (should-error (edebug-eval-defun t))))) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert ",1")) + ;; FIXME: This currently signals a "Source has changed" error, which is + ;; itself a bug (the source hasn't changed). All we're testing here + ;; is that the Edebug gets past the step of reading the sexp. + (should-error (let ((eval-expression-debug-on-error nil)) + (eval-defun t))))) (ert-deftest edebug-tests-circular-read-syntax () "Edebug can instrument code using circular read object syntax (Bug#23660)." diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index b244a56779a..fb2c6ea3b68 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -259,7 +259,7 @@ (ans '( (:PRIMARY D) (:PRIMARY D-base1) - ;; (:PRIMARY D-base2) + (:PRIMARY D-base2) (:PRIMARY D-base0) ))) (eitest-F (D nil)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 83fc476c911..bc226757ff2 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -1011,24 +1011,24 @@ Subclasses to override slot attributes.")) (B (clone A :b "bb")) (C (clone B :a "aa"))) - (should (string= "aa" (oref C :a))) - (should (string= "bb" (oref C :b))) + (should (string= "aa" (oref C a))) + (should (string= "bb" (oref C b))) - (should (slot-boundp A :a)) - (should-not (slot-boundp A :b)) - (should-not (slot-boundp A :c)) + (should (slot-boundp A 'a)) + (should-not (slot-boundp A 'b)) + (should-not (slot-boundp A 'c)) - (should-not (slot-boundp B :a)) - (should (slot-boundp B :b)) - (should-not (slot-boundp A :c)) + (should-not (slot-boundp B 'a)) + (should (slot-boundp B 'b)) + (should-not (slot-boundp A 'c)) - (should (slot-boundp C :a)) - (should-not (slot-boundp C :b)) - (should-not (slot-boundp C :c)) + (should (slot-boundp C 'a)) + (should-not (slot-boundp C 'b)) + (should-not (slot-boundp C 'c)) - (should (eieio-instance-inheritor-slot-boundp C :a)) - (should (eieio-instance-inheritor-slot-boundp C :b)) - (should-not (eieio-instance-inheritor-slot-boundp C :c)))) + (should (eieio-instance-inheritor-slot-boundp C 'a)) + (should (eieio-instance-inheritor-slot-boundp C 'b)) + (should-not (eieio-instance-inheritor-slot-boundp C 'c)))) ;;;; Interaction with defstruct diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js new file mode 100644 index 00000000000..5eae9af212f --- /dev/null +++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js @@ -0,0 +1,2 @@ +var abc = function(d) { +}; diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el index e0ba1e949b2..fa2e5dc4db7 100644 --- a/test/lisp/emacs-lisp/ert-font-lock-tests.el +++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el @@ -138,13 +138,24 @@ print(\"Hello, world!\")" (forward-line) (should (ert-font-lock--line-comment-p)))) +(ert-deftest test-parse-comments--no-assertion-error () + (let* ((str " +not_an_assertion +random_symbol +")) + (with-temp-buffer + (insert str) + (javascript-mode) + + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) + (ert-deftest test-parse-comments--single-line-error () (let* ((str "// ^ face.face1")) (with-temp-buffer (insert str) (javascript-mode) - (should-error (ert-font-lock--parse-comments))))) + (should-error (ert-font-lock--parse-comments) :type 'user-error)))) (ert-deftest test-parse-comments--single-line-single-caret () (let* ((str " @@ -159,7 +170,46 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)))))) + +(ert-deftest test-parse-comments--single-line-many-carets () + (let* ((str " +multiplecarets +//^^^ ^^ ^ face.face1 +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 6)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil) + (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil))))))) + +(ert-deftest test-parse-comments--face-list () + (let* ((str " +facelist +// ^ (face1 face2) +// ^ !(face3 face4) +// ^ (face5) +") + asserts) + (with-temp-buffer + (insert str) + (javascript-mode) + + (setq asserts (ert-font-lock--parse-comments)) + (should (eql (length asserts) 3)) + (should (equal asserts + '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t) + (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil))))))) (ert-deftest test-parse-comments--caret-negation () (let* ((str " @@ -175,11 +225,11 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t) - (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t) + (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil))))))) -(ert-deftest test-parse-comments--single-line-multiple-carets () +(ert-deftest test-parse-comments--single-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -196,12 +246,12 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 4)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil) - (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil) + (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil))))))) -(ert-deftest test-parse-comments--multiple-line-multiple-carets () +(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines () (let* ((str " first // ^ face1 @@ -218,9 +268,9 @@ third (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil) - (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil) - (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil) + (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil) + (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--arrow-single-line-single () @@ -236,7 +286,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)))))) (ert-deftest test-parse-comments-arrow-multiple-line-single () @@ -254,9 +304,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil))))))) (ert-deftest test-parse-comments--non-assert-comment-single () (let* ((str " @@ -271,7 +321,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)))))) + '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--non-assert-comment-multiple () (let* ((str " @@ -288,9 +338,9 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 3)) (should (equal asserts - '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil) - (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil))))))) + '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil) + (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil) + (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil))))))) (ert-deftest test-parse-comments--multiline-comment-single () @@ -308,7 +358,7 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 1)) (should (equal (car asserts) - '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)))))) + '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)))))) (ert-deftest test-parse-comments--multiline-comment-multiple () (let* ((str " @@ -327,13 +377,47 @@ first (setq asserts (ert-font-lock--parse-comments)) (should (eql (length asserts) 2)) (should (equal asserts - '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil) - (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil))))))) + '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil) + (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil))))))) ;;; Syntax highlighting assertion tests ;; -(ert-deftest test-syntax-highlight-inline--caret-multiple-faces () +(ert-deftest test-syntax-highlight-inline--nil-list () + (let ((str " +var abc = function(d) { +// ^ nil +// ^ !nil +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--face-list () + (let ((str " +var abc = function(d) { +// ^ (test-face-2 test-face-1 font-lock-variable-name-face) +}; + +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (add-face-text-property (point-min) (point-max) 'test-face-1) + (add-face-text-property (point-min) (point-max) 'test-face-2) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) + +(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions () (let ((str " var abc = function(d) { // ^ font-lock-variable-name-face @@ -364,6 +448,19 @@ var abc = function(d) { (should-error (ert-font-lock--check-faces (ert-font-lock--parse-comments)))))) +(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face () + (let* ((str " +var abc = function(d) { +// ^ !not-a-face +}; +")) + (with-temp-buffer + (insert str) + (javascript-mode) + (font-lock-ensure) + + (ert-font-lock--check-faces + (ert-font-lock--parse-comments))))) (ert-deftest test-syntax-highlight-inline--comment-face () (let* ((str " @@ -455,6 +552,12 @@ var abc = function(d) { javascript-mode "correct.js") +(ert-font-lock-deftest-file test-macro-test--file-no-asserts + "Check failing on files without assertions" + :expected-result :failed + javascript-mode + "no-asserts.js") + (ert-font-lock-deftest-file test-macro-test--file-failing "Test reading wrong assertions from a file" :expected-result :failed diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 768a3a726aa..1aff73d66f6 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -1,6 +1,6 @@ ;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- -;; Copyright (C) 2007-2008, 2010-2024 Free Software Foundation, Inc. +;; Copyright (C) 2007-2024 Free Software Foundation, Inc. ;; Author: Christian Ohler <ohler@gnu.org> @@ -93,16 +93,6 @@ failed or if there was a problem." '(ert-test-failed "failure message")) t)))) -(ert-deftest ert-test-fail-debug-with-condition-case () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) - (ert-deftest ert-test-fail-debug-with-debugger-1 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (let ((debugger (lambda (&rest _args) @@ -146,16 +136,6 @@ failed or if there was a problem." '(error "Error message")) t)))) -(ert-deftest ert-test-error-debug () - (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(error "Error message")) t))))) - ;;; Test that `should' works. (ert-deftest ert-test-should () @@ -359,14 +339,10 @@ This macro is used to test if macroexpansion in `should' works." (,(lambda () (let ((_x t)) (should (error "Foo")))) (error "Foo"))) do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (let* ((test (make-ert-test :body body)) + (result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal (ert-test-failed-condition result) expected-condition))))) (defun ert-test--which-file () "Dummy function to help test `symbol-file' for tests.") @@ -392,9 +368,9 @@ This macro is used to test if macroexpansion in `should' works." (result (ert-run-test test))) (should (ert-test-failed-p result)) (should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) - ;;; This is `ert-fail' on nativecomp and `signal' - ;;; otherwise. It's not clear whether that's a bug - ;;; or not (bug#51308). + ;; This is `ert-fail' on nativecomp and `signal' + ;; otherwise. It's not clear whether that's a bug + ;; or not (bug#51308). '(ert-fail signal))))) (ert-deftest ert-test-messages () @@ -880,7 +856,6 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-with-demoted-errors () "Check that ERT correctly handles `with-demoted-errors'." - :expected-result :failed ;; FIXME! Bug#11218 (should-not (with-demoted-errors "FOO: %S" (error "Foo")))) (ert-deftest ert-test-fail-inside-should () diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el index 97a0f7ba52c..3333f4014e6 100644 --- a/test/lisp/emacs-lisp/hierarchy-tests.el +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -570,8 +570,9 @@ should fail as this function will crash." (defun hierarchy-examples-delayed--childrenfn (hier-elem) "Return the children of HIER-ELEM. -Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number' -and then create a list of the number plus 0.0ā0.9." +Basically, feed the number, minus 1, to +`hierarchy-examples-delayed--find-number' and then create a list of the +number plus 0.0ā0.9." (when (> hier-elem 1) (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem)))) diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el index 460b7a8e516..5358bcaeb5c 100644 --- a/test/lisp/emacs-lisp/macroexp-resources/vk.el +++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el @@ -25,7 +25,7 @@ (if (macroexp--dynamic-variable-p var) ''dyn ''lex)) (defvar vk-a 1) -(defconst vk-b 2) +(defvar vk-b 2) (defvar vk-c) (defun vk-f1 (x) diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index d062965952a..c79adcdfec5 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -160,4 +160,18 @@ (should-error (pcase-setq a) :type '(wrong-number-of-arguments))) +(ert-deftest pcase-tests-mutually-exclusive () + (dolist (x '((functionp consp nil) + (functionp stringp t) + (compiled-function-p consp t) + (keywordp symbolp nil) + (keywordp symbol-with-pos-p nil) + (keywordp stringp t))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x))) + (should-not (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x)))) + (if (nth 2 x) + (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))) + (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))))) + ;;; pcase-tests.el ends here. diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b663fb365a8..7606183d645 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -36,4 +36,53 @@ (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "code-formats.erts"))) +(defun pp-tests--dimensions () + (save-excursion + (let ((width 0) + (height 0)) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (setq height (1+ height)) + (setq width (max width (current-column))) + (forward-char 1)) + (cons width height)))) + +(ert-deftest pp-tests--cut-before () + (with-temp-buffer + (lisp-data-mode) + (pp '(1 (quite-a-long-package-name + . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar + ((:url . "https://github.com/abo-abo/ace-window") + (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") + (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) + (:keywords "window" "location"))])) + (current-buffer)) + ;; (message "Filled:\n%s" (buffer-string)) + (let ((dimensions (pp-tests--dimensions))) + (should (< (car dimensions) 80)) + (should (< (cdr dimensions) 8))) + (goto-char (point-min)) + (while (search-forward "." nil t) + (should (not (eolp)))))) + +(ert-deftest pp-tests--sanity () + (with-temp-buffer + (lisp-data-mode) + (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))")) + (let ((res (car (read-from-string testdata)))) + (dotimes (i (length testdata)) + (erase-buffer) + (insert testdata) + (let ((fill-column i)) + (pp-fill (point-min) (point-max)) + (goto-char (point-min)) + (condition-case err + (should (equal (read (current-buffer)) res)) + (invalid-read-syntax + (message "Invalid fill result with i=%d:\n%s" + i (buffer-string)) + (signal (car err) (cdr err)) + )))))))) + ;;; pp-tests.el ends here. diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el index 8be2be3139e..e53268b3f14 100644 --- a/test/lisp/emacs-lisp/tabulated-list-tests.el +++ b/test/lisp/emacs-lisp/tabulated-list-tests.el @@ -130,4 +130,45 @@ (should-error (tabulated-list-sort) :type 'user-error) (should-error (tabulated-list-sort 4) :type 'user-error))) +(ert-deftest tabulated-list-groups () + (with-temp-buffer + (tabulated-list-mode) + (setq tabulated-list-groups + (reverse + (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3))) + tabulated-list--test-entries))) + (setq tabulated-list-format tabulated-list--test-format) + (setq tabulated-list-padding 7) + (tabulated-list-init-header) + (tabulated-list-print) + ;; Basic printing. + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + zzzz-game zzzz-game 2113 installed play zzzz in Emacs + mode mode 1128 installed A simple mode for editing Actionscript 3 files +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +")) + ;; Sort and preserve position. + (forward-line 2) + (let ((pos (thing-at-point 'line))) + (tabulated-list-next-column 2) + (tabulated-list-sort) + (should (equal (thing-at-point 'line) pos)) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + mode mode 1128 installed A simple mode for editing Actionscript 3 files + zzzz-game zzzz-game 2113 installed play zzzz in Emacs +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +"))))) + ;;; tabulated-list-tests.el ends here diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ba6fe9fd8c1..603b3745a27 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -20,14 +20,13 @@ ;;; Commentary: ;;; Code: +(require 'erc-button) (require 'ert-x) ; cl-lib (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-button) - (ert-deftest erc-button-alist--url () (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index a2fb0392727..d4b5919a1cc 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -243,7 +243,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -264,7 +264,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) @@ -289,7 +289,7 @@ (delete-region (point) (point-max)) (insert "/dcc get -") (call-interactively #'completion-at-point) - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (goto-char (point-min)) (search-forward "-s") (search-forward "-t")) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 0f19b481f37..3c4ad04abd7 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -23,13 +23,13 @@ ;; scenarios. ;;; Code: +(require 'erc-fill) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-fill) - (defvar erc-fill-tests--buffers nil) (defvar erc-fill-tests--current-time-value nil) @@ -52,6 +52,7 @@ (defun erc-fill-tests--wrap-populate (test) (let ((original-window-buffer (window-buffer (selected-window))) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-stamp--tz t) (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index b8e00c57ef5..7cbaa39d3f7 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -19,29 +19,33 @@ ;;; Commentary: ;;; Code: +(require 'erc-goodies) + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-goodies) - (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) (let ((end (+ beg (1- (length end-str))))) - (while (and beg (< beg end)) - (let* ((val (get-text-property beg 'font-lock-face)) - (ft (flatten-tree (ensure-list val)))) - (dolist (p (ensure-list present)) - (if (consp p) - (should (member p val)) - (should (memq p ft)))) - (dolist (a (ensure-list absent)) - (if (consp a) - (should-not (member a val)) - (should-not (memq a ft)))) - (setq beg (text-property-not-all beg (point-max) - 'font-lock-face val)))))) + (ert-info ((format "beg: %S, end-str: %S" beg end-str)) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (ert-info ((format "looking-at: %S, val: %S" + (buffer-substring-no-properties beg end) + val)) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft))))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val))))))) ;; These are from the "Examples" section of ;; https://modern.ircdocs.horse/formatting.html @@ -129,39 +133,205 @@ ;; Hovering over the redacted area should reveal its underlying text ;; in a high-contrast face. -(ert-deftest erc-controls-highlight--inverse () +(ert-deftest erc-controls-highlight--spoilers () (should (eq t erc-interpret-controls-p)) - (let ((erc-insert-modify-hook '(erc-controls-highlight)) - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (with-current-buffer (get-buffer-create "#chan") - (erc-mode) - (setq-local erc-interpret-mirc-color t) - (erc--initialize-markers (point) nil) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (let* ((raw (concat "BEGIN " + "\C-c0,0 WhiteOnWhite " + "\C-c1,1 BlackOnBlack " + "\C-c99,99 Default " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward "<bob> " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + (save-excursion + (search-forward "WhiteOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face)) + (search-forward "BlackOn") + (should (eq (get-text-property (point) 'mouse-face) + 'erc-spoiler-face))) + ;; Start wtih ERC default face. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Masked in all white. + (erc-goodies-tests--assert-face + 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0) + '(fg:erc-color-face1 bg:erc-color-face1)) + ;; Masked in all black. + (erc-goodies-tests--assert-face + 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil) + ;; Explicit "default" code ignoerd. + (erc-goodies-tests--assert-face + 34 "Default" '(erc-default-face) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 43 "END" 'erc-default-face nil))) + (when noninteractive + (erc-tests-common-kill-buffers))) - (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") - (msg (erc-format-privmessage "bob" m nil t))) - (erc-display-message nil nil (current-buffer) msg)) - (forward-line -1) - (should (search-forward "<bob> " nil t)) - (save-restriction - (narrow-to-region (point) (pos-eol)) - (should (eq (get-text-property (+ 9 (point)) 'mouse-face) - 'erc-inverse-face)) - (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) - 'erc-inverse-face)) - (erc-goodies-tests--assert-face - 0 "Spoiler: " 'erc-default-face - '(fg:erc-color-face0 bg:erc-color-face0)) - (erc-goodies-tests--assert-face - 9 "Hello" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1)) - (erc-goodies-tests--assert-face - 18 " World" '(erc-spoiler-face) - '( fg:erc-color-face0 bg:erc-color-face0 - fg:erc-color-face1 bg:erc-color-face1 ))) - (when noninteractive - (kill-buffer))))) +(ert-deftest erc-controls-highlight--inverse () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let* ((erc-fill-column 90) + (raw (concat "BEGIN " + "\C-c3,13 GreenOnPink " + "\C-v PinkOnGreen " + "\C-c99,99 ReversedDefault " + "\C-v NormalDefault " + "\C-o END")) + (msg (erc-format-privmessage "bob" raw nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward "<bob> " nil t)) + (save-restriction + ;; Narrow to EOL or start of right-side stamp. + (narrow-to-region (point) (line-end-position)) + ;; Baseline. + (erc-goodies-tests--assert-face + 0 "BEGIN " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + ;; Normal fg/bg combo. + (erc-goodies-tests--assert-face + 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13) + '(erc-inverse-face)) + ;; Reverse of previous, so former-bg on former-fg. + (erc-goodies-tests--assert-face + 19 "PinkOnGreen" + '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13) + nil) + ;; The inverse of `default' because reverse still in effect. + (erc-goodies-tests--assert-face + 32 "ReversedDefault" '(erc-inverse-face erc-default-face) + '(fg:erc-color-face3 bg:erc-color-face13)) + (erc-goodies-tests--assert-face + 49 "NormalDefault" '(erc-default-face) + '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 64 "END" 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)))) + (when noninteractive + (erc-tests-common-kill-buffers))) + +;; This is meant to assert two behavioral properties: +;; +;; 1) The background is preserved when only a new foreground is +;; defined, in accordance with this bit from the spec: "If only the +;; foreground color is set, the background color stays the same." +;; https://modern.ircdocs.horse/formatting#color +;; +;; 2) The same holds true for a new, lone foreground of 99. Rather +;; than prepend `erc-default-face', this causes the removal of an +;; existing foreground face and likewise doesn't clobber the +;; existing background. +(ert-deftest erc-controls-highlight/default-foreground () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c99 BlackOnYellow " + "\C-o END") + nil t))) + (forward-line -1) + (should (search-forward "<bob> " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BlackOnYellow END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 36 (font-lock-face (bg:erc-color-face8 + erc-default-face)) + 36 40 (font-lock-face (erc-default-face))))) + (should (search-forward "BlackOnYellow")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil (cdr faces)) + "yellow"))) + + ;; Redefine background color alongside default foreground. + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c99,07 BlackOnOrange " + "\C-o END") + nil t))) + (should (search-forward "<bob> " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BlackOnOrange END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 36 (font-lock-face (bg:erc-color-face7 + erc-default-face)) + 36 40 (font-lock-face (erc-default-face))))) + (should (search-forward "BlackOnOrange")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil (cdr faces)) + "orange")))) ; as opposed to white or black + (when noninteractive + (erc-tests-common-kill-buffers))) + +;; This merely asserts our current interpretation of "default faces": +;; that they reflect the foreground and background exhibited by normal +;; chat messages before any control-code formatting is applied (rather +;; than, e.g., some sort of negation or no-op). +(ert-deftest erc-controls-highlight/default-background () + (should (eq t erc-interpret-controls-p)) + (erc-tests-common-make-server-buf) + (with-current-buffer (erc--open-target "#chan") + (setq-local erc-interpret-mirc-color t) + (defvar erc-fill-column) + (let ((erc-fill-column 90)) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage + "bob" (concat "BEGIN " + "\C-c03,08 GreenOnYellow " + "\C-c05,99 BrownOnWhite " + "\C-o END") + nil t))) + (forward-line -1) + (should (search-forward "<bob> " nil t)) + (should (erc-tests-common-equal-with-props + (erc--remove-text-properties + (buffer-substring (point) (line-end-position))) + #("BEGIN GreenOnYellow BrownOnWhite END" + 0 6 (font-lock-face erc-default-face) + 6 21 (font-lock-face (fg:erc-color-face3 + bg:erc-color-face8 + erc-default-face)) + 21 35 (font-lock-face (fg:erc-color-face5 + erc-default-face)) + 35 39 (font-lock-face (erc-default-face))))) + ;; Ensure the background is white or black, rather than yellow. + (should (search-forward "BrownOnWhite")) + (let ((faces (get-text-property (point) 'font-lock-face))) + (should (equal (face-background (car faces) nil `(,@(cdr faces) default)) + (face-background 'default))))) + (when noninteractive + (erc-tests-common-kill-buffers))) (defvar erc-goodies-tests--motd ;; This is from ergo's MOTD @@ -251,15 +421,16 @@ (defun erc-goodies-tests--assert-kp-indicator-on () (should erc--keep-place-indicator-overlay) - (should (local-variable-p 'window-buffer-change-functions)) - (should window-configuration-change-hook) + (should (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should (memq 'erc-keep-place erc-insert-pre-hook)) (should (eq erc-keep-place-mode (not (local-variable-p 'erc-insert-pre-hook))))) (defun erc-goodies-tests--assert-kp-indicator-off () (should-not (local-variable-p 'erc-insert-pre-hook)) - (should-not (local-variable-p 'window-buffer-change-functions)) + (should-not (memq 'erc--keep-place-indicator-on-window-buffer-change + window-buffer-change-functions)) (should-not erc--keep-place-indicator-overlay)) (defun erc-goodies-tests--kp-indicator-populate () @@ -272,12 +443,9 @@ (goto-char erc-input-marker)) (defun erc-goodies-tests--keep-place-indicator (test) - (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*") - (erc-mode) - (erc--initialize-markers (point) nil) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-keep-place-mode -1) + (with-current-buffer (erc-tests-common-make-server-buf + "*erc-keep-place-indicator-mode*") (let (erc-connect-pre-hook erc-modules) @@ -294,7 +462,7 @@ (should-not (member 'erc-keep-place (default-value 'erc-insert-pre-hook))) (should-not (local-variable-p 'erc-insert-pre-hook)) - (kill-buffer)))) + (erc-tests-common-kill-buffers)))) (ert-deftest erc-keep-place-indicator-mode--no-global () (erc-goodies-tests--keep-place-indicator diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d8d8c6fa9cd..0d8861f2167 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -18,6 +18,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +(require 'erc-compat) (require 'ert-x) ; cl-lib (eval-and-compile @@ -1348,7 +1349,7 @@ (should-not (erc-server-process-alive (should (get-buffer "#chan/irc.foonet.org")))) - (with-current-buffer (get-buffer "#chan/irc.foonet.org") + (with-current-buffer "#chan/irc.foonet.org" (should-not erc-server-connected) (should (eq erc-server-process old-proc)) (erc-with-server-buffer @@ -1761,4 +1762,50 @@ (should (equal (erc-ports-list (nth 4 srv)) '(6697 9999)))))) +(ert-deftest erc-networks--examine-targets () + (with-current-buffer (erc-tests-common-make-server-buf "foonet") + (erc--open-target "#chan") + (erc--open-target "#spam")) + + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + (with-current-buffer (erc--open-target "*query") + (setq erc-networks--id nil)) + (with-current-buffer (erc--open-target "#chan") + (let ((calls ()) + (snap (lambda (parameter) + (list parameter + (erc-target) + (erc-networks--id-symbol erc-networks--id))))) + + ;; Search for "#chan" dupes among targets of all servers. + (should (equal + (erc-networks--examine-targets erc-networks--id erc--target + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "#chan@foonet") + (get-buffer "#chan@barnet")))) + + (should (equal (pop calls) '(ON-DUPE "#chan" barnet))) + (should (equal (pop calls) '(ON-COLL "#chan" foonet))) + (should-not calls) + (should-not (get-buffer "#chan")) + (should (get-buffer "#chan@barnet")) + (should (get-buffer "#chan@foonet")) + + ;; Search for "*query" dupes among targets of all servers. + (should (equal (erc-networks--examine-targets erc-networks--id + (buffer-local-value 'erc--target + (get-buffer "*query")) + (lambda () (push (funcall snap 'ON-DUPE) calls)) + (lambda () (push (funcall snap 'ON-COLL) calls))) + (list (get-buffer "*query")))) + + (should (equal (pop calls) '(ON-DUPE "*query" barnet))) + (should-not calls))) + + (goto-char (point-min)) + (should (search-forward "Missing network session" nil t))) + + (erc-tests-common-kill-buffers)) + ;;; erc-networks-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el index 73fba65acf4..3183cd27370 100644 --- a/test/lisp/erc/erc-scenarios-base-chan-modes.el +++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el @@ -81,4 +81,62 @@ (should-not erc-channel-user-limit) (funcall expect 10 "<Chad> after")))) +;; This asserts proper recognition of nonstandard prefixes advertised +;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3 +;; `multi-prefix' extension, we can't easily sync a user's channel +;; membership status on receipt of a 352/353 by parsing the "flags" +;; parameter because even though servers remember multiple prefixes, +;; they only ever return the one with the highest rank. For example, +;; if on receipt of a 352, we were to "update" someone we believe to +;; be @+ by changing them to a to @, we'd be guilty of willful +;; munging. And if they later lose that @, we'd then see them as null +;; when in fact they're still +. However, we *could* use a single +;; degenerate prefix to "validate" an existing record to ensure +;; correctness of our processing logic, but it's unclear how such a +;; discrepancy ought to be handled beyond asking the user to file a +;; bug. +(ert-deftest erc-scenarios-base-chan-modes--speaker-status () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/modes") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'speaker-status)) + (erc-show-speaker-membership-status t) + (erc-autojoin-channels-alist '(("." "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :user "tester") + (funcall expect 5 "Here on foonet, we provide services"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + + (ert-info ("Prefixes printed correctly in 353") + (funcall expect 10 "chan: +alice @fsbot -bob !foop")) + + (ert-info ("Speakers honor option `erc-show-speaker-membership-status'") + (funcall expect 10 "<-bob> alice: Of that which hath") + (funcall expect 10 "<+alice> Hie you, make haste") + (funcall expect 10 "<!foop> hi")) + + (ert-info ("Status conferred and rescinded") + (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ") + (funcall expect 10 "mode for #chan to +v bob") + (funcall expect 10 "<+bob> alice: Fair as a text B") + (funcall expect 10 "<+alice> bob: Even as Apemantus") + (funcall expect 10 "mode for #chan to -v bob") + (funcall expect 10 "<-bob> alice: That's the way") + (funcall expect 10 "<+alice> Give it the beasts")) + + ;; If it had instead overwritten it, our two states would be + ;; out of sync. (See comment above.) + (ert-info ("/WHO output confirms server shadowed V status") + (erc-scenarios-common-say "/who #chan") + (funcall expect 10 '(: "bob" (+ " ") "H-")) + (funcall expect 10 "<-bob> alice: Remains in danger") + (erc-cmd-QUIT ""))))) + ;;; erc-scenarios-base-chan-modes.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-renick.el b/test/lisp/erc/erc-scenarios-base-renick.el index ca22728b152..e0fcb8b9366 100644 --- a/test/lisp/erc/erc-scenarios-base-renick.el +++ b/test/lisp/erc/erc-scenarios-base-renick.el @@ -281,12 +281,12 @@ (should-not (get-buffer "rando@barnet")) (with-current-buffer "frenemy@foonet" - (funcall expect 1 "now known as") - (funcall expect 1 "doubly so")) + (funcall expect 10 "now known as") + (funcall expect 10 "doubly so")) (with-current-buffer "frenemy@barnet" - (funcall expect 1 "now known as") - (funcall expect 1 "reality picture")) + (funcall expect 10 "now known as") + (funcall expect 10 "reality picture")) (when noninteractive (with-current-buffer "frenemy@barnet" (kill-buffer)) diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index bbd9c79f593..f3905974a11 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -42,4 +42,50 @@ 'znc-foonet 'znc-barnet)) +;; Here, the upstream connection is already severed when first +;; connecting. The bouncer therefore sends query messages from an +;; administrative bot before the first numerics burst, which results +;; in a target buffer not being associated with an `erc-networks--id'. +;; The problem only manifests later, when the buffer-association +;; machinery checks the names of all target buffers and assumes a +;; non-nil `erc-networks--id'. +(ert-deftest erc-scenarios-upstream-recon--znc/severed () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/upstream-reconnect") + (erc-d-t-cleanup-sleep-secs 1) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'znc-severed)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester@vanilla/foonet" + :password "changeme" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 6 (eq (erc-network) 'foonet)))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "*status")) + (funcall expect 10 "Connection Refused. Reconnecting...") + (funcall expect 10 "Connected!")) + + (ert-info ("Join #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "<alice> tester, welcome!") + (funcall expect 10 "<bob> alice: And see a fearful sight") + (funcall expect 10 "<eve> hola") + (funcall expect 10 "<Evel> hell o") + ;; + (funcall expect 10 "<alice> bob: Or to drown my clothes"))) + + (ert-info ("Buffer not renamed with net id") + (should (get-buffer "*status"))) + + (ert-info ("No error") + (with-current-buffer (messages-buffer) + (funcall expect -0.1 "error in process filter"))))) + ;;; erc-scenarios-base-upstream-recon-znc.el ends here diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index b8ff59f4e02..ccd6f81b7d2 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -85,8 +85,8 @@ (goto-char (window-point)) (should (looking-back (rx "<bob> tester, welcome!"))) (should (= (pos-bol) (window-start))) - (should (= (overlay-start erc--keep-place-indicator-overlay) - (pos-bol)))) + (erc-d-t-wait-for 20 + (= (overlay-start erc--keep-place-indicator-overlay) (pos-bol)))) ;; Lower window is still centered at start. (other-window 1) (switch-to-buffer "#chan") @@ -101,7 +101,7 @@ (recenter 0) (redisplay) ; force ^ to appear on first line - (other-window 1) ; upper still at indicator, swtiches first + (other-window 1) ; upper still at indicator, switches first (switch-to-buffer "#spam") (other-window 1) (switch-to-buffer "#spam") ; lower follows, speaks to sync diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el b/test/lisp/erc/erc-scenarios-misc-commands.el index d6ed53b5358..da6855caf57 100644 --- a/test/lisp/erc/erc-scenarios-misc-commands.el +++ b/test/lisp/erc/erc-scenarios-misc-commands.el @@ -123,4 +123,94 @@ (should (string= (erc-server-user-host (erc-get-server-user "tester")) "some.host.test.cc")))))) +;; This tests four related slash commands, /AMSG, /GMSG, /AME, /GME, +;; the latter three introduced by bug#68401. It mainly asserts +;; correct routing behavior, especially not sending or inserting +;; messages in buffers belonging to disconnected sessions. Left +;; unaddressed are interactions with the `command-indicator' module +;; (`erc-noncommands-list') and whatever future `echo-message' +;; implementation manifests out of bug#49860. +(ert-deftest erc-scenarios-misc-commands--AMSG-GMSG-AME-GME () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "commands") + (erc-server-flood-penalty 0.1) + (dumb-server-foonet (erc-d-run "localhost" t "srv-foonet" 'amsg-foonet)) + (dumb-server-barnet (erc-d-run "localhost" t "srv-barnet" 'amsg-barnet)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet and join #foo") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-foonet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#foo"))) + + (ert-info ("Connect to barnet and join #bar") + (with-current-buffer + (erc :server "127.0.0.1" + :port (process-contact dumb-server-barnet :service) + :nick "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#bar"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 10 "welcome")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 10 "welcome")) + + (ert-info ("/AMSG only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/amsg 1 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/amsg 2 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 "<tester> 1 foonet only") + (funcall expect 10 "<alice> bob: Our queen and all")) + (with-current-buffer "#bar" + (funcall expect 10 "<tester> 2 barnet only") + (funcall expect 10 "<joe> mike: And secretly to greet"))) + + (ert-info ("/AME only sent to issuing context's server") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/ame 3 foonet only")) + (with-current-buffer "barnet" + (erc-scenarios-common-say "/ame 4 barnet only")) + (with-current-buffer "#foo" + (funcall expect 10 "* tester 3 foonet only") + (funcall expect 10 "<alice> bob: You have discharged this")) + (with-current-buffer "#bar" + (funcall expect 10 "* tester 4 barnet only") + (funcall expect 10 "<joe> mike: That same Berowne"))) + + (ert-info ("/GMSG and /GME sent to all servers") + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 5 all nets") + (erc-scenarios-common-say "/gme 6 all nets")) + (with-current-buffer "#bar" + (funcall expect 10 "<tester> 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 "<joe> mike: Mehercle! if their sons"))) + + (ert-info ("/GMSG and /GME only sent to connected servers") + (with-current-buffer "barnet" + (erc-cmd-QUIT "") + (funcall expect 10 "ERC finished")) + (with-current-buffer "#foo" + (funcall expect 10 "<tester> 5 all nets") + (funcall expect 10 "* tester 6 all nets") + (funcall expect 10 "<alice> bob: Stand you!")) + (with-current-buffer "foonet" + (erc-scenarios-common-say "/gmsg 7 all live nets") + (erc-scenarios-common-say "/gme 8 all live nets")) + ;; Message *not* inserted in disconnected buffer. + (with-current-buffer "#bar" + (funcall expect -0.1 "<tester> 7 all live nets") + (funcall expect -0.1 "* tester 8 all live nets"))) + + (with-current-buffer "#foo" + (funcall expect 10 "<tester> 7 all live nets") + (funcall expect 10 "* tester 8 all live nets") + (funcall expect 10 "<bob> alice: Live, and be prosperous;")))) + ;;; erc-scenarios-misc-commands.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index 8f6042de5c2..2afa1ce67a4 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -126,7 +126,7 @@ (erc-d-t-wait-for 10 (get-buffer "foonet")) (ert-info ("Channel buffer #foo playback received") - (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#foo")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) (funcall expect 10 "Excellent workman"))) (ert-info ("Global notices routed to server buffer") diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index ab4a97c5724..47d0bcff41a 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -186,7 +186,7 @@ (funcall expect 10 "Last login from") (funcall expect 10 "Your new nickname is tester"))) - (with-current-buffer (get-buffer "#test") + (with-current-buffer "#test" (funcall expect 10 "tester ") (funcall expect 10 "was created on")))) diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index ef292ccb618..5fee21ec28f 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,14 +20,14 @@ ;;; Commentary: ;;; Code: +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-stamp) -(require 'erc-goodies) ; for `erc-make-read-only' - ;; These display-oriented tests are brittle because many factors ;; influence how text properties are applied. We should just ;; rework these into full scenarios. @@ -46,7 +46,7 @@ (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") (erc-mode) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc--initialize-markers (point) nil) (erc-tests-common-init-server-proc "sleep" "1") @@ -168,11 +168,11 @@ (put-text-property 0 (length msg) 'wrap-prefix 10 msg) (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) - ;; Space not added (treated as opaque string). - (should (search-forward "msg one[" nil t)) - ;; Field covers stamp alone + ;; Leading space added as part of the stamp's field. + (should (search-forward "msg one [" nil t)) + ;; Field covers stamp and space. (should (eql ?e (char-before (field-beginning (point))))) - ;; Vanity props extended + ;; Vanity props extended. (should (get-text-property (field-beginning (point)) 'wrap-prefix)) (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix)) (should (get-text-property (1- (field-end (point))) 'wrap-prefix)) @@ -183,10 +183,10 @@ (erc-timestamp-right-column 20)) (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) - ;; No hard wrap - (should (search-forward "oooo[" nil t)) - ;; Field starts at format string (right bracket) - (should (eql ?\[ (char-after (field-beginning (point))))) + ;; No hard wrap. + (should (search-forward "oooo [" nil t)) + ;; Field starts at managed space before format string. + (should (eql ?\s (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) ;; This concerns a proposed partial reversal of the changes resulting @@ -235,7 +235,7 @@ (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) - (erc-munge-invisibility-spec) + (erc-stamp--manage-local-options-state) (erc-display-message nil 'notice (current-buffer) "Welcome") ;; ;; Pretend `fill' is active and that these lines are diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2cd47ec3f89..3e8ddef3731 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -20,13 +20,13 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +(require 'erc-ring) (require 'ert-x) (eval-and-compile (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-tests-common))) -(require 'erc-ring) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) @@ -302,6 +302,7 @@ (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook + (erc-last-input-time 0) (erc-modules (remq 'stamp erc-modules)) (erc-send-input-line-function #'ignore) (erc--input-review-functions erc--input-review-functions) @@ -381,7 +382,7 @@ (should-not (search-forward (rx (or "9" "10") ">") nil t))))) (ert-info ("Query buffer") - (with-current-buffer (get-buffer "bob") + (with-current-buffer "bob" (goto-char erc-insert-marker) (should (looking-at-p "bob@ServNet 14>")) (goto-char erc-input-marker) @@ -674,7 +675,7 @@ ;; checking if null beforehand. (should-not erc--parsed-prefix) (should (equal (erc--parsed-prefix) - #s(erc--parsed-prefix nil "qaohv" "~&@%+" + #s(erc--parsed-prefix nil "vhoaq" "+%@&~" ((?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v . ?+))))) (let ((cached (should erc--parsed-prefix))) @@ -696,7 +697,7 @@ (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) (setq cached erc--parsed-prefix) (should (equal cached - #s(erc--parsed-prefix ("(ov)@+") "ov" "@+" + #s(erc--parsed-prefix ("(ov)@+") "vo" "+@" ((?o . ?@) (?v . ?+))))) ;; Second target buffer reuses cached value. (with-temp-buffer @@ -714,6 +715,88 @@ (erc-with-server-buffer erc--parsed-prefix)) '((?q . ?~) (?h . ?%))))))) +(ert-deftest erc--get-prefix-flag () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (should (= (erc--get-prefix-flag ?v) 1)) + (should (= (erc--get-prefix-flag ?h) 2)) + (should (= (erc--get-prefix-flag ?o) 4)) + (should (= (erc--get-prefix-flag ?a) 8)) + (should (= (erc--get-prefix-flag ?q) 16)) + + (ert-info ("With optional `from-prefix-p'") + (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1)) + (should (= (erc--get-prefix-flag ?% nil 'fpp) 2)) + (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4)) + (should (= (erc--get-prefix-flag ?& nil 'fpp) 8)) + (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16))) + (should erc--parsed-prefix)) + +(ert-deftest erc--init-cusr-fallback-status () + ;; Fallback behavior active because no `erc--parsed-prefix'. + (should-not erc--parsed-prefix) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should-not erc--parsed-prefix) ; not created in non-ERC buffer. + + ;; Uses advertised server parameter. + (erc-tests-common-make-server-buf (buffer-name)) + (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-"))) + (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil))) + (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil))) + (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil))) + (should erc--parsed-prefix)) + +(ert-deftest erc--compute-cusr-fallback-status () + ;; Useless without an `erc--parsed-prefix'. + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on))) + + (erc-tests-common-make-server-buf (buffer-name)) + (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off))) + (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil))) + (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil))) + (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil)))) + +(ert-deftest erc--cusr-status-p () + (erc-tests-common-make-server-buf (buffer-name)) + (should-not erc--parsed-prefix) + (let ((cusr (make-erc-channel-user :voice t :op t))) + (should-not (erc--cusr-status-p cusr ?q)) + (should-not (erc--cusr-status-p cusr ?a)) + (should-not (erc--cusr-status-p cusr ?h)) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v))) + (should erc--parsed-prefix)) + +(ert-deftest erc--cusr-change-status () + (erc-tests-common-make-server-buf (buffer-name)) + (let ((cusr (make-erc-channel-user))) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?o t) + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?o)) + (should (erc--cusr-status-p cusr ?v)) + + (ert-info ("Reset with optional param") + (erc--cusr-change-status cusr ?q t 'reset) + (should-not (erc--cusr-status-p cusr ?o)) + (should-not (erc--cusr-status-p cusr ?v)) + (should (erc--cusr-status-p cusr ?q))) + + (ert-info ("Clear with optional param") + (erc--cusr-change-status cusr ?v t) + (should (erc--cusr-status-p cusr ?v)) + (erc--cusr-change-status cusr ?q nil 'reset) + (should-not (erc--cusr-status-p cusr ?v)) + (should-not (erc--cusr-status-p cusr ?q))))) + ;; This exists as a reference to assert legacy behavior in order to ;; preserve and incorporate it as a fallback in the 5.6+ replacement. (ert-deftest erc-parse-modes () @@ -737,12 +820,9 @@ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) (ert-deftest erc--update-channel-modes () - (erc-mode) + (erc-tests-common-make-server-buf) (setq erc-channel-users (make-hash-table :test #'equal) - erc-server-users (make-hash-table :test #'equal) - erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test")) - (erc-tests-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -849,7 +929,7 @@ ;; truncation ellipsis when run interactively. Rather than have ;; hard-to-read "nondeterministic" comparisons against sets of ;; acceptable values, we use separate tests. - (when (display-graphic-p) (ert-pass)) + (when (char-displayable-p ?ā¦) (ert-pass)) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) @@ -877,7 +957,7 @@ (ert-deftest erc--channel-modes/graphic-p () :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) + (unless (char-displayable-p ?ā¦) (ert-skip "See non-/graphic-p variant")) (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) @@ -969,11 +1049,13 @@ (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" "))) (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/"))) (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19"))) + (should (equal (erc--parse-isupport-value "a\\x3Db") '("a=b"))) (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c")))) (ert-deftest erc--get-isupport-entry () (let ((erc--isupport-params (make-hash-table)) - (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C"))) + (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C") + ("SPAM" . ""))) (items (lambda () (cl-loop for k being the hash-keys of erc--isupport-params using (hash-values v) collect (cons k v))))) @@ -994,7 +1076,9 @@ (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1"))) (should (equal (funcall items) - '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))))) + '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1")))) + (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM))) + (should-not (erc--get-isupport-entry 'SPAM 'single)))) (ert-deftest erc-server-005 () (let* ((hooked 0) @@ -1012,34 +1096,41 @@ (lambda (_ _ _ line) (push line calls)))) (ert-info ("Baseline") - (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") + (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" + "are supp...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ov)@+") ("EXCEPTS") + ;; Should be ("CHANTYPES") but + ;; retained for compatibility. + ("CHANTYPES" . "") ("BOT" . "B")))) (should (zerop (hash-table-count erc--isupport-params))) (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) - (should (string= (pop calls) - "BOT=B EXCEPTS PREFIX=(ov)@+ are supp...")) + (should (string= + (pop calls) + "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) (should (equal args (erc-response.command-args parsed))))) (erc-call-hooks nil parsed)) (ert-info ("Negated, updated") - (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...") + (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+" + "are su...") parsed (make-erc-response :command-args args :command "005")) (setq verify (lambda () (should (equal erc-server-parameters '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) - (should (string= (pop calls) - "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su...")) + (should (string-prefix-p + "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " + (pop calls))) (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) (should-not (erc--get-isupport-entry 'EXCEPTS)) @@ -1076,25 +1167,37 @@ (should (equal (erc-downcase "\\O/") "|o/" ))))) (ert-deftest erc-channel-p () - (let ((erc--isupport-params (make-hash-table)) - erc-server-parameters) - - (should (erc-channel-p "#chan")) - (should (erc-channel-p "##chan")) - (should (erc-channel-p "&chan")) - (should (erc-channel-p "+chan")) - (should (erc-channel-p "!chan")) - (should-not (erc-channel-p "@chan")) - - (push '("CHANTYPES" . "#&@+!") erc-server-parameters) - - (should (erc-channel-p "!chan")) - (should (erc-channel-p "#chan")) - - (with-current-buffer (get-buffer-create "#chan") - (setq erc--target (erc--target-from-string "#chan"))) - (should (erc-channel-p (get-buffer "#chan")))) - (kill-buffer "#chan")) + (erc-tests-common-make-server-buf) + + (should (erc-channel-p "#chan")) + (should (erc-channel-p "##chan")) + (should (erc-channel-p "&chan")) + (should-not (erc-channel-p "+chan")) + (should-not (erc-channel-p "!chan")) + (should-not (erc-channel-p "@chan")) + + ;; Server sends "CHANTYPES=#&+!" + (should-not erc-server-parameters) + (setq erc-server-parameters '(("CHANTYPES" . "#&+!"))) + (should (erc-channel-p "#chan")) + (should (erc-channel-p "&chan")) + (should (erc-channel-p "+chan")) + (should (erc-channel-p "!chan")) + + (with-current-buffer (erc--open-target "#chan") + (should (erc-channel-p (current-buffer)))) + (with-current-buffer (erc--open-target "+chan") + (should (erc-channel-p (current-buffer)))) + (should (erc-channel-p (get-buffer "#chan"))) + (should (erc-channel-p (get-buffer "+chan"))) + + ;; Server sends "CHANTYPES=" because it's query only. + (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params) + (should-not (erc-channel-p "#spam")) + (should-not (erc-channel-p "&spam")) + (should-not (erc-channel-p (save-excursion (erc--open-target "#spam")))) + + (erc-tests-common-kill-buffers)) (ert-deftest erc--valid-local-channel-p () (ert-info ("Local channels not supported") @@ -1109,12 +1212,16 @@ (should (erc--valid-local-channel-p "&local"))))) (ert-deftest erc--restore-initialize-priors () + (unless (>= emacs-major-version 28) + (ert-skip "Lisp nesting exceeds `max-lisp-eval-depth'")) (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode foo (ignore 1 2 3) bar #'spam baz nil)) (`(let* ((,p (or erc--server-reconnecting erc--target-priors)) (,q (and ,p (alist-get 'erc-my-mode ,p)))) + (unless (local-variable-if-set-p 'erc-my-mode) + (error "Not a local minor mode var: %s" 'erc-my-mode)) (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3)) bar (if ,q (alist-get 'bar ,p) #'spam) baz (if ,q (alist-get 'baz ,p) nil))) @@ -1193,7 +1300,7 @@ (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) - (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) + (setq-local erc-send-completed-hook nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) @@ -1298,6 +1405,14 @@ (should-not erc-debug-irc-protocol))) (ert-deftest erc--split-line () + (let ((erc-split-line-length 0)) + (should (equal (erc--split-line "") '(""))) + (should (equal (erc--split-line " ") '(" "))) + (should (equal (erc--split-line "1") '("1"))) + (should (equal (erc--split-line " 1") '(" 1"))) + (should (equal (erc--split-line "1 ") '("1 "))) + (should (equal (erc--split-line "abc") '("abc")))) + (let ((erc-default-recipients '("#chan")) (erc-split-line-length 10)) (should (equal (erc--split-line "") '(""))) @@ -1655,17 +1770,64 @@ (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (should-not erc-ask-about-multiline-input))) +(ert-deftest erc-extract-command-from-line () + ;; FIXME when next modifying `erc-command-regexp's default value, + ;; move the single quote in the first group's character alternative + ;; to the front, i.e., [A-Za-z'] -> ['A-Za-z], so we can assert + ;; equivalence with this more readable `rx' form. + (rx bol + "/" + (group (+ (in "'A-Za-z"))) + (group (| (: (+ (syntax whitespace)) (* nonl)) + (* (syntax whitespace)))) + eol) + (erc-mode) ; for `erc-mode-syntax-table' + + ;; Non-command. + (should-not (erc-extract-command-from-line "FAKE\n")) + ;; Unknown command. + (should (equal (erc-extract-command-from-line "/FAKE\n") + '(erc-cmd-default "/FAKE\n"))) + + (ert-info ("With `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/MSG\n") + '(erc-cmd-MSG "\n"))) + (should (equal (erc-extract-command-from-line "/MSG \n") + '(erc-cmd-MSG " \n"))) + (should (equal (erc-extract-command-from-line "/MSG \n\n") + '(erc-cmd-MSG " \n\n"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n\n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n \n") + '(erc-cmd-MSG " foo"))) + (should (equal (erc-extract-command-from-line "/MSG foo\n") + '(erc-cmd-MSG " foo")))) + + (ert-info ("Without `do-not-parse-args'") + (should (equal (erc-extract-command-from-line "/HELP\n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP \n") + '(erc-cmd-HELP nil))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo\n") + '(erc-cmd-HELP ("foo")))) + (should (equal (erc-extract-command-from-line "/HELP foo bar\n") + '(erc-cmd-HELP ("foo" "bar")))))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. (ert-deftest erc-process-input-line () - (let (erc-server-last-sent-time - erc-server-flood-queue - (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) - (erc-default-recipients '("#chan")) + (erc-tests-common-make-server-buf) + (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) + (pop-flood-queue (lambda () (erc-with-server-buffer + (pop erc-server-flood-queue)))) calls) - (with-temp-buffer - (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-server-current-nick "tester") + (with-current-buffer (erc--open-target "#chan") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1679,49 +1841,50 @@ (ert-info ("Baseline") (erc-process-input-line "/msg #chan hi\n") (should (equal (pop calls) " #chan hi")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Quote preserves line intact") (erc-process-input-line "/QUOTE FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Unknown command respected") (erc-process-input-line "/FAKE foo bar\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("FAKE foo bar\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "/msg #chan hi you\n") (should (equal (pop calls) " #chan hi you")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line honored") (erc-process-input-line "/msg #chan\n") (should (equal (pop calls) " #chan")) - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :\r\n" . utf-8))))) (ert-info ("Implicit cmd via `erc-send-input-line-function'") (ert-info ("Baseline") (erc-process-input-line "hi\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Spaces preserved") (erc-process-input-line "hi you\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) (ert-info ("Empty line transmitted with injected-space kludge") (erc-process-input-line "\n") - (should (equal (pop erc-server-flood-queue) + (should (equal (funcall pop-flood-queue) '("PRIVMSG #chan : \r\n" . utf-8)))) - (should-not calls)))))) + (should-not calls))))) + (erc-tests-common-kill-buffers)) (ert-deftest erc--get-inserted-msg-beg/basic () (erc-tests-common-assert-get-inserted-msg/basic @@ -2069,6 +2232,58 @@ (when noninteractive (kill-buffer)))) +(ert-deftest erc--restore-important-text-props () + (erc-mode) + (let ((erc--msg-props (map-into '((erc--important-prop-names a)) + 'hash-table))) + (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A)) + " " + (propertize "bar" 'c 'C 'a 'A 'b 'B + 'erc--important-props '(a A c C))) + + ;; Attempt to restore a and c when only a is registered. + (remove-list-of-text-properties (point-min) (point-max) '(a c)) + (erc--restore-important-text-props '(a c)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 3 (a A b B erc--important-props (a A)) + 4 7 (a A b B erc--important-props (a A c C))))) + + ;; Add d between 3 and 6. + (erc--reserve-important-text-props 3 6 '(d D)) + (put-text-property 3 6 'd 'D) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; #1 + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))) + ;; Remove a and d, and attempt to restore d. + (remove-list-of-text-properties (point-min) (point-max) '(a d)) + (erc--restore-important-text-props '(d)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" + 0 2 (b B erc--important-props (a A)) + 2 3 (d D b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D b B erc--important-props (d D a A c C)) + 5 7 (b B erc--important-props (a A c C))))) + + ;; Restore a only. + (erc--restore-important-text-props '(a)) + (should (erc-tests-common-equal-with-props + (buffer-string) + #("foo bar" ; same as #1 above + 0 2 (a A b B erc--important-props (a A)) + 2 3 (d D a A b B erc--important-props (d D a A)) + 3 4 (d D erc--important-props (d D)) + 4 5 (d D a A b B erc--important-props (d D a A c C)) + 5 7 (a A b B erc--important-props (a A c C))))))) + (ert-deftest erc--split-string-shell-cmd () ;; Leading and trailing space @@ -2651,7 +2866,7 @@ (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2661,7 +2876,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc-join-buffer . window)))))) @@ -2672,7 +2887,7 @@ (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - '&interactive-env + '--interactive-env-- '((erc-server-connect-function . erc-open-tls-stream) (erc--display-context @@ -3178,6 +3393,7 @@ (should (eq (erc--find-group 'autojoin) 'erc-autojoin)) (should (eq (erc--find-group 'pcomplete 'Completion) 'erc-pcomplete)) (should (eq (erc--find-group 'capab-identify) 'erc-capab)) + (should (eq (erc--find-group 'completion) 'erc-pcomplete)) ;; No group specified. (should (eq (erc--find-group 'smiley nil) 'erc)) (should (eq (erc--find-group 'unmorse nil) 'erc))) @@ -3525,6 +3741,20 @@ connection." (should (equal (erc-retrieve-catalog-entry 's221) "test-top 221 val")) (makunbound (intern "erc-message-test-top-s221")) - (unintern "erc-message-test-top-s221" obarray)) + (unintern "erc-message-test-top-s221" obarray) + + ;; Inheritance. + (let ((obarray (obarray-make))) + (set (intern "erc-message-test1-abc") "val test1 abc") + (set (intern "erc-message-test2-abc") "val test2 abc") + (set (intern "erc-message-test2-def") "val test2 def") + (put (intern "test0") 'erc--base-format-catalog (intern "test1")) + (put (intern "test1") 'erc--base-format-catalog (intern "test2")) + (should (equal (erc-retrieve-catalog-entry 'abc (intern "test0")) + "val test1 abc")) + (should (equal (erc-retrieve-catalog-entry 'def (intern "test0")) + "val test2 def")) + ;; Terminates. + (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) ;;; erc-tests.el ends here diff --git a/test/lisp/erc/resources/base/modes/speaker-status.eld b/test/lisp/erc/resources/base/modes/speaker-status.eld new file mode 100644 index 00000000000..4a7d508e35c --- /dev/null +++ b/test/lisp/erc/resources/base/modes/speaker-status.eld @@ -0,0 +1,69 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :unknown") + (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...") + (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.") + (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100") + (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3") + (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024") + (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy") + (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server") + (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server") + (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers") + (0.00 ":irc.example.net 252 tester 1 :operator(s) online") + (0.00 ":irc.example.net 253 tester 1 :unknown connections") + (0.00 ":irc.example.net 254 tester 2 :channels formed") + (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers") + (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5") + (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5") + (0.00 ":irc.example.net 375 tester :irc.example.net message of the day") + (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues") + (0.00 ":irc.example.net 372 tester : ") + (0.00 ":irc.example.net 372 tester : Have fun with the image!") + (0.00 ":irc.example.net 376 tester :End of message of the day.") + (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.") + (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2.")) + +((mode 10 "MODE tester +i") + (0.01 ":tester!tester@10.0.2.100 MODE tester :+i")) + +((join 10 "JOIN #chan") + (0.02 ":tester!tester@10.0.2.100 JOIN :#chan") + (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester") + (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.") + (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.example.net 324 tester #chan :+nt") + (0.01 ":irc.example.net 329 tester #chan :1705909863") + (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.") + (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.") + (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi") + ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.") + ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.") + ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.") + (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob") + (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.") + (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.") + (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.") + (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.") + (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.") + ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.") + ) + +((who-chan 10 "who #chan") + (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot") + (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown") + (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown") + (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.") + ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.") + ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.") + (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth.")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]")) diff --git a/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld new file mode 100644 index 00000000000..32d05cc8a3a --- /dev/null +++ b/test/lisp/erc/resources/base/upstream-reconnect/znc-severed.eld @@ -0,0 +1,87 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 10 "NICK tester")) +((user 10 "USER tester@vanilla/foonet 0 * :tester") + (0.00 ":irc.znc.in 001 tester :Welcome to ZNC") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.00 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.01 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.02 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +Zi") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 352 tester * ~u pfa3tpa5ig5ty.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + + (0.02 ":tester!~u@pfa3tpa5ig5ty.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :bob tester @alice eve")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see how he will take it at your hands.") + (0.02 ":irc.foonet.org 221 tester +Zi") + (0.01 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Fear not, my lord, your servant shall do so.") + (0.02 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: If I thrive well, I'll visit thee again.") + (0.01 ":irc.foonet.org 324 tester #chan +Cnt") + (0.03 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Let it be forbid, sir; so should I be a great deal of his act.") + (0.04 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: And see a fearful sight of blood and death.") + (0.00 ":eve!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hola") + (0.01 ":eve!~u@euegh6mj3y8r2.irc NICK :Evel") + (0.01 ":Evel!~u@euegh6mj3y8r2.irc PRIVMSG #chan :hell o") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: His highness comes post from Marseilles, of as able body as when he numbered thirty: he will be here to-morrow, or I am deceived by him that in such intelligence hath seldom failed.") + (0.03 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: See, by good hap, yonder's my lord; I have sweat to see his honour.") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: With the rich worth of your virginity.") + + (0.02 ":*status!znc@znc.in PRIVMSG tester :Disconnected from IRC. Reconnecting...") + (0.05 ":*status!znc@znc.in PRIVMSG tester :Connection Refused. Reconnecting...") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Connected!") + (0.01 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.04 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Wed, 31 Jan 2024 10:58:16 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.03 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 352 tester * ~u hrn2ea3rpeyck.irc irc.foonet.org tester H :0 ZNC - https://znc.in") + (0.01 ":irc.foonet.org 315 tester tester :End of WHO list") + (0.02 ":tester!~u@hrn2ea3rpeyck.irc JOIN #chan")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 353 tester = #chan :tester @alice bob") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :tester, welcome!") + (0.02 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Nay, I assure you, a peace concluded.") + (0.03 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1706698713") + (0.05 ":bob!~u@euegh6mj3y8r2.irc PRIVMSG #chan :alice: But, in defence, by mercy, 'tis most just.") + (0.04 ":alice!~u@euegh6mj3y8r2.irc PRIVMSG #chan :bob: Or to drown my clothes, and say I was stripped.")) diff --git a/test/lisp/erc/resources/commands/amsg-barnet.eld b/test/lisp/erc/resources/commands/amsg-barnet.eld new file mode 100644 index 00000000000..53b3e18651a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-barnet.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") + (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021 05:06:19 UTC") + (0 ":irc.barnet.org 004 tester irc.barnet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.barnet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.barnet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.barnet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.barnet.org 252 tester 0 :IRC Operators online") + (0 ":irc.barnet.org 253 tester 0 :unregistered connections") + (0 ":irc.barnet.org 254 tester 1 :channels formed") + (0 ":irc.barnet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.barnet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.barnet.org 221 tester +i") + (0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #bar") + (0 ":tester!~u@jnu48g2wrycbw.irc JOIN #bar") + (0 ":irc.barnet.org 353 tester = #bar :@mike joe tester") + (0 ":irc.barnet.org 366 tester #bar :End of NAMES list")) + +((mode-bar 10 "MODE #bar") + (0 ":irc.barnet.org 324 tester #bar +nt") + (0 ":irc.barnet.org 329 tester #bar 1620104779") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :tester, welcome!") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Whipp'd first, sir, and hang'd after.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: We have yet many among us can gripe as hard as Cassibelan; I do not say I am one, but I have a hand. Why tribute ? why should we pay tribute ? If C sar can hide the sun from us with a blanket, or put the moon in his pocket, we will pay him tribute for light; else, sir, no more tribute, pray you now.")) + +((privmsg-2 10 "PRIVMSG #bar :2 barnet only") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: Double and treble admonition, and still forfeit in the same kind ? This would make mercy swear, and play the tyrant.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: And secretly to greet the empress' friends.")) + +((privmsg-4 10 "PRIVMSG #bar :\1ACTION 4 barnet only\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: You have not been inquired after: I have sat here all day.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: That same Berowne I'll torture ere I go.")) + +((privmsg-5 10 "PRIVMSG #bar :5 all nets")) + +((privmsg-6 10 "PRIVMSG #bar :\1ACTION 6 all nets\1") + (0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :joe: For mine own part,no offence to the general, nor any man of quality,I hope to be saved.") + (0.1 ":joe!~u@kd7gmjbnbkn8c.irc PRIVMSG #bar :mike: Mehercle! if their sons be ingenuous, they shall want no instruction; if their daughters be capable, I will put it to them. But, vir sapit qui pauca loquitur. A soul feminine saluteth us.")) + +((quit 5 "QUIT :\2ERC\2") + (0 ":tester!~u@jnu48g2wrycbw.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/commands/amsg-foonet.eld b/test/lisp/erc/resources/commands/amsg-foonet.eld new file mode 100644 index 00000000000..eb3d84d646a --- /dev/null +++ b/test/lisp/erc/resources/commands/amsg-foonet.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :unknown") + (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") + (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0 ":irc.foonet.org 254 tester 1 :channels formed") + (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.foonet.org 221 tester +i") + (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #foo") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #foo") + (0 ":irc.foonet.org 353 tester = #foo :alice tester @bob") + (0 ":irc.foonet.org 366 tester #foo :End of NAMES list")) + +((mode-foo 10 "MODE #foo") + (0 ":irc.foonet.org 324 tester #foo +nt") + (0 ":irc.foonet.org 329 tester #foo 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :tester, welcome!") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: But, as it seems, did violence on herself.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Well, this is the forest of Arden.")) + +((privmsg-1 10 "PRIVMSG #foo :1 foonet only") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Signior Iachimo will not from it. Pray, let us follow 'em.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Our queen and all her elves come here anon.")) + +((privmsg-3 10 "PRIVMSG #foo :\1ACTION 3 foonet only\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: The ground is bloody; search about the churchyard.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: You have discharged this honestly: keep it to yourself. Many likelihoods informed me of this before, which hung so tottering in the balance that I could neither believe nor misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for your honest care. I will speak with you further anon.")) + +((privmsg-5 10 "PRIVMSG #foo :5 all nets")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 6 all nets\1") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Give me that mattock, and the wrenching iron.") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: Stand you! You have land enough of your own; but he added to your having, gave you some ground.")) + +((privmsg-6 10 "PRIVMSG #foo :7 all live nets") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Excellent workman! Thou canst not paint a man so bad as is thyself.")) + +((privmsg-6 10 "PRIVMSG #foo :\1ACTION 8 all live nets\1") + (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #foo :bob: And will you, being a man of your breeding, be married under a bush, like a beggar ? Get you to church, and have a good priest that can tell you what marriage is: this fellow will but join you together as they join wainscot; then one of you will prove a shrunk panel, and like green timber, warp, warp.") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #foo :alice: Live, and be prosperous; and farewell, good fellow.")) diff --git a/test/lisp/erc/resources/erc-d/resources/basic.eld b/test/lisp/erc/resources/erc-d/resources/basic.eld index a020eec3fff..80e46d9a279 100644 --- a/test/lisp/erc/resources/erc-d/resources/basic.eld +++ b/test/lisp/erc/resources/erc-d/resources/basic.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ;; Some comment (to prevent regression) diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld index e8feb2e6fd8..47be0722115 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld @@ -22,7 +22,7 @@ (0. ":irc.barnet.org 221 tester +Zi") (0. ":irc.barnet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org") + (0 ":irc.barnet.org 353 joe = #chan :+joe @mike") (0 ":irc.barnet.org 366 joe #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld index 2db750e49da..5d5f8ed18a8 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -21,7 +21,7 @@ (0. ":irc.foonet.org 221 tester +Zi") (0. ":irc.foonet.org 306 tester :You have been marked as being away") (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan") - (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foonet.org 353 alice = #chan :+alice @bob") (0 ":irc.foonet.org 366 alice #chan :End of NAMES list")) ((mode 3 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic.eld b/test/lisp/erc/resources/erc-d/resources/dynamic.eld index 459b6e52bfe..64d8c091ad7 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic.eld @@ -7,8 +7,7 @@ (0.0 ":" dom " 002 " nick " :Your host is " dom) (0.0 ":" dom " 003 " nick " :This server was created just now") (0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":" dom " 252 " nick " 0 :IRC Operators online") (0.0 ":" dom " 253 " nick " 0 :unregistered connections") @@ -23,7 +22,7 @@ (0.0 ":" dom " 306 " nick " :You have been marked as being away") (0.0 ":" nick "!~" nick "@localhost JOIN #chan") - (0.0 ":" dom " 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":" dom " 353 alice = #chan :+alice @bob") (0.0 ":" dom " 366 alice #chan :End of NAMES list")) ((mode 2.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/eof.eld b/test/lisp/erc/resources/erc-d/resources/eof.eld index 5da84b2e74f..db39b3d4af1 100644 --- a/test/lisp/erc/resources/erc-d/resources/eof.eld +++ b/test/lisp/erc/resources/erc-d/resources/eof.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 1.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld index 0504b6a6682..cf64004da0d 100644 --- a/test/lisp/erc/resources/erc-d/resources/fuzzy.eld +++ b/test/lisp/erc/resources/erc-d/resources/fuzzy.eld @@ -23,12 +23,12 @@ ((~join-foo 3.2 "JOIN #foo") (0 "@time=" now " :tester!~tester@localhost JOIN #foo") - (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list")) ((~join-bar 1.2 "JOIN #bar") (0 "@time=" now " :tester!~tester@localhost JOIN #bar") - (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice @bob") (0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list")) ((~mode-foo 3.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/incremental.eld b/test/lisp/erc/resources/erc-d/resources/incremental.eld index a1b48495ec3..7d192a53066 100644 --- a/test/lisp/erc/resources/erc-d/resources/incremental.eld +++ b/test/lisp/erc/resources/erc-d/resources/incremental.eld @@ -7,8 +7,7 @@ (0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net") (0.0 ":irc.foo.net 003 tester :This server was created just now") (0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.foo.net 252 tester 0 :IRC Operators online") (0.0 ":irc.foo.net 253 tester 0 :unregistered connections") @@ -24,7 +23,7 @@ ((join 3 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.foo.net 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.foo.net 353 alice = #foo :+alice @bob") (0 ":irc.foo.net 366 alice #foo :End of NAMES list")) ((mode 3 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/linger.eld b/test/lisp/erc/resources/erc-d/resources/linger.eld index e456370a800..d68da730581 100644 --- a/test/lisp/erc/resources/erc-d/resources/linger.eld +++ b/test/lisp/erc/resources/erc-d/resources/linger.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") ;; Just to mix thing's up (force handler to schedule timer) (0.1 ":irc.example.org 252 tester 0 :IRC Operators online") @@ -24,7 +23,7 @@ (0 ":irc.example.org 221 tester +Zi") (0 ":irc.example.org 306 tester :You have been marked as being away") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/no-block.eld b/test/lisp/erc/resources/erc-d/resources/no-block.eld index 2811923d8ac..af2f4a83ff6 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-block.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-block.eld @@ -7,8 +7,7 @@ (0.0 ":irc.org 002 tester :Your host is irc.org") (0.0 ":irc.org 003 tester :This server was created just now") (0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.org 252 tester 0 :IRC Operators online") (0.0 ":irc.org 253 tester 0 :unregistered connections") @@ -24,13 +23,13 @@ ((join-foo 1.2 "JOIN #foo") (0 ":tester!~tester@localhost JOIN #foo") - (0 ":irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #foo :+alice @bob") (0 ":irc.example.org 366 alice #foo :End of NAMES list")) ;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see) ((~join-bar 1.5 "JOIN #bar") (0 ":tester!~tester@localhost JOIN #bar") - (0 ":irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #bar :+alice @bob") (0 ":irc.example.org 366 alice #bar :End of NAMES list")) ((mode-foo 1.2 "MODE #foo") diff --git a/test/lisp/erc/resources/erc-d/resources/no-match.eld b/test/lisp/erc/resources/erc-d/resources/no-match.eld index d147be1e084..d12854de551 100644 --- a/test/lisp/erc/resources/erc-d/resources/no-match.eld +++ b/test/lisp/erc/resources/erc-d/resources/no-match.eld @@ -8,8 +8,7 @@ (0 ":irc.example.org 002 tester :Your host is irc.example.org") (0 ":irc.example.org 003 tester :This server was created just now") (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0 ":irc.example.org 252 tester 0 :IRC Operators online") (0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -25,7 +24,7 @@ ((join 1.2 "JOIN #chan") (0 ":tester!~tester@localhost JOIN #chan") - (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0 ":irc.example.org 353 alice = #chan :+alice @bob") (0 ":irc.example.org 366 alice #chan :End of NAMES list")) ((mode-chan 0.2 "MODE #chan") diff --git a/test/lisp/erc/resources/erc-d/resources/unexpected.eld b/test/lisp/erc/resources/erc-d/resources/unexpected.eld index ac0a8fecfa6..c03b1dbcfdb 100644 --- a/test/lisp/erc/resources/erc-d/resources/unexpected.eld +++ b/test/lisp/erc/resources/erc-d/resources/unexpected.eld @@ -7,8 +7,7 @@ (0.0 ":irc.example.org 002 tester :Your host is irc.example.org") (0.0 ":irc.example.org 003 tester :This server was created just now") (0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv") - (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+" - " :are supported by this server") + (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server") (0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)") (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") (0.0 ":irc.example.org 253 tester 0 :unregistered connections") @@ -23,6 +22,6 @@ (0.0 ":irc.example.org 306 tester :You have been marked as being away") (0.0 ":tester!~tester@localhost JOIN #chan") - (0.0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org") + (0.0 ":irc.example.org 353 alice = #chan :+alice @bob") (0.0 ":irc.example.org 366 alice #chan :End of NAMES list") (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey")) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0ec48d766ef..9ad5ce49429 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -94,7 +94,8 @@ (require 'erc) (eval-when-compile (require 'erc-join) - (require 'erc-services)) + (require 'erc-services) + (require 'erc-fill)) (declare-function erc-network "erc-networks") (defvar erc-network) @@ -148,9 +149,11 @@ (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) (erc-auth-source-parameters-join-function nil) + (erc--fill-wrap-scrolltobottom-exempt-p t) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) + (erc-last-input-time 0) (erc-d-linger-secs 10) ,@bindings))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index fc5649798b5..99f15b89b03 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -122,7 +122,7 @@ Use NAME for the network and the session server as well." erc--isupport-params (make-hash-table) erc-session-port 6667 erc-network (intern name) - erc-networks--id (erc-networks--id-create nil)) + erc-networks--id (erc-networks--id-create name)) (current-buffer))) (defun erc-tests-common-string-to-propertized-parts (string) @@ -150,7 +150,7 @@ between literal strings." For simplicity, assume string evaluates to itself." (interactive "P") (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp)))) - (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) + (if arg (insert (pp-to-string sexp)) (pp-macroexpand-expression sexp)))) ;; The following utilities are meant to help prepare tests for ;; `erc--get-inserted-msg-bounds' and friends. @@ -206,7 +206,7 @@ For simplicity, assume string evaluates to itself." (defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn) "Compare `buffer-string' to snapshot NAME.eld in DIR, if present. -When non-nil, run TRANS-FN to fiter the current buffer string, +When non-nil, run TRANS-FN to filter the current buffer string, and expect a similar string in return. Call BUF-INIT-FN, when non-nil, in the preview buffer after inserting the filtered string." diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld index 3c32719a052..6ff7af218c0 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 0)) display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld index e2064b914c4..7d9822c80bc 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 349 350 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 455 456 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 456 459 (wrap-prefix #1# line-prefix #5#) 459 466 (wrap-prefix #1# line-prefix #5#) 466 473 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG) 475 480 (wrap-prefix #1# line-prefix #7#) 480 486 (wrap-prefix #1# line-prefix #7#) 487 488 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "alice" erc--cmd PRIVMSG display #9="") 488 493 (wrap-prefix #1# line-prefix #8# display #9#) 493 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 499 (wrap-prefix #1# line-prefix #8#) 500 501 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG) 501 504 (wrap-prefix #1# line-prefix #10#) 504 512 (wrap-prefix #1# line-prefix #10#) 513 514 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "bob" erc--cmd PRIVMSG display #9#) 514 517 (wrap-prefix #1# line-prefix #11# display #9#) 517 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 524 (wrap-prefix #1# line-prefix #11#) 525 526 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG) 526 531 (wrap-prefix #1# line-prefix #12#) 531 538 (wrap-prefix #1# line-prefix #12#) 539 540 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--ts 1680332400 erc--spkr "Dummy" erc--cmd PRIVMSG display #9#) 540 545 (wrap-prefix #1# line-prefix #13# display #9#) 545 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 551 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<alice> one.\n<alice> two.\n<bob> three.\n<bob> four.\n<Dummy> five.\n<Dummy> six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #7=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #7#) 482 488 (wrap-prefix #1# line-prefix #7#) 489 490 (wrap-prefix #1# line-prefix #8=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG display #9="") 490 495 (wrap-prefix #1# line-prefix #8# display #9#) 495 497 (wrap-prefix #1# line-prefix #8# display #9#) 497 501 (wrap-prefix #1# line-prefix #8#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 516 519 (wrap-prefix #1# line-prefix #11# display #9#) 519 521 (wrap-prefix #1# line-prefix #11# display #9#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG display #9#) 542 547 (wrap-prefix #1# line-prefix #13# display #9#) 547 549 (wrap-prefix #1# line-prefix #13# display #9#) 549 553 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld index feaba85ec90..2d0e5a5965f 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld index ed1488c8595..e019e60bb26 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 507 508 (display #("~\n" 0 2 (font-lock-face shadow))) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 509 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld index a3530a6c44d..615de982b1e 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero. [07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 509 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 514 (wrap-prefix #1# line-prefix #12# display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld index 127c0b29bc9..9ab89041b53 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld index a9f3f1d1904..87ea4692d9d 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld index c94629cf357..0228e716731 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#))
\ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld index 754d7989cea..ae364accdea 100644 --- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld @@ -1 +1 @@ -#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 190 191 (line-spacing 0.5) 191 192 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 348 349 (line-spacing 0.5) 349 350 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 435 436 (line-spacing 0.5) 436 437 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 437 440 (wrap-prefix #1# line-prefix #5# display #6#) 440 442 (wrap-prefix #1# line-prefix #5# display #6#) 442 466 (wrap-prefix #1# line-prefix #5#) 466 467 (line-spacing 0.5) 467 468 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 468 484 (wrap-prefix #1# line-prefix #7#) 485 486 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 486 502 (wrap-prefix #1# line-prefix #8#) 502 503 (line-spacing 0.5) 503 504 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 504 507 (wrap-prefix #1# line-prefix #9#) 507 525 (wrap-prefix #1# line-prefix #9#))
\ No newline at end of file +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This buffer is for text.\n*** one two three\n*** four five six\n<bob> Somebody stop me\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) display #6="") 438 441 (wrap-prefix #1# line-prefix #5# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#))
\ No newline at end of file diff --git a/test/lisp/eshell/em-basic-tests.el b/test/lisp/eshell/em-basic-tests.el index 960e04690a5..ebb91cdeea0 100644 --- a/test/lisp/eshell/em-basic-tests.el +++ b/test/lisp/eshell/em-basic-tests.el @@ -33,7 +33,7 @@ ;;; Tests: -(ert-deftest em-basic-test/umask-print-numeric () +(ert-deftest em-basic-test/umask/print-numeric () "Test printing umask numerically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask" "002\n")) @@ -43,7 +43,7 @@ (cl-letf (((symbol-function 'default-file-modes) (lambda () #o1775))) (eshell-command-result-equal "umask" "002\n"))) -(ert-deftest em-basic-test/umask-read-symbolic () +(ert-deftest em-basic-test/umask/print-symbolic () "Test printing umask symbolically." (cl-letf (((symbol-function 'default-file-modes) (lambda () #o775))) (eshell-command-result-equal "umask -S" @@ -56,8 +56,8 @@ (eshell-command-result-equal "umask -S" "u=rwx,g=rwx,o=rx\n"))) -(ert-deftest em-basic-test/umask-set () - "Test setting umask." +(ert-deftest em-basic-test/umask/set-numeric () + "Test setting umask numerically." (let ((file-modes 0)) (cl-letf (((symbol-function 'set-default-file-modes) (lambda (mode) (setq file-modes mode)))) @@ -68,4 +68,30 @@ (eshell-test-command-result "umask $(identity #o222)") (should (= file-modes #o555))))) +(ert-deftest em-basic-test/umask/set-symbolic () + "Test setting umask symbolically." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'default-file-modes) + (lambda() file-modes)) + ((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask u=rwx,g=rwx,o=rx") + (should (= file-modes #o775)) + (eshell-test-command-result "umask u=rw,g=rx,o=x") + (should (= file-modes #o651)) + (eshell-test-command-result "umask u+x,o-x") + (should (= file-modes #o750)) + (eshell-test-command-result "umask a+rx") + (should (= file-modes #o755))))) + +(ert-deftest em-basic-test/umask/set-with-S () + "Test that passing \"-S\" and a umask still sets the umask." + (let ((file-modes 0)) + (cl-letf (((symbol-function 'set-default-file-modes) + (lambda (mode) (setq file-modes mode)))) + (eshell-test-command-result "umask -S 002") + (should (= file-modes #o775)) + (eshell-test-command-result "umask -S 123") + (should (= file-modes #o654))))) + ;; em-basic-tests.el ends here diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el index 13e42ffac88..f778816c4e1 100644 --- a/test/lisp/eshell/em-cmpl-tests.el +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -175,18 +175,18 @@ ACTUAL and EXPECTED should both be lists of strings." (ert-with-temp-directory default-directory (write-region nil nil (expand-file-name "file.txt")) (write-region nil nil (expand-file-name "file.el")) + ;; Complete the first time. This should insert the common prefix + ;; of our completions. (should (equal (eshell-insert-and-complete "echo fi") "echo file.")) + ;; Make sure the completions buffer isn't displayed. + (should-not (get-buffer-window "*Completions*")) ;; Now try completing again. (let ((minibuffer-message-timeout 0) (inhibit-message t)) (completion-at-point)) - ;; FIXME: We can't use `current-message' here. - (with-current-buffer (messages-buffer) - (save-excursion - (goto-char (point-max)) - (forward-line -1) - (should (looking-at "Complete, but not unique"))))))) + ;; This time, we should display the completions buffer. + (should (get-buffer-window "*Completions*"))))) (ert-deftest em-cmpl-test/file-completion/glob () "Test completion of file names using a glob." diff --git a/test/lisp/eshell/em-dirs-tests.el b/test/lisp/eshell/em-dirs-tests.el index 2f170fb0c63..9789e519f4c 100644 --- a/test/lisp/eshell/em-dirs-tests.el +++ b/test/lisp/eshell/em-dirs-tests.el @@ -34,6 +34,9 @@ default-directory)))) ;;; Tests: + +;; Variables + (ert-deftest em-dirs-test/pwd-var () "Test using the $PWD variable." (let ((default-directory "/some/path")) @@ -99,6 +102,25 @@ (eshell-match-command-output "echo $-[1][/ 1 3]" "(\"some\" \"here\")\n")))) + +;; Argument expansion + +(ert-deftest em-dirs-test/expand-user-reference/local () + "Test expansion of \"~USER\" references." + (eshell-command-result-equal "echo ~" (expand-file-name "~")) + (eshell-command-result-equal + (format "echo ~%s" user-login-name) + (expand-file-name (format "~%s" user-login-name)))) + +(ert-deftest em-dirs-test/expand-user-reference/quoted () + "Test that a quoted \"~\" isn't expanded." + (eshell-command-result-equal "echo \\~" "~") + (eshell-command-result-equal "echo \"~\"" "~") + (eshell-command-result-equal "echo '~'" "~")) + + +;; `cd' + (ert-deftest em-dirs-test/cd () "Test that changing directories with `cd' works." (ert-with-temp-directory tmpdir diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 6d922666ea3..fc460a59eed 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -61,6 +61,9 @@ component ending in \"symlink\" is treated as a symbolic link." ;;; Tests: + +;; Glob expansion + (ert-deftest em-glob-test/expand/splice-results () "Test that globs are spliced into the argument list when `eshell-glob-splice-results' is non-nil." @@ -115,6 +118,33 @@ value of `eshell-glob-splice-results'." (eshell-command-result-equal "list ${listify *.no}" '(("*.no")))))))) + +;; Glob conversion + +(ert-deftest em-glob-test/convert/current-start-directory () + "Test converting a glob starting in the current directory." + (should (equal (eshell-glob-convert "*.el") + '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/relative-start-directory () + "Test converting a glob starting in a relative directory." + (should (equal (eshell-glob-convert "some/where/*.el") + '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/absolute-start-directory () + "Test converting a glob starting in an absolute directory." + (should (equal (eshell-glob-convert "/some/where/*.el") + '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + +(ert-deftest em-glob-test/convert/remote-start-directory () + "Test converting a glob starting in a remote directory." + (should (equal (eshell-glob-convert "/ssh:nowhere.invalid:some/where/*.el") + '("/ssh:nowhere.invalid:/some/where/" + (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) + + +;; Glob matching + (ert-deftest em-glob-test/match-any-string () "Test that \"*\" pattern matches any string." (with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el") diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index d33f6a2b46a..3be5d3542ca 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -59,35 +59,31 @@ "cd" (list ,(format "/su:root@%s:~/" tramp-default-host)))))) -(defun mock-eshell-named-command (&rest args) - "Dummy function to test Eshell `sudo' command rewriting." - (list default-directory args)) - (ert-deftest em-tramp-test/sudo-basic () "Test Eshell `sudo' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "echo" "-u" "hi")) - `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-user () "Test Eshell `sudo' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "-u" "hi")) - `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((sudo-directory (format "/sudo:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/sudo "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,sudo-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/sudo-shell () "Test Eshell `sudo' command with -s/--shell option." @@ -109,34 +105,29 @@ (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external (eshell/doas "echo" "-u" "hi")) - `(,(format "/doas:root@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:root@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-user () "Test Eshell `doas' command with specified user." - (cl-letf (((symbol-function 'eshell-named-command) - #'mock-eshell-named-command)) - (should (equal - (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("hi"))))) - (should (equal - (catch 'eshell-external - (eshell/doas "-u" "USER" "echo" "-u" "hi")) - `(,(format "/doas:USER@%s:%s" - tramp-default-host default-directory) - ("echo" ("-u" "hi"))))))) + (let ((doas-directory (format "/doas:USER@%s:%s" + tramp-default-host default-directory))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("hi"))))) + (should (equal (catch 'eshell-replace-command + (eshell/doas "-u" "USER" "echo" "-u" "hi")) + `(let ((default-directory ,doas-directory)) + (eshell-named-command '"echo" '("-u" "hi"))))))) (ert-deftest em-tramp-test/doas-shell () "Test Eshell `doas' command with -s/--shell option." diff --git a/test/lisp/eshell/esh-arg-tests.el b/test/lisp/eshell/esh-arg-tests.el index b626cf10bf1..b748c5ab4c0 100644 --- a/test/lisp/eshell/esh-arg-tests.el +++ b/test/lisp/eshell/esh-arg-tests.el @@ -60,13 +60,17 @@ chars." "he\\\\llo\n"))) (ert-deftest esh-arg-test/escape/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated as just a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo hi\\\nthere" "hithere\n"))) +(ert-deftest esh-arg-test/escape/trailing-newline () + "Test that an escaped newline is equivalent to the empty string." + (with-temp-eshell + (eshell-match-command-output "echo hi\\\n" + "hi\n"))) + (ert-deftest esh-arg-test/escape/newline-conditional () "Test invocation of an if/else statement using line continuations." (let ((eshell-test-value t)) @@ -95,9 +99,7 @@ chars." "\\\"hi\\\\\n"))) (ert-deftest esh-arg-test/escape-quoted/newline () - "Test that an escaped newline is equivalent to the empty string. -When newlines are *nonspecial*, an escaped newline should be -treated literally, as a backslash and a newline." + "Test that an escaped newline is equivalent to the empty string." (with-temp-eshell (eshell-match-command-output "echo \"hi\\\nthere\"" "hithere\n"))) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index be31681267b..ef965a896c1 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -469,6 +469,28 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "no")) +;; Direct invocation + +(defmacro esh-cmd-test--deftest-invoke-directly (name command expected) + "Test `eshell-invoke-directly-p' returns EXPECTED for COMMAND. +NAME is the name of the test case." + (declare (indent 2)) + `(ert-deftest ,(intern (concat "esh-cmd-test/invoke-directly/" + (symbol-name name))) + () + (with-temp-eshell + (should (equal (eshell-invoke-directly-p + (eshell-parse-command ,command nil t)) + ,expected))))) + +(esh-cmd-test--deftest-invoke-directly no-args "echo" t) +(esh-cmd-test--deftest-invoke-directly with-args "echo hi" t) +(esh-cmd-test--deftest-invoke-directly multiple-cmds "echo hi; echo bye" nil) +(esh-cmd-test--deftest-invoke-directly subcmd "echo ${echo hi}" t) +(esh-cmd-test--deftest-invoke-directly complex "ls ." nil) +(esh-cmd-test--deftest-invoke-directly complex-subcmd "echo {ls .}" nil) + + ;; Error handling (ert-deftest esh-cmd-test/throw () diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index 8d6e0c1e426..4e5373e53cd 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el @@ -29,13 +29,15 @@ (eshell--process-args "sudo" '("-a") '((?a "all" nil show-all - "do not ignore entries starting with ."))))) + "do not ignore entries starting with .")) + '(show-all)))) (should (equal '("root" "world") (eshell--process-args "sudo" '("-u" "root" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-parse-leading-options-only () "Test behavior of :parse-leading-options-only in `eshell--process-args'." @@ -45,20 +47,23 @@ "sudo" '("emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("root" "emerge" "-uDN" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user "execute a command as another USER") - :parse-leading-options-only)))) + :parse-leading-options-only) + '(user)))) (should (equal '("DN" "emerge" "world") (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user - "execute a command as another USER")))))) + "execute a command as another USER")) + '(user))))) (ert-deftest esh-opt-test/process-args-external () "Test behavior of :external in `eshell--process-args'." @@ -69,7 +74,8 @@ "ls" '("/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls"))))) + :external "ls") + '(show-all))))) (cl-letf (((symbol-function 'eshell-search-path) #'identity)) (should (equal '(no-catch eshell-ext-command "ls") @@ -78,7 +84,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'no-catch)))) (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) (should-error @@ -86,7 +93,8 @@ "ls" '("-u" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .") - :external "ls")) + :external "ls") + '(show-all)) :type 'error))) (ert-deftest esh-opt-test/eval-using-options-short () diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 39c278a6277..b94e8a276d7 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -653,6 +653,21 @@ nil, use FUNCTION instead." "VAR=hello\n") (should (equal (getenv "VAR") "value")))) +(ert-deftest esh-var-test/local-variables/cd () + "Test that \"VAR=value cd DIR\" properly changes the directory." + (let ((parent-directory (file-name-directory + (directory-file-name default-directory)))) + (with-temp-eshell + (eshell-insert-command "VAR=hello cd ..") + (should (equal default-directory parent-directory))))) + +(ert-deftest esh-var-test/local-variables/env () + "Test that \"env VAR=value command\" temporarily sets variables." + (with-temp-eshell + (push "VAR=value" process-environment) + (eshell-match-command-output "env VAR=hello env" "VAR=hello\n") + (should (equal (getenv "VAR") "value")))) + ;; Variable aliases diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index e01e033e25e..e58b5a14ed9 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -153,7 +153,7 @@ insert the queued one at the next prompt, and finally run it." "Test flushing of previous output" (with-temp-eshell (eshell-insert-command "echo alpha") - (eshell-kill-output) + (eshell-delete-output) (should (eshell-match-output (concat "^" (regexp-quote "*** output flushed ***\n") "$"))))) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 11af1f75574..28f4d5fa181 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -74,8 +74,8 @@ (defvar file-notify--test-events nil) (defvar file-notify--test-monitors nil) -(defun file-notify--test-read-event () - "Read one event. +(defun file-notify--test-wait-event () + "Wait for one event. There are different timeouts for local and remote file notification libraries." (read-event nil nil @@ -87,7 +87,8 @@ There are different timeouts for local and remote file notification libraries." ;; for any monitor. ((file-notify--test-monitor) 7) ((file-remote-p temporary-file-directory) 0.1) - (t 0.01)))) + (t 0.01))) + nil) (defun file-notify--test-timeout () "Timeout to wait for arriving a bunch of events, in seconds." @@ -103,7 +104,7 @@ There are different timeouts for local and remote file notification libraries." TIMEOUT is the maximum time to wait for, in seconds." `(with-timeout (,timeout (ignore)) (while (null ,until) - (file-notify--test-read-event)))) + (file-notify--test-wait-event)))) (defun file-notify--test-no-descriptors () "Check that `file-notify-descriptors' is an empty hash table. @@ -452,7 +453,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Check, that removing watch descriptors out of order do not ;; harm. This fails on cygwin because of timing issues unless a ;; long `sit-for' is added before the call to - ;; `file-notify--test-read-event'. + ;; `file-notify--test-wait-event'. (unless (eq system-type 'cygwin) (let (results) (cl-flet ((first-callback (event) @@ -480,7 +481,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Remove first watch. (file-notify-rm-watch file-notify--test-desc) ;; Only the second callback shall run. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile) (file-notify--test-wait-for-events (file-notify--test-timeout) results) @@ -622,7 +623,7 @@ delivered." (cons 'file-notify while-no-input-ignore-events)) create-lockfiles) ;; Flush pending actions. - (file-notify--test-read-event) + (file-notify--test-wait-event) (file-notify--test-wait-for-events (file-notify--test-timeout) (not (input-pending-p))) @@ -671,7 +672,7 @@ delivered." (t '(created changed deleted stopped))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -707,7 +708,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -755,7 +756,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -805,14 +806,14 @@ delivered." deleted deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; The next two events shall not be visible. - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -860,10 +861,10 @@ delivered." (t '(created changed renamed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; After the rename, we won't get events anymore. - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) (file-notify-rm-watch file-notify--test-desc) @@ -912,11 +913,11 @@ delivered." (t '(attribute-changed attribute-changed))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-modes file-notify--test-tmpfile 000 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (set-file-times file-notify--test-tmpfile '(0 0) 'nofollow) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -1087,7 +1088,7 @@ delivered." (changed changed deleted stopped)))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file-notify--test-tmpfile)) ;; After deleting the file, the descriptor is not valid anymore. (should-not (file-notify-valid-p file-notify--test-desc)) @@ -1134,7 +1135,7 @@ delivered." (t '(created changed deleted deleted stopped))) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-directory file-notify--test-tmpdir 'recursive)) ;; After deleting the parent directory, the descriptor must ;; not be valid anymore. @@ -1247,9 +1248,9 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop source-file-list) nil 'no-message) - (file-notify--test-read-event) + (file-notify--test-wait-event) (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-actions (cond @@ -1272,11 +1273,11 @@ delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (rename-file (pop source-file-list) (pop target-file-list) t)))) (file-notify--test-with-actions (make-list n 'deleted) (dolist (file target-file-list) - (file-notify--test-read-event) + (file-notify--test-wait-event) (delete-file file))) (delete-directory file-notify--test-tmpfile) (if (or (string-equal (file-notify--test-library) "w32notify") @@ -1464,7 +1465,7 @@ the file watch." ;; does not report the `changed' event. (make-list (/ n 2) 'created))) (dotimes (i n) - (file-notify--test-read-event) + (file-notify--test-wait-event) (if (zerop (mod i 2)) (write-region "any text" nil file-notify--test-tmpfile1 t 'no-message) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 718ecd51f8b..d4c1ef3ba67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1656,30 +1656,47 @@ The door of all subtleties! (should (equal (file-name-base "foo") "foo")) (should (equal (file-name-base "foo/bar") "bar"))) -(defun files-tests--check-shebang (shebang expected-mode) - "Assert that mode for SHEBANG derives from EXPECTED-MODE." - (let ((actual-mode - (ert-with-temp-file script-file - :text shebang - (find-file script-file) - (if (derived-mode-p expected-mode) - expected-mode - major-mode)))) - ;; Tuck all the information we need in the `should' form: input - ;; shebang, expected mode vs actual. - (should - (equal (list shebang actual-mode) - (list shebang expected-mode))))) +(defvar sh-shell) + +(defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect) + "Assert that mode for SHEBANG derives from EXPECTED-MODE. + +If EXPECTED-MODE is sh-base-mode, DIALECT says what `sh-shell' should be +set to." + (ert-with-temp-file script-file + :text shebang + (find-file script-file) + (let ((actual-mode (if (derived-mode-p expected-mode) + expected-mode + major-mode))) + ;; Tuck all the information we need in the `should' form: input + ;; shebang, expected mode vs actual. + (should + (equal (list shebang actual-mode) + (list shebang expected-mode))) + (when (eq expected-mode 'sh-base-mode) + (should (eq sh-shell expected-dialect)))))) (ert-deftest files-tests-auto-mode-interpreter () "Test that `set-auto-mode' deduces correct modes from shebangs." - (files-tests--check-shebang "#!/bin/bash" 'sh-mode) - (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode) + ;; Straightforward interpreter invocation. + (files-tests--check-shebang "#!/bin/bash" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode) + ;; Invocation through env. + (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode) (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode) + ;; Invocation through env, with supplementary arguments. + (files-tests--check-shebang "#!/usr/bin/env --split-string=bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env --split-string=-iv --default-signal bash -eux" 'sh-base-mode 'bash) (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v OFS=\"\\t\" -f" 'awk-mode) (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode) - (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode)) + (files-tests--check-shebang "#!/usr/bin/env -S-vi bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal=INT bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -ivS --default-signal bash -eux" 'sh-base-mode 'bash) + (files-tests--check-shebang "#!/usr/bin/env -vS -uFOOBAR bash -eux" 'sh-base-mode 'bash) + ;; Invocation through env, with modified environment. + (files-tests--check-shebang "#!/usr/bin/env -S PYTHONPATH=/...:${PYTHONPATH} python" 'python-base-mode)) (ert-deftest files-test-dir-locals-auto-mode-alist () "Test an `auto-mode-alist' entry in `.dir-locals.el'" diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index a2f16d5ae35..528467a5641 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -553,6 +553,49 @@ If it's not initialized yet, initialize it." (should-not (boundp 'remote-shell-file-name)) (should (string-equal (symbol-value 'remote-null-device) "null")))) + ;; `connection-local-value' and `connection-local-p' care about a + ;; local default directory. + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory temporary-file-directory) + (remote-null-device "null")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (local-variable-p 'remote-null-device)) + (should-not (boundp 'remote-shell-file-name)) + (should (string-equal (symbol-value 'remote-null-device) "null")) + + ;; The recent variable values are used. + (should-not (connection-local-p remote-shell-file-name)) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value remote-shell-file-name) :type 'void-variable) + (should-not (connection-local-p remote-null-device)) + (should + (string-equal + (connection-local-value remote-null-device) remote-null-device)) + (should-not (connection-local-p remote-lazy-var)) + + ;; Run with a different application. + (should-not + (connection-local-p + remote-shell-file-name (cadr files-x-test--application))) + ;; `remote-shell-file-name' is not defined, so we get an error. + (should-error + (connection-local-value + remote-shell-file-name (cadr files-x-test--application)) + :type 'void-variable) + (should-not + (connection-local-p + remote-null-device (cadr files-x-test--application))) + (should + (string-equal + (connection-local-value + remote-null-device (cadr files-x-test--application)) + remote-null-device)) + (should-not + (connection-local-p remote-lazy-var (cadr files-x-test--application))))) + ;; Cleanup. (custom-set-variables `(connection-local-profile-alist ',clpa now) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 7035c8b7773..1beeb77640c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -48,12 +48,12 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-built-in () - (let ((regexp "a built-in function in .C source code") + (let ((regexp "a primitive-function in .C source code") (result (help-fns-tests--describe-function 'mapcar))) (should (string-match regexp result)))) (ert-deftest help-fns-test-interactive-built-in () - (let ((regexp "an interactive built-in function in .C source code") + (let ((regexp "an interactive primitive-function in .C source code") (result (help-fns-tests--describe-function 're-search-forward))) (should (string-match regexp result)))) @@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1 FUNC)." (ert-deftest help-fns-test-lisp-defun () (let ((regexp (if (featurep 'native-compile) - "a native-compiled Lisp function in .+subr\\.el" - "a byte-compiled Lisp function in .+subr\\.el")) + "a subr-native-elisp in .+subr\\.el" + "a compiled-function in .+subr\\.el")) (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a byte-compiled Lisp function in .+subr\\.el") + (let ((regexp "a compiled-function in .+subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 80142d6d6de..6a5f03e38a0 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -153,4 +153,148 @@ (image-rotate -154.5) (should (equal image '(image :rotation 91.0))))) +;;;; Transforming maps + +(ert-deftest image-create-image-with-map () + "Test that `create-image' correctly adds :map and/or :original-map." + (skip-unless (display-images-p)) + (let ((data "foo") + (map '(((circle (1 . 1) . 1) a))) + (original-map '(((circle (2 . 2) . 2) a))) + (original-map-other '(((circle (3 . 3) . 3) a)))) + ;; Generate :original-map from :map. + (let* ((image (create-image data 'svg t :map map :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map))) + ;; Generate :map from :original-map. + (let* ((image (create-image + data 'svg t :original-map original-map :scale 0.5)) + (got-map (image-property image :map))) + (should (equal got-map map))) + ;; Use :original-map if both it and :map are specified. + (let* ((image (create-image + data 'svg t :map map + :original-map original-map-other :scale 0.5)) + (got-original-map (image-property image :original-map))) + (should (equal got-original-map original-map-other))))) + +(defun image-tests--map-equal (a b &optional tolerance) + "Return t if maps A and B have the same coordinates within TOLERANCE. +Since image sizes calculations vary on different machines, this function +allows for each image map coordinate in A to be within TOLERANCE to the +corresponding coordinate in B. When nil, TOLERANCE defaults to 5." + (unless tolerance (setq tolerance 5)) + (catch 'different + (cl-labels ((check-tolerance + (coord-a coord-b) + (unless (>= tolerance (abs (- coord-a coord-b))) + (throw 'different nil)))) + (dotimes (i (length a)) + (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a)) + (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b))) + (unless (eq type-a type-b) + (throw 'different nil)) + (pcase-exhaustive type-a + ('rect + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cadr coords-a) (cadr coords-b)) + (check-tolerance (cddr coords-a) (cddr coords-b))) + ('circle + (check-tolerance (caar coords-a) (caar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b)) + (check-tolerance (cdar coords-a) (cdar coords-b))) + ('poly + (dotimes (i (length coords-a)) + (check-tolerance (aref coords-a i) (aref coords-b i)))))))) + t)) + +(ert-deftest image--compute-map-and-original-map () + "Test `image--compute-map' and `image--compute-original-map'." + (skip-unless (display-images-p)) + (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>") + (original-map + '(((circle (41 . 29) . 24) "a" (help-echo "A")) + ((rect (5 . 101) 77 . 149) "b" (help-echo "B")) + ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C")))) + (scaled-map + '(((circle (82 . 58) . 48) "a" (help-echo "A")) + ((rect (10 . 202) 154 . 298) "b" (help-echo "B")) + ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C")))) + (flipped-map + '(((circle (125 . 29) . 24) "a" (help-echo "A")) + ((rect (89 . 101) 161 . 149) "b" (help-echo "B")) + ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C")))) + (rotated-map + '(((circle (126 . 41) . 24) "a" (help-echo "A")) + ((rect (6 . 5) 54 . 77) "b" (help-echo "B")) + ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C")))) + (scaled-rotated-flipped-map + '(((circle (58 . 82) . 48) "a" (help-echo "A")) + ((rect (202 . 10) 298 . 154) "b" (help-echo "B")) + ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C")))) + (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map + :scale 2 :rotation 90 :flip t))) + ;; Test that `image--compute-original-map' correctly generates + ;; original-map when creating an already transformed image. + (should (image-tests--map-equal (image-property image :original-map) + original-map)) + (setf (image-property image :flip) nil) + (setf (image-property image :rotation) 0) + (setf (image-property image :scale) 2) + (should (image-tests--map-equal (image--compute-map image) + scaled-map)) + (setf (image-property image :scale) 1) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + rotated-map)) + (setf (image-property image :rotation) 0) + (setf (image-property image :flip) t) + (should (image-tests--map-equal (image--compute-map image) + flipped-map)) + (setf (image-property image :scale) 2) + (setf (image-property image :rotation) 90) + (should (image-tests--map-equal (image--compute-map image) + scaled-rotated-flipped-map)) + + ;; Uncomment to test manually by interactively transforming the + ;; image and checking the map boundaries by hovering them. + + ;; (with-current-buffer (get-buffer-create "*test image map*") + ;; (erase-buffer) + ;; (insert-image image) + ;; (goto-char (point-min)) + ;; (pop-to-buffer (current-buffer))) + )) + +(ert-deftest image-transform-map () + "Test functions related to transforming image maps." + (let ((map '(((circle (4 . 3) . 2) "circle") + ((rect (3 . 6) 8 . 8) "rect") + ((poly . [6 11 7 13 2 14]) "poly"))) + (width 10) + (height 15)) + (should (equal (image--scale-map (copy-tree map t) 2) + '(((circle (8 . 6) . 4) "circle") + ((rect (6 . 12) 16 . 16) "rect") + ((poly . [12 22 14 26 4 28]) "poly")))) + (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height)) + '(((circle (12 . 4) . 2) "circle") + ((rect (7 . 3) 9 . 8) "rect") + ((poly . [4 6 2 7 1 2]) "poly")))) + (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height)) + '(((circle (6 . 3) . 2) "circle") + ((rect (2 . 6) 7 . 8) "rect") + ((poly . [4 11 3 13 8 14]) "poly")))) + (let ((copy (copy-tree map t))) + (image--scale-map copy 2) + ;; Scale size because the map has been scaled. + (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height))) + ;; Swap width and height because the map has been flipped. + (image--flip-map copy t `(,(* 2 height) . ,(* 2 width))) + (should (equal copy + '(((circle (6 . 8) . 4) "circle") + ((rect (12 . 6) 16 . 16) "rect") + ((poly . [22 12 26 14 28 4]) "poly"))))))) + ;;; image-tests.el ends here diff --git a/test/lisp/info-tests.el b/test/lisp/info-tests.el index ebe718167bf..8020a7419cf 100644 --- a/test/lisp/info-tests.el +++ b/test/lisp/info-tests.el @@ -28,12 +28,20 @@ (require 'ert-x) (ert-deftest test-info-urls () + (should (equal (Info-url-for-node "(tramp)Top") + "https://www.gnu.org/software/emacs/manual/html_node/tramp/")) (should (equal (Info-url-for-node "(emacs)Minibuffer") "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html")) (should (equal (Info-url-for-node "(emacs)Minibuffer File") "https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer-File.html")) (should (equal (Info-url-for-node "(elisp)Backups and Auto-Saving") "https://www.gnu.org/software/emacs/manual/html_node/elisp/Backups-and-Auto_002dSaving.html")) - (should-error (Info-url-for-node "(gnus)Minibuffer File"))) + (should (equal (Info-url-for-node "(eintr)car & cdr") + "https://www.gnu.org/software/emacs/manual/html_node/eintr/car-_0026-cdr.html")) + (should (equal (Info-url-for-node "(emacs-mime)\tIndex") + "https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Index.html")) + (should (equal (Info-url-for-node "(gnus) Don't Panic") + "https://www.gnu.org/software/emacs/manual/html_node/gnus/Don_0027t-Panic.html")) + (should-error (Info-url-for-node "(nonexistent)Example"))) ;;; info-tests.el ends here diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el index 72b6706a22c..c8eb18501f3 100644 --- a/test/lisp/info-xref-tests.el +++ b/test/lisp/info-xref-tests.el @@ -92,7 +92,15 @@ text. " ) (write-region nil nil file nil 'silent)) - (should (equal 0 (call-process "makeinfo" file)))) + (if (and (eq system-type 'windows-nt) + (executable-find "sh")) + ;; If we are running from MSYS Bash, makeinfo.bat might find the + ;; wrong version of Perl, so make sure to run the shell script + ;; named just 'makeinfo' instead, because it names the correct + ;; Perl. + (should (equal 0 (call-process "sh" nil t nil + "-c" (format "makeinfo '%s'" file)))) + (should (equal 0 (call-process "makeinfo" file))))) (ert-deftest info-xref-test-makeinfo () "Test that info-xref can parse basic makeinfo output." diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 5c742451a57..9a80ced55ae 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -96,10 +96,10 @@ ;;; Testing `sgml-html-meta-auto-coding-function'. -(defconst sgml-html-meta-pre "<!doctype html><html><head>" +(defvar sgml-html-meta-pre "<!doctype html><html><head>" "The beginning of a minimal HTML document.") -(defconst sgml-html-meta-post "</head></html>" +(defvar sgml-html-meta-post "</head></html>" "The end of a minimal HTML document.") (defun sgml-html-meta-run (coding-system) diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 140482ee622..ecda189b6b2 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -161,6 +161,24 @@ DESCRIPTION (let ((button (button-at (match-beginning 0)))) (should (and button (eq 'Man-xref-header-file (button-type button)))))))))) +(ert-deftest man-tests-Man-translate-references () + (should (equal (Man-translate-references "basename") + (if (memq system-type '(ms-dos windows-nt)) + "\"basename\"" + "basename"))) + (should (equal (Man-translate-references "basename(3)") + "3 basename")) + (should (equal (Man-translate-references "basename(3v)") + "3v basename")) + (should (equal (Man-translate-references ";id") + (if (memq system-type '(ms-dos windows-nt)) + "\";id\"" + "\\;id"))) + (should (equal (Man-translate-references "-k basename") + (if (memq system-type '(ms-dos windows-nt)) + "\"-k\" \"basename\"" + "-k basename")))) + (provide 'man-tests) ;;; man-tests.el ends here diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 6dc15d0801f..c4a7de9e51f 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -201,6 +201,13 @@ 'completions-first-difference) return pos)) +(ert-deftest completion-test--pcm-bug38458 () + (should (equal (let ((completion-ignore-case t)) + (completion-pcm--merge-try '("tes" point "ing") + '("Testing" "testing") + "" "")) + '("testing" . 4)))) + (ert-deftest completion-pcm-test-1 () ;; Point is at end, this does not match anything (should (null @@ -465,6 +472,20 @@ (previous-line-completion 4) (should (equal "ac" (get-text-property (point) 'completion--string)))))) +(ert-deftest completion-next-line-multline-test () + (let ((completion-auto-wrap t)) + (completing-read-with-minibuffer-setup + '("a\na" "a\nb" "ac") + (insert "a") + (minibuffer-completion-help) + (switch-to-completions) + (goto-char (point-min)) + (next-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string))) + (goto-char (point-min)) + (previous-line-completion 5) + (should (equal "a\nb" (get-text-property (point) 'completion--string)))))) + (ert-deftest completions-header-format-test () (let ((completion-show-help nil) (completions-header-format nil)) @@ -505,11 +526,11 @@ (ert-deftest completions-affixation-navigation-test () (let ((completion-extra-properties - '(:affixation-function - (lambda (completions) - (mapcar (lambda (c) - (list c "prefix " " suffix")) - completions))))) + `(:affixation-function + ,(lambda (completions) + (mapcar (lambda (c) + (list c "prefix " " suffix")) + completions))))) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (insert "a") @@ -551,35 +572,63 @@ (if transform name (pcase name - (`"aa" "Group 1") - (`"ab" "Group 2") - (`"ac" "Group 3"))))) + (`"aa1" "Group 1") + (`"aa2" "Group 1") + (`"aa3" "Group 1") + (`"aa4" "Group 1") + (`"ab1" "Group 2") + (`"ac1" "Group 3") + (`"ac2" "Group 3"))))) (category . unicode-name)) - (complete-with-action action '("aa" "ab" "ac") string pred))) + (complete-with-action action '("aa1" "aa2" "aa3" "aa4" "ab1" "ac1" "ac2") + string pred))) (insert "a") (minibuffer-completion-help) (switch-to-completions) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap t)) - (next-completion 3)) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (let ((completion-auto-wrap nil)) - (next-completion 3)) - (should (equal "ac" (get-text-property (point) 'completion--string))) + (next-completion 7)) + (should (equal "ac2" (get-text-property (point) 'completion--string))) - (first-completion) (let ((completion-auto-wrap t)) + ;; First column + (first-completion) (next-line-completion 1) - (should (equal "ab" (get-text-property (point) 'completion--string))) - (next-line-completion 2) - (should (equal "aa" (get-text-property (point) 'completion--string))) + (should (equal "aa4" (get-text-property (point) 'completion--string))) + (next-line-completion 3) + (should (equal "aa1" (get-text-property (point) 'completion--string))) (previous-line-completion 2) - (should (equal "ab" (get-text-property (point) 'completion--string)))) + (should (equal "ab1" (get-text-property (point) 'completion--string))) + + ;; Second column + (first-completion) + (next-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 1) + (should (equal "aa2" (get-text-property (point) 'completion--string))) + + ;; Third column + (first-completion) + (next-completion 2) + (should (equal "aa3" (get-text-property (point) 'completion--string))) + (next-line-completion 1) + (should (equal "aa3" (get-text-property (point) 'completion--string)))) + (let ((completion-auto-wrap nil)) - (next-line-completion 3) - (should (equal "ac" (get-text-property (point) 'completion--string))) - (previous-line-completion 3) - (should (equal "aa" (get-text-property (point) 'completion--string)))))) + (first-completion) + (next-line-completion 7) + (should (equal "ac2" (get-text-property (point) 'completion--string))) + (previous-line-completion 7) + (should (equal "aa1" (get-text-property (point) 'completion--string)))))) (provide 'minibuffer-tests) ;;; minibuffer-tests.el ends here diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el new file mode 100644 index 00000000000..b83435e0bd9 --- /dev/null +++ b/test/lisp/net/eww-tests.el @@ -0,0 +1,247 @@ +;;; eww-tests.el --- tests for eww.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'eww) + +(defvar eww-test--response-function (lambda (url) (concat "\n" url)) + "A function for returning a mock response for URL. +The default just returns an empty list of headers and the URL as the +body.") + +(defmacro eww-test--with-mock-retrieve (&rest body) + "Evaluate BODY with a mock implementation of `eww-retrieve'. +This avoids network requests during our tests. Additionally, prepare a +temporary EWW buffer for our tests." + (declare (indent 0)) + `(cl-letf (((symbol-function 'eww-retrieve) + (lambda (url callback args) + (with-temp-buffer + (insert (funcall eww-test--response-function url)) + (apply callback nil args))))) + (with-temp-buffer + (eww-mode) + ,@body))) + +(defun eww-test--history-urls () + (mapcar (lambda (elem) (plist-get elem :url)) eww-history)) + +;;; Tests: + +(ert-deftest eww-test/display/html () + "Test displaying a simple HTML page." + (eww-test--with-mock-retrieve + (let ((eww-test--response-function + (lambda (url) + (concat "Content-Type: text/html\n\n" + (format "<html><body><h1>Hello</h1>%s</body></html>" + url))))) + (eww "example.invalid") + ;; Check that the buffer contains the rendered HTML. + (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n")) + (should (equal (get-text-property (point-min) 'face) + '(shr-text shr-h1))) + ;; Check that the DOM includes the `base'. + (should (equal (pcase (plist-get eww-data :dom) + (`(base ((href . ,url)) ,_) url)) + "http://example.invalid/"))))) + +(ert-deftest eww-test/history/new-page () + "Test that when visiting a new page, the previous one goes into the history." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (should (equal (eww-test--history-urls) + '("http://one.invalid/"))) + (eww "three.invalid") + (should (equal (eww-test--history-urls) + '("http://two.invalid/" + "http://one.invalid/"))))) + +(ert-deftest eww-test/history/back-forward () + "Test that navigating through history just changes our history position. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (let ((url-history '("http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + ;; Go back one page. This should add "three.invalid" to the + ;; history, making our position in the list 2. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go back again. + (eww-back-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 3)) + ;; At the beginning of the history, so trying to go back should + ;; signal an error. + (should-error (eww-back-url)) + ;; Go forward once. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 2)) + ;; Go forward again. + (eww-forward-url) + (should (equal (eww-test--history-urls) url-history)) + (should (= eww-history-position 1)) + ;; At the end of the history, so trying to go forward should + ;; signal an error. + (should-error (eww-forward-url))))) + +(ert-deftest eww-test/history/reload-in-place () + "Test that reloading historical pages updates their history entry in-place. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + ;; Make sure our history has the original page text. + (should (equal (plist-get (nth 1 eww-history) :text) + "http://two.invalid/")) + (should (= eww-history-position 2)) + ;; Reload the page. + (let ((eww-test--response-function + (lambda (url) (concat "\nreloaded " url)))) + (eww-reload) + (should (= eww-history-position 2))) + ;; Go to another page, and make sure the history is correct, + ;; including the reloaded page text. + (eww "four.invalid") + (should (equal (eww-test--history-urls) '("http://two.invalid/" + "http://one.invalid/"))) + (should (equal (plist-get (nth 0 eww-history) :text) + "reloaded http://two.invalid/")) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/delete-future-history () + "Test that going to a new page from a historical one deletes future history. +See bug#69232." + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0)))) + +(ert-deftest eww-test/history/before-navigate/ignore-history () + "Test that going to a new page from a historical one preserves history. +This sets `eww-before-browse-history-function' to `ignore' to preserve +history. See bug#69232." + (let ((eww-before-browse-history-function #'ignore)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) '("http://four.invalid/" + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/history/before-navigate/clone-previous () + "Test that going to a new page from a historical one clones prior history. +This sets `eww-before-browse-history-function' to +`eww-clone-previous-history' to clone the history. See bug#69232." + (let ((eww-before-browse-history-function #'eww-clone-previous-history)) + (eww-test--with-mock-retrieve + (eww "one.invalid") + (eww "two.invalid") + (eww "three.invalid") + (eww-back-url) + (eww "four.invalid") + (eww "five.invalid") + (should (equal (eww-test--history-urls) + '(;; New page and cloned history. + "http://four.invalid/" + "http://two.invalid/" + "http://one.invalid/" + ;; Original history. + "http://three.invalid/" + "http://two.invalid/" + "http://one.invalid/"))) + (should (= eww-history-position 0))))) + +(ert-deftest eww-test/readable/toggle-display () + "Test toggling the display of the \"readable\" parts of a web page." + (eww-test--with-mock-retrieve + (let* ((shr-width most-positive-fixnum) + (shr-use-fonts nil) + (words (string-join + (make-list + 20 "All work and no play makes Jack a dull boy.") + " ")) + (eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "<html><body>" + "<a>This is an uninteresting sentence.</a>" + "<div>" + words + "</div>" + "</body></html>")))) + (eww "example.invalid") + ;; Make sure EWW renders the whole document. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Now, EWW should render just the "readable" parts. + (should (plist-get eww-data :readable)) + (should (string-match-p + (concat "\\`" (regexp-quote words) "\n*\\'") + (buffer-substring-no-properties (point-min) (point-max)))) + (eww-readable 'toggle) + ;; Finally, EWW should render the whole document again. + (should-not (plist-get eww-data :readable)) + (should (string-prefix-p + "This is an uninteresting sentence." + (buffer-substring-no-properties (point-min) (point-max))))))) + +(ert-deftest eww-test/readable/default-readable () + "Test that EWW displays readable parts of pages by default when applicable." + (eww-test--with-mock-retrieve + (let* ((eww-test--response-function + (lambda (_url) + (concat "Content-Type: text/html\n\n" + "<html><body>Hello there</body></html>"))) + (eww-readable-urls '("://example\\.invalid/"))) + (eww "example.invalid") + ;; Make sure EWW uses "readable" mode. + (should (plist-get eww-data :readable))))) + +(provide 'eww-tests) +;; eww-tests.el ends here diff --git a/test/lisp/net/shr-resources/blockquote.html b/test/lisp/net/shr-resources/blockquote.html new file mode 100644 index 00000000000..412caf8bae6 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.html @@ -0,0 +1,2 @@ +<blockquote>Citation.</blockquote> +<div>Reply.</div> diff --git a/test/lisp/net/shr-resources/blockquote.txt b/test/lisp/net/shr-resources/blockquote.txt new file mode 100644 index 00000000000..8ed610b8ea2 --- /dev/null +++ b/test/lisp/net/shr-resources/blockquote.txt @@ -0,0 +1,3 @@ + Citation. + +Reply. diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 0c6e2c091bf..17138053450 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -29,30 +29,62 @@ (declare-function libxml-parse-html-region "xml.c") -(defun shr-test (name) - (with-temp-buffer - (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) - (let ((dom (libxml-parse-html-region (point-min) (point-max))) - (shr-width 80) - (shr-use-fonts nil)) - (erase-buffer) - (shr-insert-document dom) - (cons (buffer-substring-no-properties (point-min) (point-max)) - (with-temp-buffer - (insert-file-contents - (format (concat (ert-resource-directory) "/%s.txt") name)) - (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) - (replace-match (string (string-to-number (match-string 1) 16)) - t t)) - (buffer-string)))))) +(defun shr-test--rendering-check (name &optional context) + "Render NAME.html and compare it to NAME.txt. +Raise a test failure if the rendered buffer does not match NAME.txt. +Append CONTEXT to the failure data, if non-nil." + (let ((text-file (file-name-concat (ert-resource-directory) (concat name ".txt"))) + (html-file (file-name-concat (ert-resource-directory) (concat name ".html"))) + (description (if context (format "%s (%s)" name context) name))) + (with-temp-buffer + (insert-file-contents html-file) + (let ((dom (libxml-parse-html-region (point-min) (point-max))) + (shr-width 80) + (shr-use-fonts nil)) + (erase-buffer) + (shr-insert-document dom) + (let ((result (buffer-substring-no-properties (point-min) (point-max))) + (expected + (with-temp-buffer + (insert-file-contents text-file) + (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) + (replace-match (string (string-to-number (match-string 1) 16)) + t t)) + (buffer-string)))) + (unless (equal result expected) + (ert-fail (list description result expected)))))))) + +(defconst shr-test--rendering-extra-configs + '(("blockquote" + ;; Make sure blockquotes remain indented even when filling is + ;; disabled (bug#69555). + . ((shr-fill-text . nil)))) + "Extra customizations which can impact rendering. +This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a +set of txt/html files under shr-resources/, as passed to `shr-test'. +SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to +validate for the NAME testcase. + +The `rendering' testcase will test NAME once without altering any +settings, then once more for each (OPTION . VALUE) pair.") (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) - (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) - (result (shr-test name))) - (unless (equal (car result) (cdr result)) - (should (not (list name (car result) (cdr result)))))))) + (let* ((name (string-remove-suffix ".html" file)) + (extra-options (alist-get name shr-test--rendering-extra-configs + nil nil 'string=))) + ;; Test once with default settings. + (shr-test--rendering-check name) + ;; Test once more for every extra option for this specific NAME. + (pcase-dolist (`(,option-sym ,option-val) + extra-options) + (let ((option-old (symbol-value option-sym))) + (set option-sym option-val) + (unwind-protect + (shr-test--rendering-check + name (format "with %s %s" option-sym option-val)) + (set option-sym option-old))))))) (ert-deftest use-cookies () (let ((shr-cookie-policy 'same-origin)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 978342b1bb1..1ca2fa9b9b3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -77,7 +77,7 @@ A resource file is in the resource directory as per `ert-resource-directory'." `(expand-file-name ,file (ert-resource-directory))))) -(defconst tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") +(defvar tramp-archive-test-file-archive (ert-resource-file "foo.tar.gz") "The test file archive.") (defun tramp-archive-test-file-archive-hexlified () @@ -86,7 +86,7 @@ Do not hexlify \"/\". This hexlified string is used in `file:///' URLs." (let* ((url-unreserved-chars (cons ?/ url-unreserved-chars))) (url-hexify-string tramp-archive-test-file-archive))) -(defconst tramp-archive-test-archive +(defvar tramp-archive-test-archive (file-name-as-directory tramp-archive-test-file-archive) "The test archive.") diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3216a8be1b0..cdd2a1efdb2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -134,7 +134,7 @@ A resource file is in the resource directory as per (eval-and-compile ;; There is no default value on w32 systems, which could work out ;; of the box. - (defconst ert-remote-temporary-file-directory + (defvar ert-remote-temporary-file-directory (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) ((eq system-type 'windows-nt) null-device) @@ -265,8 +265,8 @@ is greater than 10. `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) (debug-ignored-errors (append - '("^make-symbolic-link not supported$" - "^error with add-name-to-file") + '("\\`make-symbolic-link not supported\\'" + "\\`error with add-name-to-file") debug-ignored-errors)) inhibit-message) (unwind-protect @@ -379,7 +379,7 @@ is greater than 10. (let (tramp-mode) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; `tramp-ignored-file-name-regexp' suppresses Tramp. - (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) + (let ((tramp-ignored-file-name-regexp "\\`/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) ;; Methods shall be at least two characters, except the ;; default method. @@ -3493,6 +3493,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (not (tramp--test-rsync-p))) ;; Wildcards are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) + ;; Wildcards are not supported with "docker cp ..." or "podman cp ...". + (skip-unless (not (tramp--test-container-oob-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 @@ -3815,15 +3817,24 @@ This tests also `access-file', `file-readable-p', (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) +(defun tramp--test-set-ert-test-documentation (test command) + "Set the documentation string for a derived test. +The test is derived from TEST and COMMAND." + (let ((test-doc + (split-string (ert-test-documentation (get test 'ert--test)) "\n"))) + ;; The first line must be extended. + (setcar + test-doc (format "%s Use the \"%s\" command." (car test-doc) command)) + (setf (ert-test-documentation + (get (intern (format "%s-with-%s" test command)) 'ert--test)) + (string-join test-doc "\n")))) + (defmacro tramp--test-deftest-with-stat (test) "Define ert `TEST-with-stat'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"stat\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "stat") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-stat tramp-test-vec)) @@ -3842,11 +3853,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-perl'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"perl\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "perl") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-perl tramp-test-vec)) @@ -3870,11 +3878,8 @@ This tests also `access-file', `file-readable-p', "Define ert `TEST-with-ls'." (declare (indent 1)) `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) () - ;; This is the docstring. However, it must be expanded to a - ;; string inside the macro. No idea. - ;; (concat (ert-test-documentation (get ',test 'ert--test)) - ;; "\nUse the \"ls\" command.") :tags '(:expensive-test) + (tramp--test-set-ert-test-documentation ',test "ls") (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (if-let ((default-directory ert-remote-temporary-file-directory) @@ -4719,57 +4724,55 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `file-name-completion' and `file-name-all-completions'." (skip-unless (tramp--test-enabled)) - ;; Method and host name in completion mode. This kind of completion - ;; does not work on MS Windows. - (unless (memq system-type '(cygwin windows-nt)) - (let ((tramp-fuse-remove-hidden-files t) - (method (file-remote-p ert-remote-temporary-file-directory 'method)) - (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax) - (minibuffer-completing-file-name t)) - (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) - (setq host (match-string 1 host))) + ;; Method and host name in completion mode. + (let ((tramp-fuse-remove-hidden-files t) + (method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) - (unwind-protect - (dolist (syntax (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) - (tramp-change-syntax syntax) - ;; This has cleaned up all connection data, which are used - ;; for completion. We must refill the cache. - (tramp-set-connection-property tramp-test-vec "property" nil) - - (let (;; This is needed for the `separate' syntax. - (prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) - ;; Complete method name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp)) - (should - (member - (concat prefix-format method tramp-postfix-method-format) - (file-name-all-completions - (concat prefix-format (substring method 0 1)) "/")))) - ;; Complete host name. - (unless (or (tramp-string-empty-or-nil-p method) - (string-empty-p tramp-method-regexp) - (tramp-string-empty-or-nil-p host)) - (should - (member - (concat - prefix-format method tramp-postfix-method-format - ipv6-prefix host ipv6-postfix tramp-postfix-host-format) - (file-name-all-completions - (concat prefix-format method tramp-postfix-method-format) - "/")))))) + (unwind-protect + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) + (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) - ;; Cleanup. - (tramp-change-syntax orig-syntax)))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) + ;; Complete method name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) + (should + (member + (concat prefix-format method tramp-postfix-method-format) + (file-name-all-completions + (concat prefix-format (substring method 0 1)) "/")))) + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) + (should + (member + (concat + prefix-format method tramp-postfix-method-format + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + (file-name-all-completions + (concat prefix-format method tramp-postfix-method-format) + "/")))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))) (dolist (non-essential '(nil t)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) @@ -4851,9 +4854,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; and Bug#60505. (ert-deftest tramp-test26-interactive-file-name-completion () "Check interactive completion with different `completion-styles'." - ;; Method, user and host name in completion mode. This kind of - ;; completion does not work on MS Windows. - (skip-unless (not (memq system-type '(cygwin windows-nt)))) + ;; Method, user and host name in completion mode. (tramp-cleanup-connection tramp-test-vec nil 'keep-password) (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) @@ -5159,8 +5160,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name))) - ;; Check remote and local DESTNATION file. This isn't - ;; implemented yet ina all file name handler backends. + ;; Check remote and local DESTINATION file. This isn't + ;; implemented yet in all file name handler backends. ;; (dolist (local '(nil t)) ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) ;; (should @@ -6380,33 +6381,35 @@ INPUT, if non-nil, is a string sent to the process." (setq tramp-remote-path orig-tramp-remote-path) ;; We make a super long `tramp-remote-path'. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) - (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) - (should (file-directory-p dir)) - (setq tramp-remote-path - (append - tramp-remote-path `(,(file-remote-p dir 'localname))) - orig-exec-path - (append - (butlast orig-exec-path) - `(,(file-remote-p dir 'localname)) - (last orig-exec-path))))) - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (equal (exec-path) orig-exec-path)) - ;; Ignore trailing newline. - (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) - ;; The shell doesn't handle such long strings. - (unless (tramp-compat-length> - path - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) - ;; The last element of `exec-path' is `exec-directory'. - (should - (string-equal path (string-join (butlast orig-exec-path) ":")))) - ;; The shell "sh" shall always exist. - (should (executable-find "sh" 'remote))) + (unless (tramp--test-container-oob-p) + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (while (tramp-compat-length< (string-join orig-exec-path ":") 5000) + (let ((dir (make-temp-file + (file-name-as-directory tmp-name) 'dir))) + (should (file-directory-p dir)) + (setq tramp-remote-path + (append + tramp-remote-path `(,(file-remote-p dir 'localname))) + orig-exec-path + (append + (butlast orig-exec-path) + `(,(file-remote-p dir 'localname)) + (last orig-exec-path))))) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (should (equal (exec-path) orig-exec-path)) + ;; Ignore trailing newline. + (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) + ;; The shell doesn't handle such long strings. + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) + ;; The last element of `exec-path' is `exec-directory'. + (should + (string-equal path (string-join (butlast orig-exec-path) ":")))) + ;; The shell "sh" shall always exist. + (should (executable-find "sh" 'remote)))) ;; Cleanup. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) @@ -7057,17 +7060,24 @@ This is used in tests which we don't want to tag (not (and (tramp--test-adb-p) (string-match-p (rx multibyte) default-directory))))) -(defun tramp--test-crypt-p () - "Check, whether the remote directory is encrypted." - (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) - (defun tramp--test-container-p () "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman") eol) + (rx bol (| "docker" "podman")) + (file-remote-p ert-remote-temporary-file-directory 'method))) + +(defun tramp--test-container-oob-p () + "Check, whether the dockercp or podmancp method is used. +They does not support wildcard copy." + (string-match-p + (rx bol (| "dockercp" "podmancp") eol) (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-crypt-p () + "Check, whether the remote directory is encrypted." + (tramp-crypt-file-name-p ert-remote-temporary-file-directory)) + (defun tramp--test-expensive-test-p () "Whether expensive tests are run. This is used in tests which we don't want to tag `:expensive' @@ -7484,7 +7494,8 @@ This requires restrictions of file name syntax." (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "*foo+bar*baz+") @@ -7504,7 +7515,10 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "<foo>bar<baz>") "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + (unless (or (tramp--test-container-oob-p) + (tramp--test-ftp-p) + (tramp--test-gvfs-p)) + "[foo]bar[baz]") "{foo}bar{baz}"))) ;; Simplify test in order to speed up. (apply #'tramp--test-check-files diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index d7e547fcf29..f9f97dba535 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -32,27 +32,18 @@ (should-not (obarrayp "aoeu")) (should-not (obarrayp '())) (should-not (obarrayp [])) - (should (obarrayp (make-vector 7 0)))) - -(ert-deftest obarrayp-unchecked-content-test () - "Should fail to check content of passed obarray." - :expected-result :failed (should-not (obarrayp ["a" "b" "c"])) - (should-not (obarrayp [1 2 3]))) - -(ert-deftest obarray-make-default-test () - (let ((table (obarray-make))) - (should (obarrayp table)) - (should (eq (obarray-size table) obarray-default-size)))) + (should-not (obarrayp [1 2 3])) + (should-not (obarrayp (make-vector 7 0))) + (should-not (obarrayp (vector (obarray-make)))) + (should (obarrayp (obarray-make))) + (should (obarrayp (obarray-make 7)))) (ert-deftest obarray-make-with-size-test () ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal, ;; so we shouldn't enforce this misbehavior in tests! (should-error (obarray-make -1) :type 'wrong-type-argument) - (should-error (obarray-make 0) :type 'wrong-type-argument) - (let ((table (obarray-make 1))) - (should (obarrayp table)) - (should (eq (obarray-size table) 1)))) + (should-error (obarray-make 'a) :type 'wrong-type-argument)) (ert-deftest obarray-get-test () (let ((table (obarray-make 3))) @@ -88,5 +79,15 @@ (obarray-map collect-names table) (should (equal (sort syms #'string<) '("a" "b" "c"))))) +(ert-deftest obarray-clear () + (let ((o (obarray-make))) + (intern "a" o) + (intern "b" o) + (intern "c" o) + (obarray-clear o) + (let ((n 0)) + (mapatoms (lambda (_) (setq n (1+ n))) o) + (should (equal n 0))))) + (provide 'obarray-tests) ;;; obarray-tests.el ends here diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 2fd26d75844..24b244c1611 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -84,7 +84,7 @@ int main() } =-=-= -Name: Concecutive blocks (GNU Style) (bug#60873) +Name: Consecutive blocks (GNU Style) (bug#60873) =-= int diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index f5b5cad9c0b..20beed955d2 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -206,6 +206,33 @@ 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") + ;; Lua + (lua "lua: database.lua:10: assertion failed!\nstack traceback:\n\t" + 6 nil 10 "database.lua") + (lua "lua 5.4: database 2.lua:10: assertion failed!\nstack traceback:\n\t" + 10 nil 10 "database 2.lua") + (lua "/usr/local/bin/lua: core/database.lua:20: assertion failed!\nstack traceback:\n\t" + 21 nil 20 "core/database.lua") + (lua "C:\\Lua\\Lua.exe: Core\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 17 nil 20 "Core\\Database.lua") + (lua "lua: /tmp/database.lua:20: assertion failed!\nstack traceback:\n\t" + 6 nil 20 "/tmp/database.lua") + (lua "Lua.exe: C:\\Temp\\Database.lua:20: assertion failed!\nstack traceback:\n\t" + 10 nil 20 "C:\\Temp\\Database.lua") + (lua-stack " database.lua: in field 'statement'" + 2 nil nil "database.lua" 0) + (lua-stack " database.lua:10: in field 'statement'" + 2 nil 10 "database.lua" 0) + (lua-stack " core/database.lua:20: in field 'statement'" + 2 nil 20 "core/database.lua" 0) + (lua-stack " database 2.lua: in field 'statement'" + 2 nil nil "database 2.lua" 0) + (lua-stack " Core\\Database.lua:20: in field 'statement'" + 2 nil 20 "Core\\Database.lua" 0) + (lua-stack " /tmp/database.lua: in field 'statement'" + 2 nil nil "/tmp/database.lua" 0) + (lua-stack " C:\\Core\\Database.lua: in field 'statement'" + 2 nil nil "C:\\Core\\Database.lua" 0) ;; gmake (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 @@ -507,9 +534,9 @@ The test data is in `compile-tests--test-regexps-data'." 1 15 5 "alpha.c"))) (compile--test-error-line test)) - (should (eq compilation-num-errors-found 100)) + (should (eq compilation-num-errors-found 106)) (should (eq compilation-num-warnings-found 35)) - (should (eq compilation-num-infos-found 28))))) + (should (eq compilation-num-infos-found 35))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index e3026dbfb5a..9d9718f719c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -111,9 +111,8 @@ end of the statement." (skip-unless (eq cperl-test-mode #'cperl-mode)) (cperl--run-test-cases (ert-resource-file "cperl-indent-styles.pl") - (cperl-set-style "PBP") - (indent-region (point-min) (point-max)) ; here we go! - (cperl-set-style-back))) + (cperl-file-style "PBP") + (indent-region (point-min) (point-max)))) ; here we go! ;;; Fontification tests @@ -1145,17 +1144,16 @@ Perl is not Lisp: An open paren in column 0 does not start a function." (ert-deftest cperl-test-bug-35925 () "Check that indentation is correct after a terminating format declaration." - (cperl-set-style "PBP") ; Make cperl-mode use the same settings as perl-mode. (cperl--run-test-cases (ert-resource-file "cperl-bug-35925.pl") + (cperl-file-style "PBP") ; Make cperl-mode use the same settings as perl-mode. (let ((tab-function (if (equal cperl-test-mode 'perl-mode) #'indent-for-tab-command #'cperl-indent-command))) (goto-char (point-max)) (forward-line -2) - (funcall tab-function))) - (cperl-set-style-back)) + (funcall tab-function)))) (ert-deftest cperl-test-bug-37127 () "Verify that closing a paren in a regex goes without a message. @@ -1363,12 +1361,13 @@ as a regex." (ert-deftest cperl-test-bug-64364 () "Check that multi-line subroutine declarations indent correctly." - (cperl-set-style "PBP") ; make cperl-mode use the same settings as perl-mode (cperl--run-test-cases (ert-resource-file "cperl-bug-64364.pl") + (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode (indent-region (point-min) (point-max))) (cperl--run-test-cases (ert-resource-file "cperl-bug-64364.pl") + (cperl-file-style "PBP") ; make cperl-mode use the same settings as perl-mode (let ((tab-function (if (equal cperl-test-mode 'perl-mode) #'indent-for-tab-command @@ -1376,8 +1375,7 @@ as a regex." (goto-char (point-min)) (while (null (eobp)) (funcall tab-function) - (forward-line 1)))) - (cperl-set-style-back)) + (forward-line 1))))) (ert-deftest cperl-test-bug-65834 () "Verify that CPerl mode identifies a left-shift operator. @@ -1433,6 +1431,25 @@ cperl-mode fontifies text after the delimiter as Perl code." (should (equal (get-text-property (point) 'face) font-lock-comment-face)))) +(ert-deftest cperl-test-bug-69604 () + "Verify that $\" in a double-quoted string does not end the string. +Both `perl-mode' and `cperl-mode' treat ?$ as a quoting/escaping char to +avoid issues with punctuation variables. In a string, however, this is +not appropriate." + (let ((strings + '("\"$\\\" in string ---\"; # \"" ; $ must not quote \ + "$\" . \" in string ---\"; # \"" ; $ must quote \ + "\"\\$\" . \" in string ---\"; # \""))) ; \$ must not quote + (dolist (string strings) + (with-temp-buffer + (insert string) + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "in string") + (should (equal (get-text-property (point) 'face) + font-lock-string-face)))))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) diff --git a/test/lisp/progmodes/csharp-mode-resources/indent.erts b/test/lisp/progmodes/csharp-mode-resources/indent.erts new file mode 100644 index 00000000000..a676ecc9728 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-resources/indent.erts @@ -0,0 +1,19 @@ +Code: + (lambda () + (csharp-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Don't consider closed statements as object initializers. (bug#69571) + +=-= +public class Foo { + void Bar () { + var x = new X(); // [1] + for (;;) { + x(); + } // [2] + } +} +=-=-= diff --git a/test/lisp/progmodes/csharp-mode-tests.el b/test/lisp/progmodes/csharp-mode-tests.el new file mode 100644 index 00000000000..f50fabf5836 --- /dev/null +++ b/test/lisp/progmodes/csharp-mode-tests.el @@ -0,0 +1,30 @@ +;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'csharp-mode) + +(ert-deftest csharp-mode-test-indentation () + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'csharp-mode-tests) +;;; csharp-mode-tests.el ends here diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts index fe09a37a32b..f2d0eacee5b 100644 --- a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts @@ -134,7 +134,7 @@ Name: Pipe statements with fn end) =-=-= -Name: Pipe statements stab clases +Name: Pipe statements stab clauses =-= [1, 2] diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index 4fca74dd2e1..514d2e08977 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -110,3 +110,34 @@ public class Java { } } =-=-= + +Name: Opening bracket on separate line (bug#67556) + +=-= +public class Java { + void foo( + String foo) + { + for (var f : rs) + return new String[] + { + "foo", + "bar" + }; + if (a == 0) + { + return 0; + } else if (a == 1) + { + return 1; + } + + switch(expr) + { + case x: + // code block + break; + } + } +} +=-=-= diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts index 9797467bbe5..48184160b4d 100644 --- a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -529,6 +529,58 @@ local Other = { } =-=-= +Name: Continuation Indent + +=-= +local very_long_variable_name = +"ok".. + "ok" +local n = a + +b * +c / +1 +local x = "A".. +"B" +.."C" +if a + and b + and c then + if x + and y then + local x = 1 + +2 * + 3 + end +elseif a + or b + or c then +end +=-= +local very_long_variable_name = + "ok".. + "ok" +local n = a + + b * + c / + 1 +local x = "A".. + "B" + .."C" +if a + and b + and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then +end +=-=-= + Code: (lambda () (setq indent-tabs-mode nil) @@ -677,3 +729,57 @@ function e (n, t) end)(i(...)) end end end =-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-continuation-lines nil) + (setq lua-ts-indent-offset 2) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: Unaligned Continuation Indent + +=-= +local n = a + + b * + c / + 1 +if a + and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a + or b + or c then + if x + or y + end +end +=-= +local n = a + + b * + c / + 1 +if a +and b +and c then + if x + and y then + local x = 1 + + 2 * + 3 + end +elseif a +or b +or c then + if x + or y + end +end +=-=-= diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1df0c42a0ce..e11440cdb5b 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -55,21 +55,27 @@ BODY is code to be executed within the temp buffer. Point is always located at the beginning of buffer. Native completion is turned off. Shell buffer will be killed on exit." (declare (indent 1) (debug t)) - `(with-temp-buffer - (let ((python-indent-guess-indent-offset nil) - (python-shell-completion-native-enable nil)) - (python-mode) - (unwind-protect - (progn - (run-python nil t) - (insert ,contents) - (goto-char (point-min)) - (python-tests-shell-wait-for-prompt) - ,@body) - (when (python-shell-get-buffer) - (python-shell-with-shell-buffer - (let (kill-buffer-hook kill-buffer-query-functions) - (kill-buffer)))))))) + (let ((dir (make-symbol "dir"))) + `(with-temp-buffer + (let ((python-indent-guess-indent-offset nil) + (python-shell-completion-native-enable nil)) + (python-mode) + (unwind-protect + ;; Prevent test failures when Jedi is used as a completion + ;; backend, either directly or indirectly (e.g., via + ;; IPython). Jedi needs to store cache, but the + ;; "/nonexistent" HOME directory is not writable. + (ert-with-temp-directory ,dir + (with-environment-variables (("XDG_CACHE_HOME" ,dir)) + (run-python nil t) + (insert ,contents) + (goto-char (point-min)) + (python-tests-shell-wait-for-prompt) + ,@body)) + (when (python-shell-get-buffer) + (python-shell-with-shell-buffer + (let (kill-buffer-hook kill-buffer-query-functions) + (kill-buffer))))))))) (defmacro python-tests-with-temp-file (contents &rest body) "Create a `python-mode' enabled file with CONTENTS. @@ -474,6 +480,28 @@ def f(x: CustomInt) -> CustomInt: (136 . font-lock-operator-face) (137) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-operator-1 () + (python-tests-assert-faces + "1 << 2 ** 3 == +4%-5|~6&7^8%9" + '((1) + (3 . font-lock-operator-face) (5) + (8 . font-lock-operator-face) (10) + (13 . font-lock-operator-face) (15) + (16 . font-lock-operator-face) (17) + (18 . font-lock-operator-face) (20) + (21 . font-lock-operator-face) (23) + (24 . font-lock-operator-face) (25) + (26 . font-lock-operator-face) (27) + (28 . font-lock-operator-face) (29)))) + +(ert-deftest python-font-lock-operator-2 () + "Keyword operators are font-locked as keywords." + (python-tests-assert-faces + "is_ is None" + '((1) + (5 . font-lock-keyword-face) (7) + (8 . font-lock-constant-face)))) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' @@ -585,62 +613,70 @@ u\"\\n\"" (845 . font-lock-string-face) (886)))) (ert-deftest python-font-lock-escape-sequence-bytes-newline () - :expected-result :failed (python-tests-assert-faces "b'\\n' b\"\\n\"" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (5 . font-lock-doc-face) (6) - (8 . font-lock-doc-face) + (5 . font-lock-string-face) (6) + (8 . font-lock-string-face) (9 . font-lock-constant-face) - (11 . font-lock-doc-face)))) + (11 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-hex-octal () - :expected-result :failed (python-tests-assert-faces "b'\\x12 \\777 \\1\\23' '\\x12 \\777 \\1\\23'" '((1) - (2 . font-lock-doc-face) + (2 . font-lock-string-face) (3 . font-lock-constant-face) - (7 . font-lock-doc-face) + (7 . font-lock-string-face) (8 . font-lock-constant-face) - (12 . font-lock-doc-face) + (12 . font-lock-string-face) (13 . font-lock-constant-face) - (18 . font-lock-doc-face) (19) - (20 . font-lock-doc-face) + (18 . font-lock-string-face) (19) + (20 . font-lock-string-face) (21 . font-lock-constant-face) - (25 . font-lock-doc-face) + (25 . font-lock-string-face) (26 . font-lock-constant-face) - (30 . font-lock-doc-face) + (30 . font-lock-string-face) (31 . font-lock-constant-face) - (36 . font-lock-doc-face)))) + (36 . font-lock-string-face)))) (ert-deftest python-font-lock-escape-sequence-unicode () - :expected-result :failed (python-tests-assert-faces "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}' '\\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (2 . font-lock-doc-face) (41) - (42 . font-lock-doc-face) + (2 . font-lock-string-face) (41) + (42 . font-lock-string-face) (43 . font-lock-constant-face) - (49 . font-lock-doc-face) + (49 . font-lock-string-face) (50 . font-lock-constant-face) - (60 . font-lock-doc-face) + (60 . font-lock-string-face) (61 . font-lock-constant-face) - (80 . font-lock-doc-face)))) + (80 . font-lock-string-face)))) (ert-deftest python-font-lock-raw-escape-sequence () - :expected-result :failed (python-tests-assert-faces "rb'\\x12 \123 \\n' r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" '((1) - (3 . font-lock-doc-face) (14) - (16 . font-lock-doc-face)))) + (3 . font-lock-string-face) (14) + (16 . font-lock-string-face)))) + +(ert-deftest python-font-lock-string-literal-concatenation () + "Test for bug#45897." + (python-tests-assert-faces + "x = \"hello\"\"\" +y = \"confused\"" + '((1 . font-lock-variable-name-face) (2) + (3 . font-lock-operator-face) (4) + (5 . font-lock-string-face) (14) + (15 . font-lock-variable-name-face) (16) + (17 . font-lock-operator-face) (18) + (19 . font-lock-string-face)))) ;;; Indentation @@ -4747,6 +4783,7 @@ def foo(): (python-tests-with-temp-buffer-with-shell "" (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4761,6 +4798,7 @@ def foo(): "" (python-shell-completion-native-turn-on) (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims) (insert "import abc") (comint-send-input) (python-tests-shell-wait-for-prompt) @@ -4769,6 +4807,114 @@ def foo(): (end-of-line 0) (should-not (nth 2 (python-shell-completion-at-point)))))) +(defun python-tests--completion-module () + "Check if modules can be completed in Python shell." + (insert "import datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "import datetime")) + (kill-line) + (insert "from datet") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime")) + (end-of-line) + (insert " import timed") + (completion-at-point) + (beginning-of-line) + (should (looking-at-p "from datetime import timedelta")) + (kill-line)) + +(defun python-tests--completion-parameters () + "Check if parameters can be completed in Python shell." + (insert "import re") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "re.split('b', 'abc', maxs") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0, ") + (should (python-shell-completion-at-point)) + ;; Test if cache is used. + (cl-letf (((symbol-function 'python-shell-completion-get-completions) + 'ignore) + ((symbol-function 'python-shell-completion-native-get-completions) + 'ignore)) + (insert "fla") + (completion-at-point) + (should (string= "re.split('b', 'abc', maxsplit=0, flags=" + (buffer-substring (line-beginning-position) (point))))) + (beginning-of-line) + (kill-line)) + +(defun python-tests--completion-extra-context () + "Check if extra context is used for completion." + (insert "re.split('b', 'abc',") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "maxs") + (completion-at-point) + (should (string= "maxsplit=" + (buffer-substring (line-beginning-position) (point)))) + (insert "0)") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "from re import (") + (comint-send-input) + (python-tests-shell-wait-for-prompt) + (insert "IGN") + (completion-at-point) + (should (string= "IGNORECASE" + (buffer-substring (line-beginning-position) (point))))) + +(defun python-tests--pythonstartup-file () + "Return Jedi readline setup file if PYTHONSTARTUP is not set." + (or (getenv "PYTHONSTARTUP") + (with-temp-buffer + (if (eql 0 (call-process python-tests-shell-interpreter + nil t nil "-m" "jedi" "repl")) + (string-trim (buffer-string)) + "")))) + +(ert-deftest python-shell-completion-at-point-jedi-completer () + "Check if Python shell completion works when Jedi completer is used." + (skip-unless (executable-find python-tests-shell-interpreter)) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context))))) + +(ert-deftest python-shell-completion-at-point-ipython () + "Check if Python shell completion works for IPython." + (let ((python-shell-interpreter "ipython") + (python-shell-interpreter-args "-i --simple-prompt")) + (skip-unless + (and + (executable-find python-shell-interpreter) + (eql (call-process python-shell-interpreter nil nil nil "--version") 0))) + (with-environment-variables + (("PYTHONSTARTUP" (python-tests--pythonstartup-file))) + (python-tests-with-temp-buffer-with-shell + "" + (python-shell-with-shell-buffer + (python-shell-completion-native-turn-off) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-shell-completion-native-turn-on) + (skip-unless (string= python-shell-readline-completer-delims "")) + (python-tests--completion-module) + (python-tests--completion-parameters) + (python-tests--completion-extra-context)))))) ;;; PDB Track integration @@ -4783,6 +4929,8 @@ def foo(): import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4799,6 +4947,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (python-shell-with-shell-buffer @@ -4818,6 +4968,8 @@ pdb.set_trace() print('Hello') " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) (goto-char (point-max)) @@ -4834,6 +4986,8 @@ import time time.sleep(3) " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-send-buffer) (goto-char (point-max)) (insert "time.") @@ -4846,6 +5000,8 @@ time.sleep(3) import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -4863,6 +5019,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -4879,6 +5037,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -4895,6 +5055,8 @@ import abc import abc " (let ((inhibit-message t)) + (python-shell-with-shell-buffer + (skip-unless python-shell-readline-completer-delims)) (python-shell-completion-native-turn-on) (python-shell-send-buffer) (python-tests-shell-wait-for-prompt) @@ -4915,11 +5077,6 @@ import abc (ert-deftest python-ffap-module-path-1 () (skip-unless (executable-find python-tests-shell-interpreter)) - ;; Skip the test on macOS, since the standard Python installation uses - ;; libedit rather than readline which confuses the running of an inferior - ;; interpreter in this case (see bug#59477 and bug#25753). - (skip-when (eq system-type 'darwin)) - (trace-function 'python-shell-output-filter) (python-tests-with-temp-buffer-with-shell " import abc @@ -6647,6 +6804,15 @@ class Class: (python-tests-look-at "Also not a docstring") (should-not (python-info-docstring-p)))) +(ert-deftest python-info-docstring-p-8 () + "Test string in the 2nd line of a buffer." + (python-tests-with-temp-buffer + "import sys +'''Not a docstring.''' +" + (python-tests-look-at "Not a docstring") + (should-not (python-info-docstring-p)))) + (ert-deftest python-info-triple-quoted-string-p-1 () "Test triple quoted string." (python-tests-with-temp-buffer diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts index 7b6185e0386..bec96ad82e0 100644 --- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts @@ -110,3 +110,17 @@ const foo = (props) => { ); } =-=-= + +Name: Interface body fields are indented + +=-= +interface Foo { +foo: string; +bar?: boolean; +} +=-= +interface Foo { + foo: string; + bar?: boolean; +} +=-=-= diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el b/test/lisp/progmodes/typescript-ts-mode-tests.el index 27b7df714e6..effd9551fb0 100644 --- a/test/lisp/progmodes/typescript-ts-mode-tests.el +++ b/test/lisp/progmodes/typescript-ts-mode-tests.el @@ -24,7 +24,8 @@ (require 'treesit) (ert-deftest typescript-ts-mode-test-indentation () - (skip-unless (treesit-ready-p 'typescript)) + (skip-unless (and (treesit-ready-p 'typescript) + (treesit-ready-p 'tsx))) (ert-test-erts-file (ert-resource-file "indent.erts"))) (provide 'typescript-ts-mode-tests) diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index be6784be7a0..a916aed9eb3 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -246,7 +246,7 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to When setting a formula has some cell with changed references, this cell has to be rewritten to data area." (let ((ses-initial-size '(4 . 3)) - ses-after-entry-functions beg) + (ses-after-entry-functions nil)) (with-temp-buffer (ses-mode) (dolist (c '((0 1 1); B1 @@ -257,7 +257,7 @@ cell has to be rewritten to data area." (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) (ses-cell-set-formula 2 1 '(+ B2 A3)); B3 (ses-command-hook) - (ses-cell-set-formula 3 1 (+ B3 A4)); B4 + (ses-cell-set-formula 3 1 '(+ B3 A4)); B4 (ses-command-hook) (should (equal (ses-cell-references 1 1) '(B3))) (ses-mode) diff --git a/test/lisp/sqlite-tests.el b/test/lisp/sqlite-tests.el new file mode 100644 index 00000000000..d4892a27efc --- /dev/null +++ b/test/lisp/sqlite-tests.el @@ -0,0 +1,51 @@ +;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: +(require 'sqlite) + +(ert-deftest with-sqlite-transaction () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should + (eql 42 (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (should (equal '((1)) (sqlite-select db "select * from test"))) + 42))) + ;; Body runs exactly once. + (should (equal '((1)) (sqlite-select db "select * from test"))))) + +(ert-deftest with-sqlite-transaction/rollback () + (skip-unless (sqlite-available-p)) + (let ((db (sqlite-open))) + (sqlite-execute db "create table test (a)") + (should (equal '(sqlite-error + ("SQL logic error" "no such function: fake" 1 1)) + (should-error + (with-sqlite-transaction db + (sqlite-execute db "insert into test values (1)") + (sqlite-execute db "insert into test values (fake(2))") + 42)))) + ;; First insertion (a=1) rolled back. + (should-not (sqlite-select db "select * from test")))) + +;;; sqlite-tests.el ends here diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index f3a2c5fbe00..fdefca36c0b 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -106,10 +106,14 @@ (insert "foo\n \nbar\n \nbaz") (goto-char (point-min)) (should (equal (page--what-page) '(1 1))) + (forward-char) + (should (equal (page--what-page) '(1 1))) (forward-page) + (should (equal (page--what-page) '(2 1))) + (forward-line) (should (equal (page--what-page) '(2 2))) (forward-page) - (should (equal (page--what-page) '(3 4))))) + (should (equal (page--what-page) '(3 1))))) ;;; page-tests.el ends here diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index ba51f375cc6..e50738f1122 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -92,6 +92,8 @@ ("1@example.com" 1 email "1@example.com") ;; email addresses user portion containing dots ("foo.bar@example.com" 1 email "foo.bar@example.com") + ("foo.bar@example.com" 5 email "foo.bar@example.com") + (" fo.ba@example.com" 6 email "fo.ba@example.com") (".foobar@example.com" 1 email nil) (".foobar@example.com" 2 email "foobar@example.com") ;; email addresses domain portion containing dots and dashes @@ -180,6 +182,13 @@ position to retrieve THING.") (should (thing-at-point-looking-at "2abcd")) (should (equal (match-data) m2))))) +(ert-deftest thing-at-point-looking-at-overlapping-matches () + (with-temp-buffer + (insert "foo.bar.baz") + (goto-char (point-max)) + (should (thing-at-point-looking-at "[a-z]+\\.[a-z]+")) + (should (string= "bar.baz" (match-string 0))))) + (ert-deftest test-symbol-thing-1 () (with-temp-buffer (insert "foo bar zot") diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el index 1a2af716f34..8373156587d 100644 --- a/test/lisp/vc/log-edit-tests.el +++ b/test/lisp/vc/log-edit-tests.el @@ -134,4 +134,214 @@ lines.")))) * a-very-long-directory-name/another-long-directory-name/and-a-long-file-name.ext \(a-really-long-function-name):")))) +(ert-deftest log-edit-fill-entry-confinement () + (let (string string1 string2 string3 string4) + (setq string + ;; This entry is precisely 65 columns in length; + ;; log-edit-fill-column should leave it unmodified. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun1134):" + string1 + ;; This entry is 66 columns in length, and must be filled. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345):" + string2 + ;; The first line of this entry totals 65 columns in length, + ;; and should be preserved intact. + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10, fun11345) +(fun11356):" + string3 + ;; The first defun in this entry is a file name that brings + ;; the total to 40 columns in length and should be preserved + ;; intact. + "* file2.txt (abcdefghijklmnopqrstuvwxyz) +(ABC):" + string4 + ;; The first defun brings that total to 41, and should be + ;; placed on the next line. + "* file2.txt (abcdefghijklmnopqrstuvwxyz):") + (with-temp-buffer + (insert string) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) string)) + (erase-buffer) + (insert string1) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) + "* file2.txt (fun4, fun5, fun6, fun7, fun8, fun9, fun10) +(fun11345):")) + (erase-buffer) + (insert string2) + (let ((fill-column 64)) (log-edit-fill-entry)) + (should (equal (buffer-string) string2)) + (erase-buffer) + (insert string3) + (let ((fill-column 39)) (log-edit-fill-entry)) + (should (equal (buffer-string) string3)) + (erase-buffer) + (insert string4) + (let ((fill-column 39)) (log-edit-fill-entry)) + (should (equal (buffer-string) + ;; There is whitespace after "file2.txt" which + ;; should not be erased! + "* file2.txt +(abcdefghijklmnopqrstuvwxyz):"))))) + +(ert-deftest log-edit-fill-entry-space-substitution () + ;; This test verifies that filling the paragraph surrounding the + ;; last line of defuns does not break between defun lists with + ;; spaces in identifiers. + (let (string wanted) + (setq string " +* src/sfnt.c (xmalloc, xrealloc): Improve behavior upon allocation +failures during test. +(sfnt_table_names): Add prep. +(sfnt_transform_coordinates): Allow applying offsets during +coordinate transform. +(sfnt_decompose_compound_glyph): Defer offset computation until +any component compound glyph is loaded, then apply it during the +transform process. +(sfnt_multiply_divide): Make available everywhere. Implement on +64 bit systems. +(sfnt_multiply_divide_signed): New function. +(sfnt_mul_fixed): Fix division overflow. +(sfnt_curve_to_and_build_1, sfnt_build_glyph_outline): Remove +outdated comment. +(sfnt_build_outline_edges): Fix coding style. +(sfnt_lookup_glyph_metrics): Allow looking up metrics without +scaling. +(struct sfnt_cvt_table): Fix type of cvt values. +(struct sfnt_prep_table): New structure. +(sfnt_read_cvt_table): Read cvt values in terms of fwords, not +longs (as Apple's doc seems to say). +(sfnt_read_fpgm_table): Fix memory allocation for font program +table. +(sfnt_read_prep_table): New function. +(struct sfnt_interpreter_zone): New structure. +(struct sfnt_interpreter_graphics_state): New fields `project', +`move', `vector_dot_product'. Rename to `sfnt_graphics_state'. +(struct sfnt_interpreter, sfnt_mul_f26dot6): Stop doing rounding +division. +(sfnt_init_graphics_state, sfnt_make_interpreter, MOVE, SSW, RAW) +(SDS, ADD, SUB, ABS, NEG, WCVTF, _MIN, S45ROUND, SVTCAx) +(sfnt_set_srounding_state, sfnt_skip_code) +(sfnt_interpret_unimplemented, sfnt_interpret_fdef) +(sfnt_interpret_idef, sfnt_interpret_if, sfnt_interpret_else) +(sfnt_round_none, sfnt_round_to_grid, sfnt_round_to_double_grid) +" + wanted " +* src/sfnt.c +(xmalloc, xrealloc): +Improve behavior +upon allocation +failures during +test. +(sfnt_table_names): +Add prep. +(sfnt_transform_coordinates): +Allow applying +offsets during +coordinate +transform. +(sfnt_decompose_compound_glyph): +Defer offset +computation until +any component +compound glyph is +loaded, then apply +it during the +transform process. +(sfnt_multiply_divide): +Make available +everywhere. +Implement on 64 bit +systems. +(sfnt_multiply_divide_signed): +New function. +(sfnt_mul_fixed): +Fix division +overflow. +(sfnt_curve_to_and_build_1) +(sfnt_build_glyph_outline): +Remove outdated +comment. +(sfnt_build_outline_edges): +Fix coding style. +(sfnt_lookup_glyph_metrics): +Allow looking up +metrics without +scaling. +(struct sfnt_cvt_table): +Fix type of cvt +values. +(struct sfnt_prep_table): +New structure. +(sfnt_read_cvt_table): +Read cvt values in +terms of fwords, not +longs (as Apple's +doc seems to say). +(sfnt_read_fpgm_table): +Fix memory +allocation for font +program table. +(sfnt_read_prep_table): +New function. +(struct sfnt_interpreter_zone): +New structure. +(struct sfnt_interpreter_graphics_state): +New fields +`project', `move', +`vector_dot_product'. +Rename to +`sfnt_graphics_state'. +(struct sfnt_interpreter) +(sfnt_mul_f26dot6): +Stop doing rounding +division. +(sfnt_init_graphics_state) +(sfnt_make_interpreter) +(MOVE, SSW, RAW, SDS) +(ADD, SUB, ABS, NEG) +(WCVTF, _MIN) +(S45ROUND, SVTCAx) +(sfnt_set_srounding_state) +(sfnt_skip_code) +(sfnt_interpret_unimplemented) +(sfnt_interpret_fdef) +(sfnt_interpret_idef) +(sfnt_interpret_if) +(sfnt_interpret_else) +(sfnt_round_none) +(sfnt_round_to_grid) +(sfnt_round_to_double_grid): +") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted))))) + +(ert-deftest log-edit-fill-entry-initial-wrapping () + ;; This test verifies that a newline is inserted before a defun + ;; itself longer than the fill column when such a defun is being + ;; inserted after a file name, and not otherwise. + (let (string wanted) + (setq string " +* src/sfnt.c (long_entry_1): This entry should be placed on a +new line. +(but_this_entry_should_not): With the prose displaced to the +next line instead." + wanted " +* src/sfnt.c +(long_entry_1): This +entry should be +placed on a new +line. +(but_this_entry_should_not): +With the prose +displaced to the +next line instead.") + (with-temp-buffer + (insert string) + (let ((fill-column 20)) (log-edit-fill-entry)) + (should (equal (buffer-string) wanted))))) + ;;; log-edit-tests.el ends here diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index c52cd9c5875..f15a0f52e8c 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert-x) +(require 'vc) (require 'vc-git) (ert-deftest vc-git-test-program-version-general () @@ -81,4 +83,49 @@ (should-not (vc-git-annotate-time)) (should-not (vc-git-annotate-time)))) +(defmacro vc-git-test--with-repo (name &rest body) + "Initialize a repository in a temporary directory and evaluate BODY. + +The current directory will be set to the top of that repository; NAME +will be bound to that directory's file name. Once BODY exits, the +directory will be deleted. + +Some dummy environment variables will be set for the duration of BODY to +allow `git commit' to determine identities for authors and committers." + (declare (indent 1)) + `(ert-with-temp-directory ,name + (let ((default-directory ,name) + (process-environment (append '("EMAIL=john@doe.ee" + "GIT_AUTHOR_NAME=A" + "GIT_COMMITTER_NAME=C") + process-environment))) + (vc-create-repo 'Git) + ,@body))) + +(defun vc-git-test--run (&rest args) + "Run git ARGSā¦, check for non-zero status, and return output." + (with-temp-buffer + (apply 'vc-git-command t 0 nil args) + (buffer-string))) + +(ert-deftest vc-git-test-dir-track-local-branch () + "Test that `vc-dir' works when tracking local branches. Bug#68183." + (skip-unless (executable-find vc-git-program)) + (vc-git-test--with-repo repo + ;; Create an initial commit to get a branch started. + (write-region "hello" nil "README") + (vc-git-test--run "add" "README") + (vc-git-test--run "commit" "-mFirst") + ;; Get current branch name lazily, to remain agnostic of + ;; init.defaultbranch. + (let ((upstream-branch + (string-trim (vc-git-test--run "branch" "--show-current")))) + (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch) + (vc-dir default-directory) + (pcase-dolist (`(,header ,value) + `(("Branch" "hack") + ("Tracking" ,upstream-branch))) + (goto-char (point-min)) + (re-search-forward (format "^%s *: %s$" header value)))))) + ;;; vc-git-tests.el ends here diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh index 5b3fb0e66fb..42a981d312e 100755 --- a/test/manual/indent/shell.sh +++ b/test/manual/indent/shell.sh @@ -189,3 +189,10 @@ bar () { fi } + +case $i { # Bug#55764 + *pattern) + (cd .; echo hi); + do1 ;; + *pattern2) do2 ;; +} diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 4cee084e211..54f339f6373 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -367,11 +367,11 @@ (while (consp insn) (let ((newcar (car insn))) (if (or (consp (car insn)) (comp-mvar-p (car insn))) - (setf newcar (comp-copy-insn (car insn)))) + (setf newcar (comp--copy-insn (car insn)))) (push newcar result)) (setf insn (cdr insn))) (nconc (nreverse result) - (if (comp-mvar-p insn) (comp-copy-insn insn) insn))) + (if (comp-mvar-p insn) (comp--copy-insn insn) insn))) (if (comp-mvar-p insn) (copy-comp-mvar insn) insn))) @@ -559,6 +559,9 @@ (let ((time (make-comp-test-time :unix (time-convert (current-time) 'integer)))) (comp-test-67239-0-f "%F" time))) +(defun comp-test-67883-1-f () + '#1=(1 . #1#)) + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 0aa9e76fa2d..b2fd2f68826 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -28,6 +28,7 @@ (require 'ert) (require 'ert-x) (require 'cl-lib) +(require 'cl-seq) (require 'comp) (require 'comp-cstr) @@ -903,14 +904,33 @@ Return a list of results." (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f))) (should (= (comp-tests-fw-prop-1-f) 6)))) +(defun comp-tests--type-lists-equal (l1 l2) + (and (= (length l1) (length l2)) + (cl-every #'comp-tests--types-equal l1 l2))) + +(defun comp-tests--types-equal (t1 t2) + "Whether the types T1 and T2 are equal." + (or (equal t1 t2) ; for atoms, and optimization for the common case + (and (consp t1) (consp t2) + (eq (car t1) (car t2)) + (cond ((memq (car t1) '(and or member)) + ;; Order or duplicates don't matter. + (null (cl-set-exclusive-or (cdr t1) (cdr t2) + :test #'comp-tests--types-equal))) + ((eq (car t1) 'function) + (and (comp-tests--type-lists-equal (nth 1 t1) (nth 1 t2)) + (comp-tests--types-equal (nth 2 t1) (nth 2 t2)))) + (t (comp-tests--type-lists-equal (cdr t1) (cdr t2))))))) + (defun comp-tests-check-ret-type-spec (func-form ret-type) (let ((lexical-binding t) (native-comp-speed 2) (f-name (cl-second func-form))) (eval func-form t) (native-compile f-name) - (should (equal (cl-third (subr-type (symbol-function f-name))) - ret-type)))) + (should (comp-tests--types-equal + (cl-third (subr-type (symbol-function f-name))) + ret-type)))) (cl-eval-when (compile eval load) (cl-defstruct comp-foo a b) @@ -1476,7 +1496,14 @@ Return a list of results." (if (comp-foo-p x) x (error ""))) - 'comp-foo))) + 'comp-foo) + + ;; 80 + ((defun comp-tests-ret-type-spec-f (x) + (if (functionp x) + (error "") + x)) + '(not function)))) (defun comp-tests-define-type-spec-test (number x) `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 8af7e902109..a1959f62fd3 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -833,4 +833,46 @@ comparing the subr with a much slower Lisp implementation." (should-error (defalias 'data-tests--da-c 'data-tests--da-d) :type 'cyclic-function-indirection)) +(ert-deftest data-tests-bare-symbol () + (dolist (symbols-with-pos-enabled '(nil t)) + (dolist (sym (list nil t 'xyzzy (make-symbol ""))) + (should (eq sym (bare-symbol (position-symbol sym 0))))))) + +(require 'cl-extra) ;For `cl--class-children'. + +(ert-deftest data-tests--cl-type-of () + ;; Make sure that `cl-type-of' returns the most precise type. + ;; Note: This doesn't work for list/vector structs since those types + ;; are too difficult/unreliable to detect (so `cl-type-of' only says + ;; it's a `cons' or a `vector'). + (dolist (val (list -2 10 (expt 2 128) nil t 'car :car + (symbol-function 'car) + (symbol-function 'progn) + (eval '(lambda (x) (+ x 1)) t) + (position-symbol 'car 7) + (position-symbol :car 7))) + (let* ((type (cl-type-of val)) + (class (cl-find-class type)) + (alltypes (cl--class-allparents class)) + ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'. + ;; (e.g. `symbolp' returns nil on a sympos if that var is nil). + (symbols-with-pos-enabled t)) + (dolist (parent alltypes) + (should (cl-typep val parent)) + (dolist (subtype (cl--class-children (cl-find-class parent))) + (when (and (not (memq subtype alltypes)) + (built-in-class-p (cl-find-class subtype)) + (not (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser)))) + (cond + ((eq subtype 'function) (cl-functionp val)) + (t (should-not (cl-typep val subtype)))))))))) + + ;;; data-tests.el ends here diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 06049364b1e..3aafae1b896 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -33,9 +33,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef WINDOWSNT /* Cannot include <process.h> because of the local header by the same name, sigh. */ -uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); +uintptr_t _beginthread (void (__cdecl *) (void *), unsigned, void *); # if !defined __x86_64__ -# define ALIGN_STACK __attribute__((force_align_arg_pointer)) +# define ALIGN_STACK __attribute__ ((force_align_arg_pointer)) # endif # include <windows.h> /* for Sleep */ #else /* !WINDOWSNT */ diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index b82d4a36304..052fd83dc85 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -114,15 +114,14 @@ changes." (ert-deftest mod-test-non-local-exit-signal-test () (should-error (mod-test-signal)) - (let (debugger-args backtrace) + (let (handler-err backtrace) (should-error - (let ((debugger (lambda (&rest args) - (setq debugger-args args - backtrace (with-output-to-string (backtrace))) - (cl-incf num-nonmacro-input-events))) - (debug-on-signal t)) + (handler-bind + ((error (lambda (err) + (setq handler-err err + backtrace (with-output-to-string (backtrace)))))) (mod-test-signal))) - (should (equal debugger-args '(error (error . 56)))) + (should (equal handler-err '(error . 56))) (should (string-match-p (rx bol " mod-test-signal()" eol) backtrace)))) @@ -316,7 +315,7 @@ local reference." (replace-match "`src/emacs-module-resources/")) (should (equal (buffer-substring-no-properties 1 (point-max)) - (format "a module function in `src/emacs-module-resources/mod-test%s'. + (format "a module-function in `src/emacs-module-resources/mod-test%s'. (mod-test-sum a b) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e4b18ec7849..187dc2f34d5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,25 +282,85 @@ expressions works for identifiers starting with period." (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) -(defvar eval-tests/global-var 'value) -(defvar-local eval-tests/buffer-local-var 'value) +(defvar eval-tests/global-var 'global-value) +(defvar-local eval-tests/buffer-local-var 'default-value) (ert-deftest eval-tests/default-value () ;; `let' overrides the default value for global variables. (should (default-boundp 'eval-tests/global-var)) - (should (eq 'value (default-value 'eval-tests/global-var))) - (should (eq 'value eval-tests/global-var)) - (let ((eval-tests/global-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/global-var))) - (should (eq 'bar eval-tests/global-var))) + (should (eq 'global-value (default-value 'eval-tests/global-var))) + (should (eq 'global-value eval-tests/global-var)) + (let ((eval-tests/global-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/global-var))) + (should (eq 'let-value eval-tests/global-var))) ;; `let' overrides the default value everywhere, but leaves ;; buffer-local values unchanged in current buffer and in the ;; buffers where there is no explicitly set buffer-local value. (should (default-boundp 'eval-tests/buffer-local-var)) - (should (eq 'value (default-value 'eval-tests/buffer-local-var))) - (should (eq 'value eval-tests/buffer-local-var)) + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)) (with-temp-buffer - (let ((eval-tests/buffer-local-var 'bar)) - (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) - (should (eq 'bar eval-tests/buffer-local-var))))) + (let ((eval-tests/buffer-local-var 'let-value)) + (should (eq 'let-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)))) + ;; When current buffer has explicit buffer-local binding, `let' does + ;; not alter the default binding. + (with-temp-buffer + (setq-local eval-tests/buffer-local-var 'local-value) + (let ((eval-tests/buffer-local-var 'let-value)) + ;; Let in a buffer with local binding does not change the + ;; default value for variable. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'let-value eval-tests/buffer-local-var)) + (with-temp-buffer + ;; We are in a new buffer - `eval-tests/buffer-local-var' has its global default value. + (should (eq 'default-value (default-value 'eval-tests/buffer-local-var))) + (should (eq 'default-value eval-tests/buffer-local-var)))))) + +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + +(ert-deftest eval-tests--error-id () + (let* (inner-error + (outer-error + (condition-case err + (handler-bind ((error (lambda (err) (setq inner-error err)))) + (car 1)) + (error err)))) + (should (eq inner-error outer-error)))) + ;;; eval-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3893b8b0320..1b13785a9fc 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -375,6 +375,49 @@ (should (equal (should-error (sort "cba" #'<) :type 'wrong-type-argument) '(wrong-type-argument list-or-vector-p "cba")))) +(defun fns-tests--shuffle-vector (vect) + "Shuffle VECT in place." + (let ((n (length vect))) + (dotimes (i (1- n)) + (let* ((j (+ i (random (- n i)))) + (vi (aref vect i))) + (aset vect i (aref vect j)) + (aset vect j vi))))) + +(ert-deftest fns-tests-sort-kw () + ;; Test the `sort' keyword calling convention by comparing with + ;; the results from using the old (positional) style tested above. + (random "my seed") + (dolist (size '(0 1 2 3 10 100 1000)) + ;; Use a vector with both positive and negative numbers (asymmetric). + (let ((numbers (vconcat + (number-sequence (- (/ size 3)) (- size 1 (/ size 3)))))) + (fns-tests--shuffle-vector numbers) + ;; Test both list and vector input. + (dolist (input (list (append numbers nil) numbers)) + (dolist (in-place '(nil t)) + (dolist (reverse '(nil t)) + (dolist (key '(nil abs)) + (dolist (lessp '(nil >)) + (let* ((seq (copy-sequence input)) + (res (sort seq :key key :lessp lessp + :in-place in-place :reverse reverse)) + (pred (or lessp #'value<)) + (exp-in (copy-sequence input)) + (exp-out + (sort (if reverse (reverse exp-in) exp-in) + (if key + (lambda (a b) + (funcall pred + (funcall key a) (funcall key b))) + pred))) + (expected (if reverse (reverse exp-out) exp-out))) + (should (equal res expected)) + (if in-place + (should (eq res seq)) + (should-not (and (> size 0) (eq res seq))) + (should (equal seq input)))))))))))) + (defvar w32-collate-ignore-punctuation) (ert-deftest fns-tests-collate-sort () @@ -1097,6 +1140,16 @@ (should (= (sxhash-equal (record 'a (make-string 10 ?a))) (sxhash-equal (record 'a (make-string 10 ?a)))))) +(ert-deftest fns--define-hash-table-test () + ;; Check that we can have two differently-named tests using the + ;; same functions (bug#68668). + (define-hash-table-test 'fns-tests--1 'my-cmp 'my-hash) + (define-hash-table-test 'fns-tests--2 'my-cmp 'my-hash) + (let ((h1 (make-hash-table :test 'fns-tests--1)) + (h2 (make-hash-table :test 'fns-tests--2))) + (should (eq (hash-table-test h1) 'fns-tests--1)) + (should (eq (hash-table-test h2) 'fns-tests--2)))) + (ert-deftest test-secure-hash () (should (equal (secure-hash 'md5 "foobar") "3858f62230ac3c915f300c664312c63f")) @@ -1503,4 +1556,222 @@ (should-error (copy-alist "abc") :type 'wrong-type-argument)) +(ert-deftest fns-value<-ordered () + ;; values (X . Y) where X<Y + (let* ((big (* 10 most-positive-fixnum)) + (buf1 (get-buffer-create " *one*")) + (buf2 (get-buffer-create " *two*")) + (buf3 (get-buffer-create " *three*")) + (_ (progn (with-current-buffer buf1 (insert (make-string 20 ?a))) + (with-current-buffer buf2 (insert (make-string 20 ?b))))) + (mark1 (set-marker (make-marker) 12 buf1)) + (mark2 (set-marker (make-marker) 13 buf1)) + (mark3 (set-marker (make-marker) 12 buf2)) + (mark4 (set-marker (make-marker) 13 buf2)) + (proc1 (make-pipe-process :name " *proc one*")) + (proc2 (make-pipe-process :name " *proc two*"))) + (kill-buffer buf3) + (unwind-protect + (dolist (c + `( + ;; fixnums + (1 . 2) (-2 . -1) (-2 . 1) (-1 . 2) + ;; bignums + (,big . ,(1+ big)) (,(- big) . ,big) + (,(- -1 big) . ,(- big)) + ;; fixnums/bignums + (1 . ,big) (-1 . ,big) (,(- big) . -1) (,(- big) . 1) + ;; floats + (1.5 . 1.6) (-1.3 . -1.2) (-13.0 . 12.0) + ;; floats/fixnums + (1 . 1.1) (1.9 . 2) (-2.0 . 1) (-2 . 1.0) + ;; floats/bignums + (,big . ,(float (* 2 big))) (,(float big) . ,(* 2 big)) + ;; symbols + (a . b) (nil . nix) (b . ba) (## . a) (A . a) + (#:a . #:b) (a . #:b) (#:a . b) + ;; strings + ("" . "a") ("a" . "b") ("A" . "a") ("abc" . "abd") + ("b" . "ba") + + ;; lists + ((1 2 3) . (2 3 4)) ((2) . (2 1)) (() . (0)) + ((1 2 3) . (1 3)) ((1 2 3) . (1 3 2)) + (((b a) (c d) e) . ((b a) (c d) f)) + (((b a) (c D) e) . ((b a) (c d) e)) + (((b a) (c d () x) e) . ((b a) (c d (1) x) e)) + ((1 . 2) . (1 . 3)) ((1 2 . 3) . (1 2 . 4)) + + ;; vectors + ([1 2 3] . [2 3 4]) ([2] . [2 1]) ([] . [0]) + ([1 2 3] . [1 3]) ([1 2 3] . [1 3 2]) + ([[b a] [c d] e] . [[b a] [c d] f]) + ([[b a] [c D] e] . [[b a] [c d] e]) + ([[b a] [c d [] x] e] . [[b a] [c d [1] x] e]) + + ;; bool-vectors + (,(bool-vector) . ,(bool-vector nil)) + (,(bool-vector nil) . ,(bool-vector t)) + (,(bool-vector t nil t nil) . ,(bool-vector t nil t t)) + (,(bool-vector t nil t) . ,(bool-vector t nil t nil)) + + ;; records + (#s(a 2 3) . #s(b 3 4)) (#s(b) . #s(b a)) + (#s(a 2 3) . #s(a 3)) (#s(a 2 3) . #s(a 3 2)) + (#s(#s(b a) #s(c d) e) . #s(#s(b a) #s(c d) f)) + (#s(#s(b a) #s(c D) e) . #s(#s(b a) #s(c d) e)) + (#s(#s(b a) #s(c d #s(u) x) e) + . #s(#s(b a) #s(c d #s(v) x) e)) + + ;; markers + (,mark1 . ,mark2) (,mark1 . ,mark3) (,mark1 . ,mark4) + (,mark2 . ,mark3) (,mark2 . ,mark4) (,mark3 . ,mark4) + + ;; buffers + (,buf1 . ,buf2) (,buf3 . ,buf1) (,buf3 . ,buf2) + + ;; processes + (,proc1 . ,proc2) + )) + (let ((x (car c)) + (y (cdr c))) + (should (value< x y)) + (should-not (value< y x)) + (should-not (value< x x)) + (should-not (value< y y)))) + + (delete-process proc2) + (delete-process proc1) + (kill-buffer buf2) + (kill-buffer buf1)))) + +(ert-deftest fns-value<-unordered () + ;; values (X . Y) where neither X<Y nor Y<X + + (let ((buf1 (get-buffer-create " *one*")) + (buf2 (get-buffer-create " *two*"))) + (kill-buffer buf2) + (kill-buffer buf1) + (dolist (c `( + ;; numbers + (0 . 0.0) (0 . -0.0) (0.0 . -0.0) + + ;; symbols + (a . #:a) + + ;; (dead) buffers + (,buf1 . ,buf2) + + ;; unordered types + (,(make-hash-table) . ,(make-hash-table)) + (,(obarray-make) . ,(obarray-make)) + ;; FIXME: more? + )) + (let ((x (car c)) + (y (cdr c))) + (should-not (value< x y)) + (should-not (value< y x)))))) + +(ert-deftest fns-value<-type-mismatch () + ;; values of disjoint (incomparable) types + (let ((incomparable + `( 1 a "a" (a b) [a b] ,(bool-vector nil t) #s(a b) + ,(make-char-table 'test) + ,(make-hash-table) + ,(obarray-make) + ;; FIXME: more? + ))) + (let ((tail incomparable)) + (while tail + (let ((x (car tail))) + (dolist (y (cdr tail)) + (should-error (value< x y) :type 'type-mismatch) + (should-error (value< y x) :type 'type-mismatch))) + (setq tail (cdr tail)))))) + +(ert-deftest fns-value<-symbol-with-pos () + ;; values (X . Y) where X<Y + (let* ((a-sp-1 (position-symbol 'a 1)) + (a-sp-2 (position-symbol 'a 2)) + (b-sp-1 (position-symbol 'b 1)) + (b-sp-2 (position-symbol 'b 2))) + + (dolist (swp '(nil t)) + (let ((symbols-with-pos-enabled swp)) + ;; Enabled or not, they compare by name. + (dolist (c `((,a-sp-1 . ,b-sp-1) (,a-sp-1 . ,b-sp-2) + (,a-sp-2 . ,b-sp-1) (,a-sp-2 . ,b-sp-2))) + (let ((x (car c)) + (y (cdr c))) + (should (value< x y)) + (should-not (value< y x)) + (should-not (value< x x)) + (should-not (value< y y)))) + (should-not (value< a-sp-1 a-sp-2)) + (should-not (value< a-sp-2 a-sp-1)))) + + ;; When disabled, symbol-with-pos and symbols do not compare. + (should-error (value< a-sp-1 'a) :type 'type-mismatch) + (should-error (value< 'a a-sp-1) :type 'type-mismatch) + + (let ((symbols-with-pos-enabled t)) + ;; When enabled, a symbol-with-pos compares as a plain symbol. + (dolist (c `((,a-sp-1 . b) (a . ,b-sp-1))) + (let ((x (car c)) + (y (cdr c))) + (should (value< x y)) + (should-not (value< y x)) + (should-not (value< x x)) + (should-not (value< y y)))) + (should-not (value< a-sp-1 'a)) + (should-not (value< 'a a-sp-1))))) + +(ert-deftest fns-value<-circle () + ;; Check that we at least don't hang when comparing two circular lists. + (let ((a (number-sequence 1 5)) + (b (number-sequence 1 5))) + (setcdr (last a) (nthcdr 2 a)) + (setcdr (last b) (nthcdr 2 b)) + (should-error (value< a b :type 'circular)) + (should-error (value< b a :type 'circular)))) + +(ert-deftest fns-value<-bool-vector () + ;; More thorough test of `value<' for bool-vectors. + (random "my seed") + (dolist (na '(0 1 5 8 9 32 63 64 65 200 1001 1024)) + (let ((a (make-bool-vector na nil))) + (dotimes (i na) + (aset a i (zerop (random 2)))) + (dolist (nb '(0 1 5 8 9 32 63 64 65 200 1001 1024)) + (when (<= nb na) + (let ((b (make-bool-vector nb nil))) + (dotimes (i nb) + (aset b i (aref a i))) + ;; `b' is now a prefix of `a'. + (should-not (value< a b)) + (cond ((= nb na) + (should (equal a b)) + (should-not (value< b a))) + (t + (should-not (equal a b)) + (should (value< b a)))) + (unless (zerop nb) + ;; Flip random bits in `b' and check how it affects the order. + (dotimes (_ 3) + (let ((i (random nb))) + (let ((val (aref b i))) + (aset b i (not val)) + (should-not (equal a b)) + (cond + (val + ;; t -> nil: `b' is now always a proper prefix of `a'. + (should-not (value< a b)) + (should (value< b a))) + (t + ;; nil -> t: `a' is now less than `b'. + (should (value< a b)) + (should-not (value< b a)))) + ;; Undo the flip. + (aset b i val))))))))))) + ;;; fns-tests.el ends here diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index bc9977f31bf..04b897045db 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (defun keymap-tests--make-keymap-test (fun) (should (eq (car (funcall fun)) 'keymap)) @@ -470,10 +471,18 @@ g .. h foo ert-keymap-duplicate "a" #'next-line "a" #'previous-line)) - (should-error - (define-keymap - "a" #'next-line - "a" #'previous-line))) + (let ((msg "")) + ;; FIXME: It would be nicer to use `current-message' rather than override + ;; `message', but `current-message' returns always nil in batch mode :-( + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (should + (string-match "duplicate" + (progn + (define-keymap + "a" #'next-line + "a" #'previous-line) + msg)))))) (ert-deftest keymap-unset-test-remove-and-inheritance () "Check various behaviors of keymap-unset. (Bug#62207)" diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 14d160df25c..99d522d1856 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -34,7 +34,7 @@ (let ((num 0)) (mapcar (lambda (str) (cons str (cl-incf num))) list))) (defun minibuf-tests--strings-to-obarray (list) - (let ((ob (make-vector 7 0))) + (let ((ob (obarray-make 7))) (mapc (lambda (str) (intern str ob)) list) ob)) (defun minibuf-tests--strings-to-string-hashtable (list) @@ -61,6 +61,9 @@ ;;; Testing functions that are agnostic to type of COLLECTION. +(defun minibuf-tests--set-equal (a b) + (null (cl-set-exclusive-or a b :test #'equal))) + (defun minibuf-tests--try-completion (xform-collection) (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) @@ -101,7 +104,8 @@ (let* ((abcdef (funcall xform-collection '("abc" "def"))) (+abba (funcall xform-collection '("abc" "abba" "def")))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil)))) @@ -111,7 +115,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def"))) (+abba-member (funcall collection-member +abba))) (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) - (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba +abba-member) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) (should (equal (all-completions "abcd" +abba +abba-member) nil)) (should-not (all-completions "a" abcdef #'ignore)) @@ -124,7 +129,8 @@ (+abba (funcall xform-collection '("abc" "abba" "def")))) (let ((completion-regexp-list '("."))) (should (equal (all-completions "a" abcdef) '("abc"))) - (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (minibuf-tests--set-equal (all-completions "a" +abba) + '("abc" "abba"))) (should (equal (all-completions "abc" +abba) '("abc"))) (should (equal (all-completions "abcd" +abba) nil))) (let ((completion-regexp-list '("X"))) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index aedaa9a4e06..ff3a6fe7483 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -369,13 +369,6 @@ otherwise, use a different charset." (should (string-match - "data ()" - (let ((h (make-hash-table))) - (let ((print-length 0)) - (format "%S" h))))) - - (should - (string-match "data (99 99)" (let ((h (make-hash-table))) (dotimes (i 100) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index a89bf1298c0..bdc9630c783 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -254,7 +254,7 @@ (should (eq nil (treesit-node-text (treesit-search-subtree subarray "\\[")))) - ;; If ALL=nil, searching for number should still find the + ;; If ALL=t, searching for number should still find the ;; numbers. (should (equal "1" (treesit-node-text (treesit-search-subtree |