aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorYuuki Harano2021-01-10 18:49:51 +0900
committerYuuki Harano2021-01-10 18:49:51 +0900
commitaac33a8074c41354ffdb1236a342da16dca4a1bc (patch)
tree3a99478549f66d3f93a282e29d2c302995a86a49 /test
parent78fd106653a9e4fa7c9c3c9788540e2e15552254 (diff)
parent690cf6b8d8b8827f046bc1e24b2e556afeff976c (diff)
downloademacs-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.in6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el7
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el3
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el23
-rw-r--r--test/lisp/filenotify-tests.el2
-rw-r--r--test/lisp/gnus/mm-decode-resources/8bit-multipart.bin20
-rw-r--r--test/lisp/gnus/mm-decode-tests.el89
-rw-r--r--test/lisp/help-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el18
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/here-docs.pl143
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el32
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el3
-rw-r--r--test/lisp/progmodes/xref-tests.el38
-rw-r--r--test/lisp/subr-tests.el38
-rw-r--r--test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin9
-rw-r--r--test/lisp/textmodes/paragraphs-tests.el23
-rw-r--r--test/lisp/wid-edit-tests.el21
-rw-r--r--test/src/keymap-tests.el12
-rw-r--r--test/src/process-tests.el23
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.
163WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } 163WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
164## On Hydra or Emba, always show logs for certain problematic tests.
164ifdef EMACS_HYDRA_CI 165ifdef EMACS_HYDRA_CI
165## On Hydra, always show logs for certain problematic tests.
166lisp/net/tramp-tests.log \ 166lisp/net/tramp-tests.log \
167: WRITE_LOG = 2>&1 | tee $@ 167: WRITE_LOG = 2>&1 | tee $@
168endif 168endif
169ifdef EMACS_EMBA_CI
170lisp/filenotify-tests.log lisp/net/tramp-tests.log \
171: WRITE_LOG = 2>&1 | tee $@
172endif
169 173
170ifeq ($(TEST_LOAD_EL), yes) 174ifeq ($(TEST_LOAD_EL), yes)
171testloadfile = $*.el 175testloadfile = $*.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 @@
1From: example <example@example.org>
2To: example <example@example.org>
3Content-Type: multipart/alternative; boundary="===============2877195075946974246=="
4Date: Thu, 29 Oct 2020 14:47:55 +0100
5MIME-Version: 1.0
6Subject: test
7
8--===============2877195075946974246==
9Content-Type: text/plain; charset="utf-8"
10Content-Transfer-Encoding: 8bit
11
12ääää
13
14--===============2877195075946974246==
15Content-Type: text/html; charset="utf-8"
16Content-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
102ESC Prefix Command 102ESC Prefix Command
103SPC minibuffer-complete-word 103SPC minibuffer-complete-word
104? minibuffer-completion-help 104? minibuffer-completion-help
105<C-tab> file-cache-minibuffer-complete 105C-<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 @@
1use 5.020;
2
3=head1 NAME
4
5here-docs.pl - resource file for cperl-test-here-docs
6
7=head1 DESCRIPTION
8
9This file holds a couple of HERE documents, with a variety of normal
10and edge cases. For a formatted view of this description, run:
11
12 (cperl-perldoc "here-docs.pl")
13
14For each of the HERE documents, the following checks will done:
15
16=over 4
17
18=item *
19
20All occurrences of the string "look-here" are fontified correcty.
21Note that we deliberately test the face, not the syntax property:
22Users won't care for the syntax property, but they see the face.
23Different implementations with different syntax properties have been
24seen in the past.
25
26=item *
27
28Indentation of the line(s) containing "look-here" is 0, i.e. there are no
29leading spaces.
30
31=item *
32
33Indentation of the following perl statement containing "indent" should
34be 0 if the statement contains "noindent", and according to the mode's
35continued-statement-offset otherwise.
36
37=back
38
39=cut
40
41# Prologue to make the test file valid without warnings
42
43my $text;
44my $any;
45my $indentation;
46my $anywhere = 'back again';
47my $noindent;
48
49=head1 The Tests
50
51=head2 Test Case 1
52
53We 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
61HERE
62$tlook-here and
63THERE
64
65$noindent = "This should be left-justified";
66
67=head2 Test case 2
68
69A HERE document followed by a continuation line
70
71=cut
72
73## test case
74
75$text = <<HERE
76look-here
77HERE
78
79. 'indent-level'; # Continuation, should be indented
80
81=head2 Test case 3
82
83A here document with a line-end comment in the starter line,
84after a complete statement
85
86=cut
87
88## test case
89
90$text = <<HERE; # start here
91look-here
92HERE
93
94$noindent = "New statement in this line";
95
96=head2 Test case 4
97
98A HERE document with a to-be-continued statement and a comment in the
99starter line.
100
101=cut
102
103## test case
104
105$text = <<HERE # start here
106look-here
107HERE
108
109. 'indent-level'; # Continuation, should be indented
110
111=head2 Test case 5
112
113A HERE document with a comment sign, but no comment to follow.
114
115
116=cut
117
118## test case
119
120$text = <<HERE; #
121look-here
122HERE
123
124$noindent = "New statement in this line";
125
126=head2 Test case 6
127
128A HERE document with a comment sign, but no comment to follow, with a
129statement to be continued. Also, the character before the comment
130sign has a relevant syntax property (end of string in our case) which
131must be preserved.
132
133=cut
134
135## test case
136
137$text = <<"HERE"#
138look-here
139HERE
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 @@
1First
2paragraph
3
4Second
5
6Third
7paragraph
8
9No 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
2480 .. 3 foo 2480 .. 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
645FD_SETSIZE file descriptors (Bug#24325)." 653FD_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))