diff options
| author | Yuuki Harano | 2021-01-10 18:49:51 +0900 |
|---|---|---|
| committer | Yuuki Harano | 2021-01-10 18:49:51 +0900 |
| commit | aac33a8074c41354ffdb1236a342da16dca4a1bc (patch) | |
| tree | 3a99478549f66d3f93a282e29d2c302995a86a49 /test | |
| parent | 78fd106653a9e4fa7c9c3c9788540e2e15552254 (diff) | |
| parent | 690cf6b8d8b8827f046bc1e24b2e556afeff976c (diff) | |
| download | emacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.tar.gz emacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.zip | |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
Diffstat (limited to 'test')
| -rw-r--r-- | test/Makefile.in | 6 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el | 7 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 3 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 23 | ||||
| -rw-r--r-- | test/lisp/filenotify-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/gnus/mm-decode-resources/8bit-multipart.bin | 20 | ||||
| -rw-r--r-- | test/lisp/gnus/mm-decode-tests.el | 89 | ||||
| -rw-r--r-- | test/lisp/help-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 18 | ||||
| -rw-r--r-- | test/lisp/progmodes/cperl-mode-resources/here-docs.pl | 143 | ||||
| -rw-r--r-- | test/lisp/progmodes/cperl-mode-tests.el | 32 | ||||
| -rw-r--r-- | test/lisp/progmodes/ruby-mode-tests.el | 3 | ||||
| -rw-r--r-- | test/lisp/progmodes/xref-tests.el | 38 | ||||
| -rw-r--r-- | test/lisp/subr-tests.el | 38 | ||||
| -rw-r--r-- | test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin | 9 | ||||
| -rw-r--r-- | test/lisp/textmodes/paragraphs-tests.el | 23 | ||||
| -rw-r--r-- | test/lisp/wid-edit-tests.el | 21 | ||||
| -rw-r--r-- | test/src/keymap-tests.el | 12 | ||||
| -rw-r--r-- | test/src/process-tests.el | 23 |
19 files changed, 490 insertions, 22 deletions
diff --git a/test/Makefile.in b/test/Makefile.in index 8aa37ca7854..fc40dad5e2e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in | |||
| @@ -161,11 +161,15 @@ endif | |||
| 161 | 161 | ||
| 162 | ## Save logs, and show logs for failed tests. | 162 | ## Save logs, and show logs for failed tests. |
| 163 | WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } | 163 | WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } |
| 164 | ## On Hydra or Emba, always show logs for certain problematic tests. | ||
| 164 | ifdef EMACS_HYDRA_CI | 165 | ifdef EMACS_HYDRA_CI |
| 165 | ## On Hydra, always show logs for certain problematic tests. | ||
| 166 | lisp/net/tramp-tests.log \ | 166 | lisp/net/tramp-tests.log \ |
| 167 | : WRITE_LOG = 2>&1 | tee $@ | 167 | : WRITE_LOG = 2>&1 | tee $@ |
| 168 | endif | 168 | endif |
| 169 | ifdef EMACS_EMBA_CI | ||
| 170 | lisp/filenotify-tests.log lisp/net/tramp-tests.log \ | ||
| 171 | : WRITE_LOG = 2>&1 | tee $@ | ||
| 172 | endif | ||
| 169 | 173 | ||
| 170 | ifeq ($(TEST_LOAD_EL), yes) | 174 | ifeq ($(TEST_LOAD_EL), yes) |
| 171 | testloadfile = $*.el | 175 | testloadfile = $*.el |
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el new file mode 100644 index 00000000000..e65a541e6e3 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el | |||
| @@ -0,0 +1,7 @@ | |||
| 1 | ;;; -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | (make-obsolete-variable 'bytecomp--tests-obsolete-var-2 nil "99.99") | ||
| 4 | |||
| 5 | (defun foo () | ||
| 6 | (let ((bytecomp--tests-obsolete-var-2 2)) | ||
| 7 | bytecomp--tests-obsolete-var-2)) | ||
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5e5f99dbdab..a07af188fac 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -625,6 +625,9 @@ Subtests signal errors if something goes wrong." | |||
| 625 | (bytecomp--define-warning-file-test "warn-obsolete-variable.el" | 625 | (bytecomp--define-warning-file-test "warn-obsolete-variable.el" |
| 626 | "bytecomp--tests-obs.*obsolete.*99.99") | 626 | "bytecomp--tests-obs.*obsolete.*99.99") |
| 627 | 627 | ||
| 628 | (bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" | ||
| 629 | "bytecomp--tests-obs.*obsolete.*99.99" t) | ||
| 630 | |||
| 628 | (bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el" | 631 | (bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el" |
| 629 | "as both function and macro") | 632 | "as both function and macro") |
| 630 | 633 | ||
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 446983c2e3e..bcd63f73a3c 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el | |||
| @@ -610,4 +610,27 @@ collection clause." | |||
| 610 | ;; Just make sure the function can be instrumented. | 610 | ;; Just make sure the function can be instrumented. |
| 611 | (edebug-defun))) | 611 | (edebug-defun))) |
| 612 | 612 | ||
| 613 | ;;; cl-labels | ||
| 614 | |||
| 615 | (ert-deftest cl-macs--labels () | ||
| 616 | ;; Simple recursive function. | ||
| 617 | (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0))) | ||
| 618 | (should (equal (len (make-list 42 t)) 42))) | ||
| 619 | |||
| 620 | ;; Simple tail-recursive function. | ||
| 621 | (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) | ||
| 622 | (should (equal (len (make-list 42 t) 0) 42)) | ||
| 623 | ;; Should not bump into stack depth limits. | ||
| 624 | (should (equal (len (make-list 42000 t) 0) 42000))) | ||
| 625 | |||
| 626 | ;; Check that non-recursive functions are handled more efficiently. | ||
| 627 | (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) | ||
| 628 | (`(let* ,_ (funcall ,_ 5)) t))) | ||
| 629 | |||
| 630 | ;; Case of "tail-recursive lambdas". | ||
| 631 | (should (pcase (macroexpand | ||
| 632 | '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) | ||
| 633 | #'len)) | ||
| 634 | (`(function (lambda (,_ ,_) . ,_)) t)))) | ||
| 635 | |||
| 613 | ;;; cl-macs-tests.el ends here | 636 | ;;; cl-macs-tests.el ends here |
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 047109a96a2..d73b072661a 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el | |||
| @@ -1265,7 +1265,7 @@ delivered." | |||
| 1265 | ;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 | 1265 | ;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 |
| 1266 | (file-notify--deftest-remote file-notify-test07-many-events | 1266 | (file-notify--deftest-remote file-notify-test07-many-events |
| 1267 | "Check that events are not dropped for remote directories." | 1267 | "Check that events are not dropped for remote directories." |
| 1268 | (getenv "EMACS_HYDRA_CI")) | 1268 | (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))) |
| 1269 | 1269 | ||
| 1270 | (ert-deftest file-notify-test08-backup () | 1270 | (ert-deftest file-notify-test08-backup () |
| 1271 | "Check that backup keeps file notification." | 1271 | "Check that backup keeps file notification." |
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin new file mode 100644 index 00000000000..0b193a27234 --- /dev/null +++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin | |||
| @@ -0,0 +1,20 @@ | |||
| 1 | From: example <example@example.org> | ||
| 2 | To: example <example@example.org> | ||
| 3 | Content-Type: multipart/alternative; boundary="===============2877195075946974246==" | ||
| 4 | Date: Thu, 29 Oct 2020 14:47:55 +0100 | ||
| 5 | MIME-Version: 1.0 | ||
| 6 | Subject: test | ||
| 7 | |||
| 8 | --===============2877195075946974246== | ||
| 9 | Content-Type: text/plain; charset="utf-8" | ||
| 10 | Content-Transfer-Encoding: 8bit | ||
| 11 | |||
| 12 | ääää | ||
| 13 | |||
| 14 | --===============2877195075946974246== | ||
| 15 | Content-Type: text/html; charset="utf-8" | ||
| 16 | Content-Transfer-Encoding: 8bit | ||
| 17 | |||
| 18 | <!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"></head><body>ääää</body></html> | ||
| 19 | |||
| 20 | --===============2877195075946974246==-- | ||
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el new file mode 100644 index 00000000000..74591f919da --- /dev/null +++ b/test/lisp/gnus/mm-decode-tests.el | |||
| @@ -0,0 +1,89 @@ | |||
| 1 | ;;; mm-decode-tests.el --- -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2021 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 10 | ;; any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'ert-x) | ||
| 26 | (require 'mm-decode) | ||
| 27 | |||
| 28 | (ert-deftest test-mm-dissect-buffer () | ||
| 29 | (with-temp-buffer | ||
| 30 | (set-buffer-multibyte nil) | ||
| 31 | (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin")) | ||
| 32 | (while (search-forward "\r\n" nil t) | ||
| 33 | (replace-match "\n")) | ||
| 34 | (let ((handle (mm-dissect-buffer))) | ||
| 35 | (should (equal (mm-handle-media-type handle) "multipart/alternative")) | ||
| 36 | ;; Skip multipart type. | ||
| 37 | (pop handle) | ||
| 38 | (let ((part (pop handle))) | ||
| 39 | (should (equal (mm-handle-media-type part) "text/plain")) | ||
| 40 | (should (eq (mm-handle-encoding part) '8bit)) | ||
| 41 | (with-current-buffer (mm-handle-buffer part) | ||
| 42 | (should (equal (decode-coding-string | ||
| 43 | (buffer-string) | ||
| 44 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 45 | 'charset))) | ||
| 46 | "ääää\n")))) | ||
| 47 | (let ((part (pop handle))) | ||
| 48 | (should (equal (mm-handle-media-type part) "text/html")) | ||
| 49 | (should (eq (mm-handle-encoding part) '8bit)) | ||
| 50 | (with-current-buffer (mm-handle-buffer part) | ||
| 51 | (should (equal (decode-coding-string | ||
| 52 | (buffer-string) | ||
| 53 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 54 | 'charset))) | ||
| 55 | "<!doctype html><html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\"></head><body>ääää</body></html>\n"))))))) | ||
| 56 | |||
| 57 | (ert-deftest test-mm-with-part-unibyte () | ||
| 58 | (with-temp-buffer | ||
| 59 | (set-buffer-multibyte nil) | ||
| 60 | (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin")) | ||
| 61 | (while (search-forward "\r\n" nil t) | ||
| 62 | (replace-match "\n")) | ||
| 63 | (let ((handle (mm-dissect-buffer))) | ||
| 64 | (pop handle) | ||
| 65 | (let ((part (pop handle))) | ||
| 66 | (should (equal (decode-coding-string | ||
| 67 | (mm-with-part part | ||
| 68 | (buffer-string)) | ||
| 69 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 70 | 'charset))) | ||
| 71 | "ääää\n")))))) | ||
| 72 | |||
| 73 | (ert-deftest test-mm-with-part-multibyte () | ||
| 74 | (with-temp-buffer | ||
| 75 | (set-buffer-multibyte t) | ||
| 76 | (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin")) | ||
| 77 | (while (search-forward "\r\n" nil t) | ||
| 78 | (replace-match "\n")) | ||
| 79 | (let ((handle (mm-dissect-buffer))) | ||
| 80 | (pop handle) | ||
| 81 | (let ((part (pop handle))) | ||
| 82 | (should (equal (decode-coding-string | ||
| 83 | (mm-with-part part | ||
| 84 | (buffer-string)) | ||
| 85 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 86 | 'charset))) | ||
| 87 | "ääää\n")))))) | ||
| 88 | |||
| 89 | ;;; mm-decode-tests.el ends here | ||
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 95557c95eb7..835d9fe7949 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el | |||
| @@ -102,7 +102,7 @@ RET minibuffer-complete-and-exit | |||
| 102 | ESC Prefix Command | 102 | ESC Prefix Command |
| 103 | SPC minibuffer-complete-word | 103 | SPC minibuffer-complete-word |
| 104 | ? minibuffer-completion-help | 104 | ? minibuffer-completion-help |
| 105 | <C-tab> file-cache-minibuffer-complete | 105 | C-<tab> file-cache-minibuffer-complete |
| 106 | <XF86Back> previous-history-element | 106 | <XF86Back> previous-history-element |
| 107 | <XF86Forward> next-history-element | 107 | <XF86Forward> next-history-element |
| 108 | <down> next-line-or-history-element | 108 | <down> next-line-or-history-element |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 896b9978e7c..e1cb9939f29 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -4670,7 +4670,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 4670 | 4670 | ||
| 4671 | (ert-deftest tramp-test31-interrupt-process () | 4671 | (ert-deftest tramp-test31-interrupt-process () |
| 4672 | "Check `interrupt-process'." | 4672 | "Check `interrupt-process'." |
| 4673 | :tags (if (getenv "EMACS_EMBA_CI") | 4673 | :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) |
| 4674 | '(:expensive-test :unstable) '(:expensive-test)) | 4674 | '(:expensive-test :unstable) '(:expensive-test)) |
| 4675 | (skip-unless (tramp--test-enabled)) | 4675 | (skip-unless (tramp--test-enabled)) |
| 4676 | (skip-unless (tramp--test-sh-p)) | 4676 | (skip-unless (tramp--test-sh-p)) |
| @@ -5787,7 +5787,8 @@ This requires restrictions of file name syntax." | |||
| 5787 | (tmp-name2 (tramp--test-make-temp-name 'local quoted)) | 5787 | (tmp-name2 (tramp--test-make-temp-name 'local quoted)) |
| 5788 | (files (delq nil files)) | 5788 | (files (delq nil files)) |
| 5789 | (process-environment process-environment) | 5789 | (process-environment process-environment) |
| 5790 | (sorted-files (sort (copy-sequence files) #'string-lessp))) | 5790 | (sorted-files (sort (copy-sequence files) #'string-lessp)) |
| 5791 | buffer) | ||
| 5791 | (unwind-protect | 5792 | (unwind-protect |
| 5792 | (progn | 5793 | (progn |
| 5793 | (make-directory tmp-name1) | 5794 | (make-directory tmp-name1) |
| @@ -5849,6 +5850,18 @@ This requires restrictions of file name syntax." | |||
| 5849 | tmp-name2 nil directory-files-no-dot-files-regexp)) | 5850 | tmp-name2 nil directory-files-no-dot-files-regexp)) |
| 5850 | sorted-files)) | 5851 | sorted-files)) |
| 5851 | 5852 | ||
| 5853 | ;; Check, that `insert-directory' works properly. | ||
| 5854 | (with-current-buffer | ||
| 5855 | (setq buffer (dired-noselect tmp-name1 "--dired -al")) | ||
| 5856 | (goto-char (point-min)) | ||
| 5857 | (while (not (eobp)) | ||
| 5858 | (when-let ((name (dired-get-filename 'localp 'no-error))) | ||
| 5859 | (unless | ||
| 5860 | (string-match-p name directory-files-no-dot-files-regexp) | ||
| 5861 | (should (member name files)))) | ||
| 5862 | (forward-line 1))) | ||
| 5863 | (kill-buffer buffer) | ||
| 5864 | |||
| 5852 | ;; `substitute-in-file-name' could return different | 5865 | ;; `substitute-in-file-name' could return different |
| 5853 | ;; values. For `adb', there could be strange file | 5866 | ;; values. For `adb', there could be strange file |
| 5854 | ;; permissions preventing overwriting a file. We don't | 5867 | ;; permissions preventing overwriting a file. We don't |
| @@ -5944,6 +5957,7 @@ This requires restrictions of file name syntax." | |||
| 5944 | (regexp-quote (getenv envvar)))))))))) | 5957 | (regexp-quote (getenv envvar)))))))))) |
| 5945 | 5958 | ||
| 5946 | ;; Cleanup. | 5959 | ;; Cleanup. |
| 5960 | (ignore-errors (kill-buffer buffer)) | ||
| 5947 | (ignore-errors (delete-directory tmp-name1 'recursive)) | 5961 | (ignore-errors (delete-directory tmp-name1 'recursive)) |
| 5948 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) | 5962 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) |
| 5949 | 5963 | ||
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl new file mode 100644 index 00000000000..8af4625fff3 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl | |||
| @@ -0,0 +1,143 @@ | |||
| 1 | use 5.020; | ||
| 2 | |||
| 3 | =head1 NAME | ||
| 4 | |||
| 5 | here-docs.pl - resource file for cperl-test-here-docs | ||
| 6 | |||
| 7 | =head1 DESCRIPTION | ||
| 8 | |||
| 9 | This file holds a couple of HERE documents, with a variety of normal | ||
| 10 | and edge cases. For a formatted view of this description, run: | ||
| 11 | |||
| 12 | (cperl-perldoc "here-docs.pl") | ||
| 13 | |||
| 14 | For each of the HERE documents, the following checks will done: | ||
| 15 | |||
| 16 | =over 4 | ||
| 17 | |||
| 18 | =item * | ||
| 19 | |||
| 20 | All occurrences of the string "look-here" are fontified correcty. | ||
| 21 | Note that we deliberately test the face, not the syntax property: | ||
| 22 | Users won't care for the syntax property, but they see the face. | ||
| 23 | Different implementations with different syntax properties have been | ||
| 24 | seen in the past. | ||
| 25 | |||
| 26 | =item * | ||
| 27 | |||
| 28 | Indentation of the line(s) containing "look-here" is 0, i.e. there are no | ||
| 29 | leading spaces. | ||
| 30 | |||
| 31 | =item * | ||
| 32 | |||
| 33 | Indentation of the following perl statement containing "indent" should | ||
| 34 | be 0 if the statement contains "noindent", and according to the mode's | ||
| 35 | continued-statement-offset otherwise. | ||
| 36 | |||
| 37 | =back | ||
| 38 | |||
| 39 | =cut | ||
| 40 | |||
| 41 | # Prologue to make the test file valid without warnings | ||
| 42 | |||
| 43 | my $text; | ||
| 44 | my $any; | ||
| 45 | my $indentation; | ||
| 46 | my $anywhere = 'back again'; | ||
| 47 | my $noindent; | ||
| 48 | |||
| 49 | =head1 The Tests | ||
| 50 | |||
| 51 | =head2 Test Case 1 | ||
| 52 | |||
| 53 | We have two HERE documents in one line with different quoting styles. | ||
| 54 | |||
| 55 | =cut | ||
| 56 | |||
| 57 | ## test case | ||
| 58 | |||
| 59 | $text = <<"HERE" . <<'THERE' . $any; | ||
| 60 | #look-here and | ||
| 61 | HERE | ||
| 62 | $tlook-here and | ||
| 63 | THERE | ||
| 64 | |||
| 65 | $noindent = "This should be left-justified"; | ||
| 66 | |||
| 67 | =head2 Test case 2 | ||
| 68 | |||
| 69 | A HERE document followed by a continuation line | ||
| 70 | |||
| 71 | =cut | ||
| 72 | |||
| 73 | ## test case | ||
| 74 | |||
| 75 | $text = <<HERE | ||
| 76 | look-here | ||
| 77 | HERE | ||
| 78 | |||
| 79 | . 'indent-level'; # Continuation, should be indented | ||
| 80 | |||
| 81 | =head2 Test case 3 | ||
| 82 | |||
| 83 | A here document with a line-end comment in the starter line, | ||
| 84 | after a complete statement | ||
| 85 | |||
| 86 | =cut | ||
| 87 | |||
| 88 | ## test case | ||
| 89 | |||
| 90 | $text = <<HERE; # start here | ||
| 91 | look-here | ||
| 92 | HERE | ||
| 93 | |||
| 94 | $noindent = "New statement in this line"; | ||
| 95 | |||
| 96 | =head2 Test case 4 | ||
| 97 | |||
| 98 | A HERE document with a to-be-continued statement and a comment in the | ||
| 99 | starter line. | ||
| 100 | |||
| 101 | =cut | ||
| 102 | |||
| 103 | ## test case | ||
| 104 | |||
| 105 | $text = <<HERE # start here | ||
| 106 | look-here | ||
| 107 | HERE | ||
| 108 | |||
| 109 | . 'indent-level'; # Continuation, should be indented | ||
| 110 | |||
| 111 | =head2 Test case 5 | ||
| 112 | |||
| 113 | A HERE document with a comment sign, but no comment to follow. | ||
| 114 | |||
| 115 | |||
| 116 | =cut | ||
| 117 | |||
| 118 | ## test case | ||
| 119 | |||
| 120 | $text = <<HERE; # | ||
| 121 | look-here | ||
| 122 | HERE | ||
| 123 | |||
| 124 | $noindent = "New statement in this line"; | ||
| 125 | |||
| 126 | =head2 Test case 6 | ||
| 127 | |||
| 128 | A HERE document with a comment sign, but no comment to follow, with a | ||
| 129 | statement to be continued. Also, the character before the comment | ||
| 130 | sign has a relevant syntax property (end of string in our case) which | ||
| 131 | must be preserved. | ||
| 132 | |||
| 133 | =cut | ||
| 134 | |||
| 135 | ## test case | ||
| 136 | |||
| 137 | $text = <<"HERE"# | ||
| 138 | look-here | ||
| 139 | HERE | ||
| 140 | |||
| 141 | . 'indent-level'; # Continuation, should be indented | ||
| 142 | |||
| 143 | __END__ | ||
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 46e687f14d0..943c454445c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el | |||
| @@ -135,6 +135,37 @@ point in the distant past, and is still broken in perl-mode. " | |||
| 135 | (should (equal (nth 3 (syntax-ppss)) nil)) | 135 | (should (equal (nth 3 (syntax-ppss)) nil)) |
| 136 | (should (equal (nth 4 (syntax-ppss)) t)))))) | 136 | (should (equal (nth 4 (syntax-ppss)) t)))))) |
| 137 | 137 | ||
| 138 | (ert-deftest cperl-test-heredocs () | ||
| 139 | "Test that HERE-docs are fontified with the appropriate face." | ||
| 140 | (require 'perl-mode) | ||
| 141 | (let ((file (ert-resource-file "here-docs.pl")) | ||
| 142 | (cperl-continued-statement-offset perl-continued-statement-offset) | ||
| 143 | (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc | ||
| 144 | 'font-lock-string-face)) | ||
| 145 | (case-fold-search nil)) | ||
| 146 | (with-temp-buffer | ||
| 147 | (insert-file-contents file) | ||
| 148 | (goto-char (point-min)) | ||
| 149 | (funcall cperl-test-mode) | ||
| 150 | (indent-region (point-min) (point-max)) | ||
| 151 | (font-lock-ensure (point-min) (point-max)) | ||
| 152 | (while (search-forward "## test case" nil t) | ||
| 153 | (save-excursion | ||
| 154 | (while (search-forward "look-here" nil t) | ||
| 155 | (should (equal | ||
| 156 | (get-text-property (match-beginning 0) 'face) | ||
| 157 | target-font)) | ||
| 158 | (beginning-of-line) | ||
| 159 | (should (null (looking-at "[ \t]"))) | ||
| 160 | (forward-line 1))) | ||
| 161 | (should (re-search-forward | ||
| 162 | (concat "^\\([ \t]*\\)" ; the actual indentation amount | ||
| 163 | "\\([^ \t\n].*?\\)\\(no\\)?indent") | ||
| 164 | nil t)) | ||
| 165 | (should (equal (- (match-end 1) (match-beginning 1)) | ||
| 166 | (if (match-beginning 3) 0 | ||
| 167 | perl-indent-level))))))) | ||
| 168 | |||
| 138 | ;;; Tests for issues reported in the Bug Tracker | 169 | ;;; Tests for issues reported in the Bug Tracker |
| 139 | 170 | ||
| 140 | (defun cperl-test--run-bug-10483 () | 171 | (defun cperl-test--run-bug-10483 () |
| @@ -164,6 +195,7 @@ under timeout control." | |||
| 164 | (interactive) | 195 | (interactive) |
| 165 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out | 196 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out |
| 166 | (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen | 197 | (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen |
| 198 | (skip-unless (eq cperl-test-mode #'cperl-mode)) | ||
| 167 | (let* ((emacs (concat invocation-directory invocation-name)) | 199 | (let* ((emacs (concat invocation-directory invocation-name)) |
| 168 | (test-function 'cperl-test--run-bug-10483) | 200 | (test-function 'cperl-test--run-bug-10483) |
| 169 | (test-function-name (symbol-name test-function)) | 201 | (test-function-name (symbol-name test-function)) |
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index 67b592e9070..42a011c8bcd 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el | |||
| @@ -497,7 +497,8 @@ VALUES-PLIST is a list with alternating index and value elements." | |||
| 497 | (ert-deftest ruby-add-log-current-method-examples () | 497 | (ert-deftest ruby-add-log-current-method-examples () |
| 498 | (let ((pairs '(("foo" . "#foo") | 498 | (let ((pairs '(("foo" . "#foo") |
| 499 | ("C.foo" . ".foo") | 499 | ("C.foo" . ".foo") |
| 500 | ("self.foo" . ".foo")))) | 500 | ("self.foo" . ".foo") |
| 501 | ("<<" . "#<<")))) | ||
| 501 | (dolist (pair pairs) | 502 | (dolist (pair pairs) |
| 502 | (let ((name (car pair)) | 503 | (let ((name (car pair)) |
| 503 | (value (cdr pair))) | 504 | (value (cdr pair))) |
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index eaafc5888c7..b4b5e4db5d6 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el | |||
| @@ -99,13 +99,18 @@ | |||
| 99 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) | 99 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) |
| 100 | 100 | ||
| 101 | (ert-deftest xref--xref-file-name-display-is-abs () | 101 | (ert-deftest xref--xref-file-name-display-is-abs () |
| 102 | (let ((xref-file-name-display 'abs)) | 102 | (let ((xref-file-name-display 'abs) |
| 103 | (should (equal (delete-dups | 103 | ;; Some older BSD find versions can produce '//' in the output. |
| 104 | (mapcar 'xref-location-group | 104 | (expected (list |
| 105 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) | 105 | (concat xref-tests--data-dir "/?file1.txt") |
| 106 | (list | 106 | (concat xref-tests--data-dir "/?file2.txt"))) |
| 107 | (concat xref-tests--data-dir "file1.txt") | 107 | (actual (delete-dups |
| 108 | (concat xref-tests--data-dir "file2.txt")))))) | 108 | (mapcar 'xref-location-group |
| 109 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | ||
| 110 | (should (and (= (length expected) (length actual)) | ||
| 111 | (cl-every (lambda (e1 e2) | ||
| 112 | (string-match-p e1 e2)) | ||
| 113 | expected actual))))) | ||
| 109 | 114 | ||
| 110 | (ert-deftest xref--xref-file-name-display-is-nondirectory () | 115 | (ert-deftest xref--xref-file-name-display-is-nondirectory () |
| 111 | (let ((xref-file-name-display 'nondirectory)) | 116 | (let ((xref-file-name-display 'nondirectory)) |
| @@ -121,10 +126,15 @@ | |||
| 121 | (file-name-directory (directory-file-name xref-tests--data-dir))) | 126 | (file-name-directory (directory-file-name xref-tests--data-dir))) |
| 122 | (project-find-functions | 127 | (project-find-functions |
| 123 | #'(lambda (_) (cons 'transient data-parent-dir))) | 128 | #'(lambda (_) (cons 'transient data-parent-dir))) |
| 124 | (xref-file-name-display 'project-relative)) | 129 | (xref-file-name-display 'project-relative) |
| 125 | (should (equal (delete-dups | 130 | ;; Some older BSD find versions can produce '//' in the output. |
| 126 | (mapcar 'xref-location-group | 131 | (expected (list |
| 127 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) | 132 | "xref-resources//?file1.txt" |
| 128 | (list | 133 | "xref-resources//?file2.txt")) |
| 129 | "xref-resources/file1.txt" | 134 | (actual (delete-dups |
| 130 | "xref-resources/file2.txt"))))) | 135 | (mapcar 'xref-location-group |
| 136 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | ||
| 137 | (should (and (= (length expected) (length actual)) | ||
| 138 | (cl-every (lambda (e1 e2) | ||
| 139 | (string-match-p e1 e2)) | ||
| 140 | expected actual))))) | ||
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 2f5b38d05d9..e0826208b60 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -61,6 +61,35 @@ | |||
| 61 | (quote | 61 | (quote |
| 62 | (0 font-lock-keyword-face)))))))) | 62 | (0 font-lock-keyword-face)))))))) |
| 63 | 63 | ||
| 64 | |||
| 65 | ;;;; Keymap support. | ||
| 66 | |||
| 67 | (ert-deftest subr-test-kbd () | ||
| 68 | (should (equal (kbd "f") "f")) | ||
| 69 | (should (equal (kbd "<f1>") [f1])) | ||
| 70 | (should (equal (kbd "RET") "\C-m")) | ||
| 71 | (should (equal (kbd "C-x a") "\C-xa")) | ||
| 72 | ;; Check that kbd handles both new and old style key descriptions | ||
| 73 | ;; (bug#45536). | ||
| 74 | (should (equal (kbd "s-<return>") [s-return])) | ||
| 75 | (should (equal (kbd "<s-return>") [s-return])) | ||
| 76 | (should (equal (kbd "C-M-<return>") [C-M-return])) | ||
| 77 | (should (equal (kbd "<C-M-return>") [C-M-return]))) | ||
| 78 | |||
| 79 | (ert-deftest subr-test-define-prefix-command () | ||
| 80 | (define-prefix-command 'foo-prefix-map) | ||
| 81 | (should (keymapp foo-prefix-map)) | ||
| 82 | (should (fboundp #'foo-prefix-map)) | ||
| 83 | ;; With optional argument. | ||
| 84 | (define-prefix-command 'bar-prefix 'bar-prefix-map) | ||
| 85 | (should (keymapp bar-prefix-map)) | ||
| 86 | (should (fboundp #'bar-prefix)) | ||
| 87 | ;; Returns the symbol. | ||
| 88 | (should (eq (define-prefix-command 'foo-bar) 'foo-bar))) | ||
| 89 | |||
| 90 | |||
| 91 | ;;;; Mode hooks. | ||
| 92 | |||
| 64 | (defalias 'subr-tests--parent-mode | 93 | (defalias 'subr-tests--parent-mode |
| 65 | (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) | 94 | (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) |
| 66 | 95 | ||
| @@ -404,6 +433,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." | |||
| 404 | (should (equal (flatten-tree '(1 ("foo" "bar") 2)) | 433 | (should (equal (flatten-tree '(1 ("foo" "bar") 2)) |
| 405 | '(1 "foo" "bar" 2)))) | 434 | '(1 "foo" "bar" 2)))) |
| 406 | 435 | ||
| 436 | (ert-deftest subr--tests-letrec () | ||
| 437 | ;; Test that simple cases of `letrec' get optimized back to `let*'. | ||
| 438 | (should (equal (macroexpand '(letrec ((subr-tests-var1 1) | ||
| 439 | (subr-tests-var2 subr-tests-var1)) | ||
| 440 | (+ subr-tests-var1 subr-tests-var2))) | ||
| 441 | '(let* ((subr-tests-var1 1) | ||
| 442 | (subr-tests-var2 subr-tests-var1)) | ||
| 443 | (+ subr-tests-var1 subr-tests-var2))))) | ||
| 444 | |||
| 407 | (defvar subr-tests--hook nil) | 445 | (defvar subr-tests--hook nil) |
| 408 | 446 | ||
| 409 | (ert-deftest subr-tests-add-hook-depth () | 447 | (ert-deftest subr-tests-add-hook-depth () |
diff --git a/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin new file mode 100644 index 00000000000..1905477af8c --- /dev/null +++ b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin | |||
| @@ -0,0 +1,9 @@ | |||
| 1 | First | ||
| 2 | paragraph | ||
| 3 | |||
| 4 | Second | ||
| 5 | |||
| 6 | Third | ||
| 7 | paragraph | ||
| 8 | |||
| 9 | No line end \ No newline at end of file | ||
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el index bf7f37090f5..712169029de 100644 --- a/test/lisp/textmodes/paragraphs-tests.el +++ b/test/lisp/textmodes/paragraphs-tests.el | |||
| @@ -24,6 +24,7 @@ | |||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (require 'ert) | 26 | (require 'ert) |
| 27 | (require 'ert-x) | ||
| 27 | ;; (require 'paragraphs) ; loaded by default | 28 | ;; (require 'paragraphs) ; loaded by default |
| 28 | 29 | ||
| 29 | (ert-deftest paragraphs-tests-sentence-end () | 30 | (ert-deftest paragraphs-tests-sentence-end () |
| @@ -161,5 +162,27 @@ | |||
| 161 | (should (equal (buffer-string) | 162 | (should (equal (buffer-string) |
| 162 | "First sentence. Third sentence. Second sentence.")))) | 163 | "First sentence. Third sentence. Second sentence.")))) |
| 163 | 164 | ||
| 165 | (ert-deftest test-mark-paragraphs () | ||
| 166 | (with-current-buffer | ||
| 167 | (find-file-noselect (ert-resource-file "mark-paragraph.bin")) | ||
| 168 | (goto-char (point-max)) | ||
| 169 | ;; Just a sanity check that the file hasn't changed. | ||
| 170 | (should (= (point) 54)) | ||
| 171 | (mark-paragraph) | ||
| 172 | (should (= (point) 42)) | ||
| 173 | (should (= (mark) 54)) | ||
| 174 | ;; Doesn't move. | ||
| 175 | (mark-paragraph) | ||
| 176 | (should (= (point) 42)) | ||
| 177 | (should (= (mark) 54)) | ||
| 178 | (forward-line -1) | ||
| 179 | (mark-paragraph) | ||
| 180 | (should (= (point) 25)) | ||
| 181 | (should (= (mark) 42)) | ||
| 182 | (goto-char (point-min)) | ||
| 183 | (mark-paragraph) | ||
| 184 | (should (= (point) 1)) | ||
| 185 | (should (= (mark) 17)))) | ||
| 186 | |||
| 164 | (provide 'paragraphs-tests) | 187 | (provide 'paragraphs-tests) |
| 165 | ;;; paragraphs-tests.el ends here | 188 | ;;; paragraphs-tests.el ends here |
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index 35235c65665..17fdfefce84 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el | |||
| @@ -301,4 +301,25 @@ return nil, even with a non-nil bubblep argument." | |||
| 301 | (should child) | 301 | (should child) |
| 302 | (should (equal (widget-value widget) '((1 "One"))))))) | 302 | (should (equal (widget-value widget) '((1 "One"))))))) |
| 303 | 303 | ||
| 304 | (ert-deftest widget-test-widget-move () | ||
| 305 | "Test moving with `widget-forward' and `widget-backward'." | ||
| 306 | (with-temp-buffer | ||
| 307 | (dolist (el '("First" "Second" "Third")) | ||
| 308 | (widget-create 'push-button el)) | ||
| 309 | (widget-insert "\n") | ||
| 310 | (use-local-map widget-keymap) | ||
| 311 | (widget-setup) | ||
| 312 | (goto-char (point-min)) | ||
| 313 | ;; Check that moving from the widget's start works. | ||
| 314 | (widget-forward 2) | ||
| 315 | (should (string= "Third" (widget-value (widget-at)))) | ||
| 316 | (widget-backward 1) | ||
| 317 | (should (string= "Second" (widget-value (widget-at)))) | ||
| 318 | ;; Check that moving from inside the widget works. | ||
| 319 | (goto-char (point-min)) | ||
| 320 | (widget-forward 2) | ||
| 321 | (forward-char) | ||
| 322 | (widget-backward 1) | ||
| 323 | (should (string= "Second" (widget-value (widget-at)))))) | ||
| 324 | |||
| 304 | ;;; wid-edit-tests.el ends here | 325 | ;;; wid-edit-tests.el ends here |
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 74fb3c892db..d4f5fc3f190 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el | |||
| @@ -248,6 +248,18 @@ g .. h foo | |||
| 248 | 0 .. 3 foo | 248 | 0 .. 3 foo |
| 249 | "))))) | 249 | "))))) |
| 250 | 250 | ||
| 251 | (ert-deftest keymap--key-description () | ||
| 252 | (should (equal (key-description [right] [?\C-x]) | ||
| 253 | "C-x <right>")) | ||
| 254 | (should (equal (key-description [M-H-right] [?\C-x]) | ||
| 255 | "C-x M-H-<right>")) | ||
| 256 | (should (equal (single-key-description 'home) | ||
| 257 | "<home>")) | ||
| 258 | (should (equal (single-key-description 'home t) | ||
| 259 | "home")) | ||
| 260 | (should (equal (single-key-description 'C-s-home) | ||
| 261 | "C-s-<home>"))) | ||
| 262 | |||
| 251 | (provide 'keymap-tests) | 263 | (provide 'keymap-tests) |
| 252 | 264 | ||
| 253 | ;;; keymap-tests.el ends here | 265 | ;;; keymap-tests.el ends here |
diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 5294bc07ce5..921bcd5f85b 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el | |||
| @@ -560,8 +560,16 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 560 | ;; We should have managed to start at least one process. | 560 | ;; We should have managed to start at least one process. |
| 561 | (should processes) | 561 | (should processes) |
| 562 | (dolist (process processes) | 562 | (dolist (process processes) |
| 563 | (should (process-live-p process)) | 563 | ;; The process now should either be running, or have |
| 564 | (process-send-eof process) | 564 | ;; already failed before `exec'. |
| 565 | (should (memq (process-status process) '(run exit))) | ||
| 566 | (when (process-live-p process) | ||
| 567 | (process-send-eof process)) | ||
| 568 | ;; FIXME: This `sleep-for' shouldn't be needed. It | ||
| 569 | ;; indicates a bug in Emacs; perhaps SIGCHLD is | ||
| 570 | ;; received in parallel with `accept-process-output', | ||
| 571 | ;; causing the latter to hang. | ||
| 572 | (sleep-for 0.1) | ||
| 565 | (while (accept-process-output process)) | 573 | (while (accept-process-output process)) |
| 566 | (should (eq (process-status process) 'exit)) | 574 | (should (eq (process-status process) 'exit)) |
| 567 | ;; If there's an error between fork and exec, Emacs | 575 | ;; If there's an error between fork and exec, Emacs |
| @@ -643,6 +651,8 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 643 | (ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () | 651 | (ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () |
| 644 | "Check that Emacs doesn't crash when trying to use more than | 652 | "Check that Emacs doesn't crash when trying to use more than |
| 645 | FD_SETSIZE file descriptors (Bug#24325)." | 653 | FD_SETSIZE file descriptors (Bug#24325)." |
| 654 | ;; This test cannot be run if PTYs aren't supported. | ||
| 655 | (skip-unless (not (eq system-type 'windows-nt))) | ||
| 646 | (with-timeout (60 (ert-fail "Test timed out")) | 656 | (with-timeout (60 (ert-fail "Test timed out")) |
| 647 | (process-tests--with-processes processes | 657 | (process-tests--with-processes processes |
| 648 | ;; In order to use `make-serial-process', we need to create some | 658 | ;; In order to use `make-serial-process', we need to create some |
| @@ -664,6 +674,15 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 664 | (tty-name (process-tty-name host))) | 674 | (tty-name (process-tty-name host))) |
| 665 | (should (processp host)) | 675 | (should (processp host)) |
| 666 | (push host processes) | 676 | (push host processes) |
| 677 | ;; FIXME: The assumption below that using :connection 'pty | ||
| 678 | ;; in make-process necessarily produces a process with PTY | ||
| 679 | ;; connection is unreliable and non-portable. | ||
| 680 | ;; make-process can legitimately and silently fall back on | ||
| 681 | ;; pipes if allocating a PTY fails (and on MS-Windows it | ||
| 682 | ;; always fails). The following code also assumes that | ||
| 683 | ;; process-tty-name produces a file name that can be | ||
| 684 | ;; passed to 'stat' and to make-serial-process, which is | ||
| 685 | ;; also non-portable. | ||
| 667 | (should tty-name) | 686 | (should tty-name) |
| 668 | (should (file-exists-p tty-name)) | 687 | (should (file-exists-p tty-name)) |
| 669 | (should-not (member tty-name tty-names)) | 688 | (should-not (member tty-name tty-names)) |