aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/lisp/abbrev-tests.el3
-rw-r--r--test/lisp/autorevert-tests.el170
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el6
-rw-r--r--test/lisp/emacs-lisp/let-alist-tests.el5
-rw-r--r--test/lisp/emacs-lisp/testcover-resources/testcases.el493
-rw-r--r--test/lisp/emacs-lisp/testcover-tests.el186
-rw-r--r--test/lisp/faces-tests.el9
-rw-r--r--test/lisp/ffap-tests.el2
-rw-r--r--test/lisp/filenotify-tests.el70
-rw-r--r--test/lisp/htmlfontify-tests.el12
-rw-r--r--test/lisp/ibuffer-tests.el9
-rw-r--r--test/lisp/kmacro-tests.el890
-rw-r--r--test/lisp/minibuffer-tests.el2
-rw-r--r--test/lisp/net/dbus-tests.el3
-rw-r--r--test/lisp/progmodes/js-tests.el14
-rw-r--r--test/lisp/progmodes/python-tests.el23
-rw-r--r--test/lisp/simple-tests.el6
-rw-r--r--test/lisp/textmodes/css-mode-tests.el15
-rw-r--r--test/lisp/textmodes/tildify-tests.el2
-rw-r--r--test/lisp/vc/diff-mode-tests.el203
-rw-r--r--test/lisp/xml-tests.el15
-rw-r--r--test/manual/indent/css-mode.css27
-rw-r--r--test/manual/indent/scss-mode.scss44
-rw-r--r--test/manual/scroll-tests.el130
-rw-r--r--test/src/syntax-tests.el85
25 files changed, 2271 insertions, 153 deletions
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index a454471ae3b..1ffcd6ac0d0 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -45,8 +45,7 @@
45 (should-not (abbrev-table-p [])) 45 (should-not (abbrev-table-p []))
46 ;; Missing :abbrev-table-modiff counter: 46 ;; Missing :abbrev-table-modiff counter:
47 (should-not (abbrev-table-p (obarray-make))) 47 (should-not (abbrev-table-p (obarray-make)))
48 (let* ((table (obarray-make))) 48 (should (abbrev-table-empty-p (make-abbrev-table))))
49 (should (abbrev-table-empty-p (make-abbrev-table)))))
50 49
51(ert-deftest abbrev-make-abbrev-table-test () 50(ert-deftest abbrev-make-abbrev-table-test ()
52 ;; Table without properties: 51 ;; Table without properties:
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index aea855ae02f..c6f103321c6 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -24,24 +24,29 @@
24;;; Code: 24;;; Code:
25 25
26(require 'ert) 26(require 'ert)
27(require 'ert-x)
27(require 'autorevert) 28(require 'autorevert)
28(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" 29(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
29 auto-revert-stop-on-user-input nil) 30 auto-revert-stop-on-user-input nil)
30 31
31(defconst auto-revert--timeout 10 32(defconst auto-revert--timeout 10
32 "Time to wait until a message appears in the *Messages* buffer.") 33 "Time to wait for a message.")
34
35(defvar auto-revert--messages nil
36 "Used to collect messages issued during a section of a test.")
33 37
34(defun auto-revert--wait-for-revert (buffer) 38(defun auto-revert--wait-for-revert (buffer)
35 "Wait until the *Messages* buffer reports reversion of BUFFER." 39 "Wait until a message reports reversion of BUFFER.
40This expects `auto-revert--messages' to be bound by
41`ert-with-message-capture' before calling."
36 (with-timeout (auto-revert--timeout nil) 42 (with-timeout (auto-revert--timeout nil)
37 (with-current-buffer "*Messages*" 43 (while
38 (while 44 (null (string-match
39 (null (string-match 45 (format-message "Reverting buffer `%s'." (buffer-name buffer))
40 (format-message "Reverting buffer `%s'." (buffer-name buffer)) 46 auto-revert--messages))
41 (buffer-string))) 47 (if (with-current-buffer buffer auto-revert-use-notify)
42 (if (with-current-buffer buffer auto-revert-use-notify) 48 (read-event nil nil 0.1)
43 (read-event nil nil 0.1) 49 (sleep-for 0.1)))))
44 (sleep-for 0.1))))))
45 50
46(ert-deftest auto-revert-test00-auto-revert-mode () 51(ert-deftest auto-revert-test00-auto-revert-mode ()
47 "Check autorevert for a file." 52 "Check autorevert for a file."
@@ -51,41 +56,38 @@
51 buf) 56 buf)
52 (unwind-protect 57 (unwind-protect
53 (progn 58 (progn
54 (with-current-buffer (get-buffer-create "*Messages*") 59 (write-region "any text" nil tmpfile nil 'no-message)
55 (narrow-to-region (point-max) (point-max)))
56 (write-region "any text" nil tmpfile nil 'no-message)
57 (setq buf (find-file-noselect tmpfile)) 60 (setq buf (find-file-noselect tmpfile))
58 (with-current-buffer buf 61 (with-current-buffer buf
59 (should (string-equal (buffer-string) "any text")) 62 (ert-with-message-capture auto-revert--messages
60 ;; `buffer-stale--default-function' checks for 63 (should (string-equal (buffer-string) "any text"))
61 ;; `verify-visited-file-modtime'. We must ensure that it 64 ;; `buffer-stale--default-function' checks for
62 ;; returns nil. 65 ;; `verify-visited-file-modtime'. We must ensure that it
63 (sleep-for 1) 66 ;; returns nil.
64 (auto-revert-mode 1) 67 (sleep-for 1)
65 (should auto-revert-mode) 68 (auto-revert-mode 1)
69 (should auto-revert-mode)
66 70
67 ;; Modify file. We wait for a second, in order to have 71 ;; Modify file. We wait for a second, in order to have
68 ;; another timestamp. 72 ;; another timestamp.
69 (sleep-for 1) 73 (sleep-for 1)
70 (write-region "another text" nil tmpfile nil 'no-message) 74 (write-region "another text" nil tmpfile nil 'no-message)
71 75
72 ;; Check, that the buffer has been reverted. 76 ;; Check, that the buffer has been reverted.
73 (auto-revert--wait-for-revert buf) 77 (auto-revert--wait-for-revert buf))
74 (should (string-match "another text" (buffer-string))) 78 (should (string-match "another text" (buffer-string)))
75 79
76 ;; When the buffer is modified, it shall not be reverted. 80 ;; When the buffer is modified, it shall not be reverted.
77 (with-current-buffer (get-buffer-create "*Messages*") 81 (ert-with-message-capture auto-revert--messages
78 (narrow-to-region (point-max) (point-max))) 82 (set-buffer-modified-p t)
79 (set-buffer-modified-p t) 83 (sleep-for 1)
80 (sleep-for 1) 84 (write-region "any text" nil tmpfile nil 'no-message)
81 (write-region "any text" nil tmpfile nil 'no-message)
82 85
83 ;; Check, that the buffer hasn't been reverted. 86 ;; Check, that the buffer hasn't been reverted.
84 (auto-revert--wait-for-revert buf) 87 (auto-revert--wait-for-revert buf))
85 (should-not (string-match "any text" (buffer-string))))) 88 (should-not (string-match "any text" (buffer-string)))))
86 89
87 ;; Exit. 90 ;; Exit.
88 (with-current-buffer "*Messages*" (widen))
89 (ignore-errors 91 (ignore-errors
90 (with-current-buffer buf (set-buffer-modified-p nil)) 92 (with-current-buffer buf (set-buffer-modified-p nil))
91 (kill-buffer buf)) 93 (kill-buffer buf))
@@ -106,13 +108,11 @@
106 (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) 108 (make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
107 buf1 buf2) 109 buf1 buf2)
108 (unwind-protect 110 (unwind-protect
109 (progn 111 (ert-with-message-capture auto-revert--messages
110 (with-current-buffer (get-buffer-create "*Messages*") 112 (write-region "any text" nil tmpfile1 nil 'no-message)
111 (narrow-to-region (point-max) (point-max))) 113 (setq buf1 (find-file-noselect tmpfile1))
112 (write-region "any text" nil tmpfile1 nil 'no-message) 114 (write-region "any text" nil tmpfile2 nil 'no-message)
113 (setq buf1 (find-file-noselect tmpfile1)) 115 (setq buf2 (find-file-noselect tmpfile2))
114 (write-region "any text" nil tmpfile2 nil 'no-message)
115 (setq buf2 (find-file-noselect tmpfile2))
116 116
117 (dolist (buf (list buf1 buf2)) 117 (dolist (buf (list buf1 buf2))
118 (with-current-buffer buf 118 (with-current-buffer buf
@@ -148,7 +148,6 @@
148 (should (string-match "another text" (buffer-string)))))) 148 (should (string-match "another text" (buffer-string))))))
149 149
150 ;; Exit. 150 ;; Exit.
151 (with-current-buffer "*Messages*" (widen))
152 (ignore-errors 151 (ignore-errors
153 (dolist (buf (list buf1 buf2)) 152 (dolist (buf (list buf1 buf2))
154 (with-current-buffer buf (set-buffer-modified-p nil)) 153 (with-current-buffer buf (set-buffer-modified-p nil))
@@ -165,8 +164,6 @@
165 buf) 164 buf)
166 (unwind-protect 165 (unwind-protect
167 (progn 166 (progn
168 (with-current-buffer (get-buffer-create "*Messages*")
169 (narrow-to-region (point-max) (point-max)))
170 (write-region "any text" nil tmpfile nil 'no-message) 167 (write-region "any text" nil tmpfile nil 'no-message)
171 (setq buf (find-file-noselect tmpfile)) 168 (setq buf (find-file-noselect tmpfile))
172 (with-current-buffer buf 169 (with-current-buffer buf
@@ -184,42 +181,38 @@
184 'before-revert-hook 181 'before-revert-hook
185 (lambda () (delete-file buffer-file-name)) 182 (lambda () (delete-file buffer-file-name))
186 nil t) 183 nil t)
187 (with-current-buffer (get-buffer-create "*Messages*")
188 (narrow-to-region (point-max) (point-max)))
189 (sleep-for 1)
190 (write-region "another text" nil tmpfile nil 'no-message)
191 184
192 ;; Check, that the buffer hasn't been reverted. File 185 (ert-with-message-capture auto-revert--messages
193 ;; notification should be disabled, falling back to 186 (sleep-for 1)
194 ;; polling. 187 (write-region "another text" nil tmpfile nil 'no-message)
195 (auto-revert--wait-for-revert buf) 188 (auto-revert--wait-for-revert buf))
189 ;; Check, that the buffer hasn't been reverted. File
190 ;; notification should be disabled, falling back to
191 ;; polling.
196 (should (string-match "any text" (buffer-string))) 192 (should (string-match "any text" (buffer-string)))
197 (should-not auto-revert-use-notify) 193 ;; With w32notify, the 'stopped' events are not sent.
194 (or (eq file-notify--library 'w32notify)
195 (should-not auto-revert-use-notify))
198 196
199 ;; Once the file has been recreated, the buffer shall be 197 ;; Once the file has been recreated, the buffer shall be
200 ;; reverted. 198 ;; reverted.
201 (kill-local-variable 'before-revert-hook) 199 (kill-local-variable 'before-revert-hook)
202 (with-current-buffer (get-buffer-create "*Messages*") 200 (ert-with-message-capture auto-revert--messages
203 (narrow-to-region (point-max) (point-max))) 201 (sleep-for 1)
204 (sleep-for 1) 202 (write-region "another text" nil tmpfile nil 'no-message)
205 (write-region "another text" nil tmpfile nil 'no-message) 203 (auto-revert--wait-for-revert buf))
206 204 ;; Check, that the buffer has been reverted.
207 ;; Check, that the buffer has been reverted.
208 (auto-revert--wait-for-revert buf)
209 (should (string-match "another text" (buffer-string))) 205 (should (string-match "another text" (buffer-string)))
210 206
211 ;; An empty file shall still be reverted. 207 ;; An empty file shall still be reverted.
212 (with-current-buffer (get-buffer-create "*Messages*") 208 (ert-with-message-capture auto-revert--messages
213 (narrow-to-region (point-max) (point-max))) 209 (sleep-for 1)
214 (sleep-for 1) 210 (write-region "" nil tmpfile nil 'no-message)
215 (write-region "" nil tmpfile nil 'no-message) 211 (auto-revert--wait-for-revert buf))
216 212 ;; Check, that the buffer has been reverted.
217 ;; Check, that the buffer has been reverted.
218 (auto-revert--wait-for-revert buf)
219 (should (string-equal "" (buffer-string))))) 213 (should (string-equal "" (buffer-string)))))
220 214
221 ;; Exit. 215 ;; Exit.
222 (with-current-buffer "*Messages*" (widen))
223 (ignore-errors 216 (ignore-errors
224 (with-current-buffer buf (set-buffer-modified-p nil)) 217 (with-current-buffer buf (set-buffer-modified-p nil))
225 (kill-buffer buf)) 218 (kill-buffer buf))
@@ -232,9 +225,7 @@
232 (let ((tmpfile (make-temp-file "auto-revert-test")) 225 (let ((tmpfile (make-temp-file "auto-revert-test"))
233 buf) 226 buf)
234 (unwind-protect 227 (unwind-protect
235 (progn 228 (ert-with-message-capture auto-revert--messages
236 (with-current-buffer (get-buffer-create "*Messages*")
237 (narrow-to-region (point-max) (point-max)))
238 (write-region "any text" nil tmpfile nil 'no-message) 229 (write-region "any text" nil tmpfile nil 'no-message)
239 (setq buf (find-file-noselect tmpfile)) 230 (setq buf (find-file-noselect tmpfile))
240 (with-current-buffer buf 231 (with-current-buffer buf
@@ -259,7 +250,6 @@
259 (string-match "modified text\nanother text" (buffer-string))))) 250 (string-match "modified text\nanother text" (buffer-string)))))
260 251
261 ;; Exit. 252 ;; Exit.
262 (with-current-buffer "*Messages*" (widen))
263 (ignore-errors (kill-buffer buf)) 253 (ignore-errors (kill-buffer buf))
264 (ignore-errors (delete-file tmpfile))))) 254 (ignore-errors (delete-file tmpfile)))))
265 255
@@ -283,33 +273,29 @@
283 (should 273 (should
284 (string-match name (substring-no-properties (buffer-string)))) 274 (string-match name (substring-no-properties (buffer-string))))
285 275
286 ;; Delete file. We wait for a second, in order to have 276 (ert-with-message-capture auto-revert--messages
287 ;; another timestamp. 277 ;; Delete file. We wait for a second, in order to have
288 (with-current-buffer (get-buffer-create "*Messages*") 278 ;; another timestamp.
289 (narrow-to-region (point-max) (point-max))) 279 (sleep-for 1)
290 (sleep-for 1) 280 (delete-file tmpfile)
291 (delete-file tmpfile) 281 (auto-revert--wait-for-revert buf))
292 282 ;; Check, that the buffer has been reverted.
293 ;; Check, that the buffer has been reverted.
294 (auto-revert--wait-for-revert buf)
295 (should-not 283 (should-not
296 (string-match name (substring-no-properties (buffer-string)))) 284 (string-match name (substring-no-properties (buffer-string))))
297 285
298 ;; Make dired buffer modified. Check, that the buffer has 286 (ert-with-message-capture auto-revert--messages
299 ;; been still reverted. 287 ;; Make dired buffer modified. Check, that the buffer has
300 (with-current-buffer (get-buffer-create "*Messages*") 288 ;; been still reverted.
301 (narrow-to-region (point-max) (point-max))) 289 (set-buffer-modified-p t)
302 (set-buffer-modified-p t) 290 (sleep-for 1)
303 (sleep-for 1) 291 (write-region "any text" nil tmpfile nil 'no-message)
304 (write-region "any text" nil tmpfile nil 'no-message)
305 292
306 ;; Check, that the buffer has been reverted. 293 (auto-revert--wait-for-revert buf))
307 (auto-revert--wait-for-revert buf) 294 ;; Check, that the buffer has been reverted.
308 (should 295 (should
309 (string-match name (substring-no-properties (buffer-string)))))) 296 (string-match name (substring-no-properties (buffer-string))))))
310 297
311 ;; Exit. 298 ;; Exit.
312 (with-current-buffer "*Messages*" (widen))
313 (ignore-errors 299 (ignore-errors
314 (with-current-buffer buf (set-buffer-modified-p nil)) 300 (with-current-buffer buf (set-buffer-modified-p nil))
315 (kill-buffer buf)) 301 (kill-buffer buf))
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 3740b5c1836..61e3d720331 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -250,9 +250,9 @@ Body are forms defining the test."
250 (should (= 0 (cl-count -5 list))) 250 (should (= 0 (cl-count -5 list)))
251 (should (= 0 (cl-count 2 list :start 2 :end 4))) 251 (should (= 0 (cl-count 2 list :start 2 :end 4)))
252 (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo))))) 252 (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo)))))
253 (should (= 4 (cl-count 'foo list :test (lambda (a b) (cl-evenp b))))) 253 (should (= 4 (cl-count 'foo list :test (lambda (_a b) (cl-evenp b)))))
254 (should (equal (cl-count 'foo list :test (lambda (a b) (cl-oddp b))) 254 (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b)))
255 (cl-count 'foo list :test-not (lambda (a b) (cl-evenp b))))))) 255 (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp b)))))))
256 256
257;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end 257;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
258(ert-deftest cl-seq-mismatch-test () 258(ert-deftest cl-seq-mismatch-test ()
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index fbcde4e3cbf..d04645709e4 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -31,7 +31,7 @@
31 (.test-two (cdr (assq 'test-two symbol)))) 31 (.test-two (cdr (assq 'test-two symbol))))
32 (list .test-one .test-two 32 (list .test-one .test-two
33 .test-two .test-two))) 33 .test-two .test-two)))
34 (cl-letf (((symbol-function #'make-symbol) (lambda (x) 'symbol))) 34 (cl-letf (((symbol-function #'make-symbol) (lambda (_x) 'symbol)))
35 (macroexpand 35 (macroexpand
36 '(let-alist data (list .test-one .test-two 36 '(let-alist data (list .test-one .test-two
37 .test-two .test-two)))))) 37 .test-two .test-two))))))
@@ -51,8 +51,7 @@
51(ert-deftest let-alist-cons () 51(ert-deftest let-alist-cons ()
52 (should 52 (should
53 (equal 53 (equal
54 (let ((.external "ext") 54 (let ((.external "ext"))
55 (.external.too "et"))
56 (let-alist '((test-two . 0) 55 (let-alist '((test-two . 0)
57 (test-three . 1) 56 (test-three . 1)
58 (sublist . ((foo . 2) 57 (sublist . ((foo . 2)
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
new file mode 100644
index 00000000000..1eb791a993c
--- /dev/null
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -0,0 +1,493 @@
1;;;; testcases.el -- Test cases for testcover-tests.el
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell
6
7;; This file is part of GNU Emacs.
8
9;; This program is free software: you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation, either version 3 of the
12;; License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17;; General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program. If not, see `http://www.gnu.org/licenses/'.
21
22;;; Commentary:
23
24;; * This file should not be loaded directly. It is meant to be read
25;; by `testcover-tests-build-test-cases'.
26;;
27;; * Test cases begin with ;; ==== name ====. The symbol name between
28;; the ===='s is used to create the name of the test.
29;;
30;; * Following the beginning comment place the test docstring and
31;; any tags or keywords for ERT. These will be spliced into the
32;; ert-deftest for the test.
33;;
34;; * To separate the above from the test case code, use another
35;; comment: ;; ====
36;;
37;; * These special comments should start at the beginning of a line.
38;;
39;; * `testcover-tests-skeleton' will prompt you for a test name and
40;; insert the special comments.
41;;
42;; * The test case code should be annotated with %%% at the end of
43;; each form where a tan splotch is expected, and !!! at the end
44;; of each form where a red mark is expected.
45;;
46;; * If Testcover is working correctly on your code sample, using
47;; `testcover-tests-markup-region' and
48;; `testcover-tests-unmarkup-region' can make creating test cases
49;; easier.
50
51;;; Code:
52;;; Test Cases:
53
54;; ==== constants-bug-25316 ====
55"Testcover doesn't splotch constants."
56:expected-result :failed
57;; ====
58(defconst testcover-testcase-const "apples")
59(defun testcover-testcase-zero () 0)
60(defun testcover-testcase-list-consts ()
61 (list
62 emacs-version 10
63 "hello"
64 `(a b c ,testcover-testcase-const)
65 '(1 2 3)
66 testcover-testcase-const
67 (testcover-testcase-zero)
68 nil))
69
70(defun testcover-testcase-add-to-const-list (arg)
71 (cons arg%%% (testcover-testcase-list-consts))%%%)
72
73(should (equal (testcover-testcase-add-to-const-list 'a)
74 `(a ,emacs-version 10 "hello" (a b c "apples") (1 2 3)
75 "apples" 0 nil)))
76
77;; ==== customize-defcustom-bug-25326 ====
78"Testcover doesn't prevent testing of defcustom values."
79:expected-result :failed
80;; ====
81(defgroup testcover-testcase nil
82 "Test case for testcover"
83 :group 'lisp
84 :prefix "testcover-testcase-"
85 :version "26.0")
86(defcustom testcover-testcase-flag t
87 "Test value used by testcover-tests.el"
88 :type 'boolean
89 :group 'testcover-testcase)
90(defun testcover-testcase-get-flag ()
91 testcover-testcase-flag)
92
93(testcover-testcase-get-flag)
94(setq testcover-testcase-flag (not testcover-testcase-flag))
95(testcover-testcase-get-flag)
96
97;; ==== no-returns ====
98"Testcover doesn't splotch functions which don't return."
99;; ====
100(defun testcover-testcase-play-ball (retval)
101 (catch 'ball
102 (throw 'ball retval%%%))%%%) ; catch gets marked but not throw
103
104(defun testcover-testcase-not-my-favorite-error-message ()
105 (signal 'wrong-type-argument (list 'consp nil)))
106
107(should (testcover-testcase-play-ball t))
108(condition-case nil
109 (testcover-testcase-not-my-favorite-error-message)
110 (error nil))
111
112;; ==== noreturn-symbol ====
113"Wrapping a form with noreturn prevents splotching."
114;; ====
115(defun testcover-testcase-cancel (spacecraft)
116 (error "no destination for %s" spacecraft))
117(defun testcover-testcase-launch (spacecraft planet)
118 (if (null planet)
119 (noreturn (testcover-testcase-cancel spacecraft%%%))
120 (list spacecraft%%% planet%%%)%%%)%%%)
121(defun testcover-testcase-launch-2 (spacecraft planet)
122 (if (null planet%%%)%%%
123 (testcover-testcase-cancel spacecraft%%%)!!!
124 (list spacecraft!!! planet!!!)!!!)!!!)
125(should (equal (testcover-testcase-launch "Curiosity" "Mars") '("Curiosity" "Mars")))
126(condition-case err
127 (testcover-testcase-launch "Voyager" nil)
128 (error err))
129(condition-case err
130 (testcover-testcase-launch-2 "Voyager II" nil)
131 (error err))
132
133(should-error (testcover-testcase-launch "Voyager" nil))
134(should-error (testcover-testcase-launch-2 "Voyager II" nil))
135
136;; ==== 1-value-symbol-bug-25316 ====
137"Wrapping a form with 1value prevents splotching."
138:expected-result :failed
139;; ====
140(defun testcover-testcase-always-zero (num)
141 (- num%%% num%%%)%%%)
142(defun testcover-testcase-still-always-zero (num)
143 (1value (- num%%% num%%% (- num%%% num%%%)%%%)))
144(defun testcover-testcase-never-called (num)
145 (1value (/ num!!! num!!!)!!!)!!!)
146(should (eql 0 (testcover-testcase-always-zero 3)))
147(should (eql 0 (testcover-testcase-still-always-zero 5)))
148
149;; ==== dotimes-dolist ====
150"Dolist and dotimes with a 1valued return value are 1valued."
151;; ====
152(defun testcover-testcase-do-over (things)
153 (dolist (thing things%%%)
154 (list thing))
155 (dolist (thing things%%% 42)
156 (list thing))
157 (dolist (thing things%%% things%%%)
158 (list thing))%%%)
159(defun testcover-testcase-do-more (count)
160 (dotimes (num count%%%)
161 (+ num num))
162 (dotimes (num count%%% count%%%)
163 (+ num num))%%%
164 (dotimes (num count%%% 0)
165 (+ num num)))
166(should (equal '(a b c) (testcover-testcase-do-over '(a b c))))
167(should (eql 0 (testcover-testcase-do-more 2)))
168
169;; ==== let-last-form ====
170"A let form is 1valued if its last form is 1valued."
171;; ====
172(defun testcover-testcase-double (num)
173 (let ((double (* num%%% 2)%%%))
174 double%%%)%%%)
175(defun testcover-testcase-nullbody-let (num)
176 (let* ((square (* num%%% num%%%)%%%)
177 (double (* 2 num%%%)%%%))))
178(defun testcover-testcase-answer ()
179 (let ((num 100))
180 42))
181(should-not (testcover-testcase-nullbody-let 3))
182(should (eql (testcover-testcase-answer) 42))
183(should (eql (testcover-testcase-double 10) 20))
184
185;; ==== if-with-1value-clauses ====
186"An if is 1valued if both then and else are 1valued."
187;; ====
188(defun testcover-testcase-describe (val)
189 (if (zerop val%%%)%%%
190 "a number"
191 "a different number"))
192(defun testcover-testcase-describe-2 (val)
193 (if (zerop val)
194 "zero"
195 "not zero"))
196(defun testcover-testcase-describe-3 (val)
197 (if (zerop val%%%)%%%
198 "zero"
199 (format "%d" val%%%)%%%)%%%)
200(should (equal (testcover-testcase-describe 0) "a number"))
201(should (equal (testcover-testcase-describe-2 0) "zero"))
202(should (equal (testcover-testcase-describe-2 1) "not zero"))
203(should (equal (testcover-testcase-describe-3 1) "1"))
204
205;; ==== cond-with-1value-clauses ====
206"A cond form is marked 1valued if all clauses are 1valued."
207;; ====
208(defun testcover-testcase-cond (num)
209 (cond
210 ((eql num%%% 0)%%% 'a)
211 ((eql num%%% 1)%%% 'b)
212 ((eql num!!! 2)!!! 'c)))
213(defun testcover-testcase-cond-2 (num)
214 (cond
215 ((eql num%%% 0)%%% (cons 'a 0)!!!)
216 ((eql num%%% 1)%%% 'b))%%%)
217(should (eql (testcover-testcase-cond 1) 'b))
218(should (eql (testcover-testcase-cond-2 1) 'b))
219
220;; ==== condition-case-with-1value-components ====
221"A condition-case is marked 1valued if its body and handlers are."
222;; ====
223(defun testcover-testcase-cc (arg)
224 (condition-case nil
225 (if (null arg%%%)%%%
226 (error "foo")
227 "0")!!!
228 (error nil)))
229(should-not (testcover-testcase-cc nil))
230
231;; ==== quotes-within-backquotes-bug-25316 ====
232"Forms to instrument are found within quotes within backquotes."
233:expected-result :failed
234;; ====
235(defun testcover-testcase-make-list ()
236 (list 'defun 'defvar))
237(defmacro testcover-testcase-bq-macro (arg)
238 (declare (debug t))
239 `(memq ,arg%%% '(defconst ,@(testcover-testcase-make-list)))%%%)
240(defun testcover-testcase-use-bq-macro (arg)
241 (testcover-testcase-bq-macro arg%%%)%%%)
242(should (equal '(defun defvar) (testcover-testcase-use-bq-macro 'defun)))
243
244;; ==== progn-functions ====
245"Some forms are 1value if their last argument is 1value."
246;; ====
247(defun testcover-testcase-one (arg)
248 (progn
249 (setq arg (1- arg%%%)%%%)%%%)%%%
250 (progn
251 (setq arg (1+ arg%%%)%%%)%%%
252 1))
253
254(should (eql 1 (testcover-testcase-one 0)))
255;; ==== prog1-functions ====
256"Some forms are 1value if their first argument is 1value."
257;; ====
258(defun testcover-testcase-unwinder (arg)
259 (unwind-protect
260 (if ( > arg%%% 0)%%%
261 1
262 0)
263 (format "unwinding %s!" arg%%%)%%%))
264(defun testcover-testcase-divider (arg)
265 (unwind-protect
266 (/ 100 arg%%%)%%%
267 (format "unwinding! %s" arg%%%)%%%)%%%)
268
269(should (eq 0 (testcover-testcase-unwinder 0)))
270(should (eq 1 (testcover-testcase-divider 100)))
271
272;; ==== compose-functions ====
273"Some functions are 1value if all their arguments are 1value."
274;; ====
275(defconst testcover-testcase-count 3)
276(defun testcover-testcase-number ()
277 (+ 1 testcover-testcase-count))
278(defun testcover-testcase-more ()
279 (+ 1 (testcover-testcase-number) testcover-testcase-count))
280
281(should (equal (testcover-testcase-more) 8))
282
283;; ==== apply-quoted-symbol ====
284"Apply with a quoted function symbol treated as 1value if function is."
285;; ====
286(defun testcover-testcase-numlist (flag)
287 (if flag%%%
288 '(1 2 3)
289 '(4 5 6)))
290(defun testcover-testcase-sum (flag)
291 (apply '+ (testcover-testcase-numlist flag%%%)))
292(defun testcover-testcase-label ()
293 (apply 'message "edebug uses: %s %s" (list 1 2)!!!)!!!)
294
295(should (equal 6 (testcover-testcase-sum t)))
296
297;; ==== backquote-1value-bug-24509 ====
298"Commas within backquotes are recognized as non-1value."
299:expected-result :failed
300;; ====
301(defmacro testcover-testcase-lambda (&rest body)
302 `(lambda () ,@body))
303
304(defun testcover-testcase-example ()
305 (let ((lambda-1 (testcover-testcase-lambda (format "lambda-%d" 1))%%%)
306 (lambda-2 (testcover-testcase-lambda (format "lambda-%d" 2))%%%))
307 (concat (funcall lambda-1%%%)%%% " "
308 (funcall lambda-2%%%)%%%)%%%)%%%)
309
310(defmacro testcover-testcase-message-symbol (name)
311 `(message "%s" ',name))
312
313(defun testcover-testcase-example-2 ()
314 (concat
315 (testcover-testcase-message-symbol foo)%%%
316 (testcover-testcase-message-symbol bar)%%%)%%%)
317
318(should (equal "lambda-1 lambda-2" (testcover-testcase-example)))
319(should (equal "foobar" (testcover-testcase-example-2)))
320
321;; ==== pcase-bug-24688 ====
322"Testcover copes with condition-case within backquoted list."
323:expected-result :failed
324;; ====
325(defun testcover-testcase-pcase (form)
326 (pcase form%%%
327 (`(condition-case ,var ,protected-form . ,handlers)
328 (list var%%% protected-form%%% handlers%%%)%%%)
329 (_ nil))%%%)
330
331(should (equal (testcover-testcase-pcase '(condition-case a
332 (/ 5 a)
333 (error 0)))
334 '(a (/ 5 a) ((error 0)))))
335
336;; ==== defun-in-backquote-bug-11307-and-24743 ====
337"Testcover handles defun forms within backquoted list."
338:expected-result :failed
339;; ====
340(defmacro testcover-testcase-defun (name &rest body)
341 (declare (debug (symbolp def-body)))
342 `(defun ,name () ,@body))
343
344(testcover-testcase-defun foo (+ 1 2))
345(testcover-testcase-defun bar (+ 3 4))
346(should (eql (foo) 3))
347(should (eql (bar) 7))
348
349;; ==== closure-1value-bug ====
350"Testcover does not mark closures as 1value."
351:expected-result :failed
352;; ====
353;; -*- lexical-binding:t -*-
354(setq testcover-testcase-foo nil)
355(setq testcover-testcase-bar 0)
356
357(defun testcover-testcase-baz (arg)
358 (setq testcover-testcase-foo
359 (lambda () (+ arg testcover-testcase-bar%%%))))
360
361(testcover-testcase-baz 2)
362(should (equal 2 (funcall testcover-testcase-foo)))
363(testcover-testcase-baz 3)
364(should (equal 3 (funcall testcover-testcase-foo)))
365
366;; ==== by-value-vs-by-reference-bug-25351 ====
367"An object created by a 1value expression may be modified by other code."
368:expected-result :failed
369;; ====
370(defun testcover-testcase-ab ()
371 (list 'a 'b))
372(defun testcover-testcase-change-it (arg)
373 (setf (cadr arg%%%)%%% 'c)%%%
374 arg%%%)
375
376(should (equal (testcover-testcase-change-it (testcover-testcase-ab)) '(a c)))
377(should (equal (testcover-testcase-ab) '(a b)))
378
379;; ==== 1value-error-test ====
380"Forms wrapped by `1value' should always return the same value."
381;; ====
382(defun testcover-testcase-thing (arg)
383 (1value (list 1 arg 3)))
384
385(should (equal '(1 2 3) (testcover-testcase-thing 2)))
386(should-error (testcover-testcase-thing 3))
387
388;; ==== dotted-backquote ====
389"Testcover correctly instruments dotted backquoted lists."
390;; ====
391(defun testcover-testcase-dotted-bq (flag extras)
392 (let* ((bq
393 `(a b c . ,(and flag extras%%%))))
394 bq))
395
396(should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e))))
397(should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e))))
398
399;; ==== backquoted-vector-bug-25316 ====
400"Testcover reinstruments within backquoted vectors."
401:expected-result :failed
402;; ====
403(defun testcover-testcase-vec (a b c)
404 `[,a%%% ,(list b%%% c%%%)%%%]%%%)
405
406(defun testcover-testcase-vec-in-list (d e f)
407 `([[,d%%% ,e%%%] ,f%%%])%%%)
408
409(defun testcover-testcase-vec-arg (num)
410 (list `[,num%%%]%%%)%%%)
411
412(should (equal [1 (2 3)] (testcover-testcase-vec 1 2 3)))
413(should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6)))
414(should (equal '([100]) (testcover-testcase-vec-arg 100)))
415
416;; ==== vector-in-macro-spec-bug-25316 ====
417"Testcover reinstruments within vectors."
418:expected-result :failed
419;; ====
420(defmacro testcover-testcase-nth-case (arg vec)
421 (declare (indent 1)
422 (debug (form (vector &rest form))))
423 `(eval (aref ,vec%%% ,arg%%%))%%%)
424
425(defun testcover-testcase-use-nth-case (choice val)
426 (testcover-testcase-nth-case choice
427 [(+ 1 val!!!)!!!
428 (- 1 val%%%)%%%
429 (* 7 val)
430 (/ 4 val!!!)!!!]))
431
432(should (eql 42 (testcover-testcase-use-nth-case 2 6)))
433(should (eql 49 (testcover-testcase-use-nth-case 2 7)))
434(should (eql 0 (testcover-testcase-use-nth-case 1 1 )))
435
436;; ==== mapcar-is-not-compose ====
437"Mapcar with 1value arguments is not 1value."
438:expected-result :failed
439;; ====
440(defvar testcover-testcase-num 0)
441(defun testcover-testcase-add-num (n)
442 (+ testcover-testcase-num n))
443(defun testcover-testcase-mapcar-sides ()
444 (mapcar 'testcover-testcase-add-num '(1 2 3)))
445
446(setq testcover-testcase-num 1)
447(should (equal (testcover-testcase-mapcar-sides) '(2 3 4)))
448(setq testcover-testcase-num 2)
449(should (equal (testcover-testcase-mapcar-sides) '(3 4 5)))
450
451;; ==== function-with-edebug-spec-bug-25316 ====
452"Functions can have edebug specs too.
453See c-make-font-lock-search-function for an example in the Emacs
454sources. The other issue is that it's ok to use quote in an
455edebug spec, so testcover needs to cope with that."
456:expected-result :failed
457;; ====
458(defun testcover-testcase-make-function (forms)
459 `(lambda (flag) (if flag 0 ,@forms%%%))%%%)
460
461(def-edebug-spec testcover-testcase-make-function
462 (("quote" (&rest def-form))))
463
464(defun testcover-testcase-thing ()
465 (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%)
466
467(defun testcover-testcase-use-thing ()
468 (funcall (testcover-testcase-thing)%%% nil)%%%)
469
470(should (equal (testcover-testcase-use-thing) 15))
471
472;; ==== backquoted-dotted-alist ====
473"Testcover can instrument a dotted alist constructed with backquote."
474;; ====
475(defun testcover-testcase-make-alist (expr entries)
476 `((0 . ,expr%%%) . ,entries%%%)%%%)
477
478(should (equal (testcover-testcase-make-alist "foo" '((1 . "bar") (2 . "baz")))
479 '((0 . "foo") (1 . "bar") (2 . "baz"))))
480
481;; ==== coverage-of-the-unknown-symbol-bug-25471 ====
482"Testcover correctly records coverage of code which uses `unknown'"
483:expected-result :failed
484;; ====
485(defun testcover-testcase-how-do-i-know-you (name)
486 (let ((val 'unknown))
487 (when (equal name%%% "Bob")%%%
488 (setq val 'known)!!!)
489 val%%%)%%%)
490
491(should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown))
492
493;; testcases.el ends here.
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
new file mode 100644
index 00000000000..d31379c3aa2
--- /dev/null
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -0,0 +1,186 @@
1;;; testcover-tests.el --- Testcover test suite -*- lexical-binding:t -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell
6
7;; This file is part of GNU Emacs.
8
9;; This program is free software: you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation, either version 3 of the
12;; License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17;; General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program. If not, see `http://www.gnu.org/licenses/'.
21
22;;; Commentary:
23
24;; Testcover test suite.
25;; * All the test cases are in testcover-resources/testcover-cases.el.
26;; See that file for an explanation of the test case format.
27;; * `testcover-tests-define-tests', which is run when this file is
28;; loaded, reads testcover-resources/testcover-cases.el and defines
29;; ERT tests for each test case.
30
31;;; Code:
32
33(require 'ert)
34(require 'testcover)
35(require 'skeleton)
36
37;; Use `eval-and-compile' around all these definitions because they're
38;; used by the macro `testcover-tests-define-tests'.
39
40(eval-and-compile
41 (defvar testcover-tests-file-dir
42 (expand-file-name
43 "testcover-resources/"
44 (file-name-directory (or (bound-and-true-p byte-compile-current-file)
45 load-file-name
46 buffer-file-name)))
47 "Directory of the \"testcover-tests.el\" file."))
48
49(eval-and-compile
50 (defvar testcover-tests-test-cases
51 (expand-file-name "testcases.el" testcover-tests-file-dir)
52 "File containing marked up code to instrument and check."))
53
54;; Convert Testcover's overlays to plain text.
55
56(eval-and-compile
57 (defun testcover-tests-markup-region (beg end &rest optargs)
58 "Mark up test code within region between BEG and END.
59Convert Testcover's tan and red splotches to %%% and !!! for
60testcases.el. This can be used to create test cases if Testcover
61is working correctly on a code sample. OPTARGS are optional
62arguments for `testcover-start'."
63 (interactive "r")
64 (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
65 (code (buffer-substring beg end))
66 (marked-up-code))
67 (unwind-protect
68 (progn
69 (with-temp-file tempfile
70 (insert code))
71 (save-current-buffer
72 (let ((buf (find-file-noselect tempfile)))
73 (set-buffer buf)
74 (apply 'testcover-start (cons tempfile optargs))
75 (testcover-mark-all buf)
76 (dolist (overlay (overlays-in (point-min) (point-max)))
77 (let ((ov-face (overlay-get overlay 'face)))
78 (goto-char (overlay-end overlay))
79 (cond
80 ((eq ov-face 'testcover-nohits) (insert "!!!"))
81 ((eq ov-face 'testcover-1value) (insert "%%%"))
82 (t nil))))
83 (setq marked-up-code (buffer-string)))
84 (set-buffer-modified-p nil)))
85 (ignore-errors (kill-buffer (find-file-noselect tempfile)))
86 (ignore-errors (delete-file tempfile)))
87
88 ;; Now replace the original code with the marked up code.
89 (delete-region beg end)
90 (insert marked-up-code))))
91
92(eval-and-compile
93 (defun testcover-tests-unmarkup-region (beg end)
94 "Remove the markup used in testcases.el between BEG and END."
95 (interactive "r")
96 (save-excursion
97 (save-restriction
98 (narrow-to-region beg end)
99 (goto-char (point-min))
100 (while (re-search-forward "!!!\\|%%%" nil t)
101 (replace-match ""))))))
102
103(define-skeleton testcover-tests-skeleton
104 "Write a testcase for testcover-tests.el."
105 "Enter name of test: "
106 ";; ==== " str " ====\n"
107 "\"docstring\"\n"
108 ";; Directives for ERT should go here, if any.\n"
109 ";; ====\n"
110 ";; Replace this line with annotated test code.\n")
111
112;; Check a test case.
113
114(eval-and-compile
115 (defun testcover-tests-run-test-case (marked-up-code)
116 "Test the operation of Testcover on the string MARKED-UP-CODE."
117 (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")))
118 (unwind-protect
119 (progn
120 (with-temp-file tempfile
121 (insert marked-up-code))
122 ;; Remove the marks and mark the code up again. The original
123 ;; and recreated versions should match.
124 (save-current-buffer
125 (set-buffer (find-file-noselect tempfile))
126 ;; Fail the test if the debugger tries to become active,
127 ;; which will happen if Testcover's reinstrumentation
128 ;; leaves an edebug-enter in the code. This will also
129 ;; prevent debugging these tests using Edebug.
130 (cl-letf (((symbol-function #'edebug-enter)
131 (lambda (&rest _args)
132 (ert-fail
133 (concat "Debugger invoked during test run "
134 "(possible edebug-enter not replaced)")))))
135 (dolist (byte-compile '(t nil))
136 (testcover-tests-unmarkup-region (point-min) (point-max))
137 (unwind-protect
138 (testcover-tests-markup-region (point-min) (point-max) byte-compile)
139 (set-buffer-modified-p nil))
140 (should (string= marked-up-code
141 (buffer-string)))))))
142 (ignore-errors (kill-buffer (find-file-noselect tempfile)))
143 (ignore-errors (delete-file tempfile))))))
144
145;; Convert test case file to ert-defmethod.
146
147(eval-and-compile
148 (defun testcover-tests-build-test-cases ()
149 "Parse the test case file and return a list of ERT test definitions.
150Construct and return a list of `ert-deftest' forms. See testcases.el
151for documentation of the test definition format."
152 (let (results)
153 (with-temp-buffer
154 (insert-file-contents testcover-tests-test-cases)
155 (goto-char (point-min))
156 (while (re-search-forward
157 (concat "^;; ==== \\([^ ]+?\\) ====\n"
158 "\\(\\(?:.*\n\\)*?\\)"
159 ";; ====\n"
160 "\\(\\(?:.*\n\\)*?\\)"
161 "\\(\\'\\|;; ====\\)")
162 nil t)
163 (let ((name (match-string 1))
164 (splice (car (read-from-string
165 (format "(%s)" (match-string 2)))))
166 (code (match-string 3)))
167 (push
168 `(ert-deftest ,(intern (concat "testcover-tests-" name)) ()
169 ,@splice
170 (testcover-tests-run-test-case ,code))
171 results))
172 (beginning-of-line)))
173 results)))
174
175;; Define all the tests.
176
177(defmacro testcover-tests-define-tests ()
178 "Construct and define ERT test methods using the test case file."
179 (let* ((test-cases (testcover-tests-build-test-cases)))
180 `(progn ,@test-cases)))
181
182(testcover-tests-define-tests)
183
184(provide 'testcover-tests)
185
186;;; testcover-tests.el ends here
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index a30ba25f8f0..2b3456d47f6 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -23,13 +23,18 @@
23(require 'ert) 23(require 'ert)
24(require 'faces) 24(require 'faces)
25 25
26(defgroup faces--test nil ""
27 :group 'faces--test)
28
26(defface faces--test1 29(defface faces--test1
27 '((t :background "black" :foreground "black")) 30 '((t :background "black" :foreground "black"))
28 "") 31 ""
32 :group 'faces--test)
29 33
30(defface faces--test2 34(defface faces--test2
31 '((t :box 1)) 35 '((t :box 1))
32 "") 36 ""
37 :group 'faces--test)
33 38
34(ert-deftest faces--test-color-at-point () 39(ert-deftest faces--test-color-at-point ()
35 (with-temp-buffer 40 (with-temp-buffer
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index a3fe3502461..827d751be69 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -44,7 +44,7 @@ index 3d7cebadcf..ad4b70d737 100644
44 str 44 str
45 (make-string ffap-max-region-length #xa) 45 (make-string ffap-max-region-length #xa)
46 (format "%s ENDS HERE" file))) 46 (format "%s ENDS HERE" file)))
47 (mark-whole-buffer) 47 (call-interactively 'mark-whole-buffer)
48 (should (equal "" (ffap-string-at-point))) 48 (should (equal "" (ffap-string-at-point)))
49 (should (equal '(1 1) ffap-string-at-point-region))))) 49 (should (equal '(1 1) ffap-string-at-point-region)))))
50 (and (file-exists-p file) (delete-file file))))) 50 (and (file-exists-p file) (delete-file file)))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index d237d0cc06e..27434bcef20 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -36,6 +36,7 @@
36;;; Code: 36;;; Code:
37 37
38(require 'ert) 38(require 'ert)
39(require 'ert-x)
39(require 'filenotify) 40(require 'filenotify)
40(require 'tramp) 41(require 'tramp)
41 42
@@ -703,21 +704,19 @@ delivered."
703 (should auto-revert-notify-watch-descriptor) 704 (should auto-revert-notify-watch-descriptor)
704 705
705 ;; Modify file. We wait for a second, in order to have 706 ;; Modify file. We wait for a second, in order to have
706 ;; another timestamp. 707 ;; another timestamp.
707 (with-current-buffer (get-buffer-create "*Messages*") 708 (ert-with-message-capture captured-messages
708 (narrow-to-region (point-max) (point-max))) 709 (sleep-for 1)
709 (sleep-for 1) 710 (write-region
710 (write-region 711 "another text" nil file-notify--test-tmpfile nil 'no-message)
711 "another text" nil file-notify--test-tmpfile nil 'no-message) 712
712 713 ;; Check, that the buffer has been reverted.
713 ;; Check, that the buffer has been reverted. 714 (file-notify--wait-for-events
714 (with-current-buffer (get-buffer-create "*Messages*") 715 timeout
715 (file-notify--wait-for-events 716 (string-match
716 timeout
717 (string-match
718 (format-message "Reverting buffer `%s'." (buffer-name buf)) 717 (format-message "Reverting buffer `%s'." (buffer-name buf))
719 (buffer-string)))) 718 captured-messages))
720 (should (string-match "another text" (buffer-string))) 719 (should (string-match "another text" (buffer-string))))
721 720
722 ;; Stop file notification. Autorevert shall still work via polling. 721 ;; Stop file notification. Autorevert shall still work via polling.
723 (file-notify-rm-watch auto-revert-notify-watch-descriptor) 722 (file-notify-rm-watch auto-revert-notify-watch-descriptor)
@@ -728,27 +727,24 @@ delivered."
728 727
729 ;; Modify file. We wait for two seconds, in order to 728 ;; Modify file. We wait for two seconds, in order to
730 ;; have another timestamp. One second seems to be too 729 ;; have another timestamp. One second seems to be too
731 ;; short. 730 ;; short.
732 (with-current-buffer (get-buffer-create "*Messages*") 731 (ert-with-message-capture captured-messages
733 (narrow-to-region (point-max) (point-max))) 732 (sleep-for 2)
734 (sleep-for 2) 733 (write-region
735 (write-region 734 "foo bla" nil file-notify--test-tmpfile nil 'no-message)
736 "foo bla" nil file-notify--test-tmpfile nil 'no-message) 735
737 736 ;; Check, that the buffer has been reverted.
738 ;; Check, that the buffer has been reverted. 737 (file-notify--wait-for-events
739 (with-current-buffer (get-buffer-create "*Messages*") 738 timeout
740 (file-notify--wait-for-events 739 (string-match
741 timeout 740 (format-message "Reverting buffer `%s'." (buffer-name buf))
742 (string-match 741 captured-messages))
743 (format-message "Reverting buffer `%s'." (buffer-name buf)) 742 (should (string-match "foo bla" (buffer-string)))))
744 (buffer-string))))
745 (should (string-match "foo bla" (buffer-string))))
746 743
747 ;; The environment shall be cleaned up. 744 ;; The environment shall be cleaned up.
748 (file-notify--test-cleanup-p)) 745 (file-notify--test-cleanup-p))
749 746
750 ;; Cleanup. 747 ;; Cleanup.
751 (with-current-buffer "*Messages*" (widen))
752 (ignore-errors (kill-buffer buf)) 748 (ignore-errors (kill-buffer buf))
753 (file-notify--test-cleanup)))) 749 (file-notify--test-cleanup))))
754 750
@@ -850,6 +846,13 @@ delivered."
850 ;; After deleting the parent directory, the descriptor must 846 ;; After deleting the parent directory, the descriptor must
851 ;; not be valid anymore. 847 ;; not be valid anymore.
852 (should-not (file-notify-valid-p file-notify--test-desc)) 848 (should-not (file-notify-valid-p file-notify--test-desc))
849 ;; w32notify doesn't generate 'stopped' events when the parent
850 ;; directory is deleted, which doesn't provide a chance for
851 ;; filenotify.el to remove the descriptor from the internal
852 ;; hash table it maintains. So we must remove the descriptor
853 ;; manually.
854 (if (string-equal (file-notify--test-library) "w32notify")
855 (file-notify--rm-descriptor file-notify--test-desc))
853 856
854 ;; The environment shall be cleaned up. 857 ;; The environment shall be cleaned up.
855 (file-notify--test-cleanup-p)) 858 (file-notify--test-cleanup-p))
@@ -906,6 +909,8 @@ delivered."
906 (file-notify--test-timeout) 909 (file-notify--test-timeout)
907 (not (file-notify-valid-p file-notify--test-desc))) 910 (not (file-notify-valid-p file-notify--test-desc)))
908 (should-not (file-notify-valid-p file-notify--test-desc)) 911 (should-not (file-notify-valid-p file-notify--test-desc))
912 (if (string-equal (file-notify--test-library) "w32notify")
913 (file-notify--rm-descriptor file-notify--test-desc))
909 914
910 ;; The environment shall be cleaned up. 915 ;; The environment shall be cleaned up.
911 (file-notify--test-cleanup-p)) 916 (file-notify--test-cleanup-p))
@@ -975,6 +980,8 @@ delivered."
975 (file-notify--test-read-event) 980 (file-notify--test-read-event)
976 (delete-file file))) 981 (delete-file file)))
977 (delete-directory file-notify--test-tmpfile) 982 (delete-directory file-notify--test-tmpfile)
983 (if (string-equal (file-notify--test-library) "w32notify")
984 (file-notify--rm-descriptor file-notify--test-desc))
978 985
979 ;; The environment shall be cleaned up. 986 ;; The environment shall be cleaned up.
980 (file-notify--test-cleanup-p)) 987 (file-notify--test-cleanup-p))
@@ -1184,6 +1191,9 @@ the file watch."
1184 (delete-directory file-notify--test-tmpfile 'recursive)) 1191 (delete-directory file-notify--test-tmpfile 'recursive))
1185 (should-not (file-notify-valid-p file-notify--test-desc1)) 1192 (should-not (file-notify-valid-p file-notify--test-desc1))
1186 (should-not (file-notify-valid-p file-notify--test-desc2)) 1193 (should-not (file-notify-valid-p file-notify--test-desc2))
1194 (when (string-equal (file-notify--test-library) "w32notify")
1195 (file-notify--rm-descriptor file-notify--test-desc1)
1196 (file-notify--rm-descriptor file-notify--test-desc2))
1187 1197
1188 ;; The environment shall be cleaned up. 1198 ;; The environment shall be cleaned up.
1189 (file-notify--test-cleanup-p)) 1199 (file-notify--test-cleanup-p))
diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el
index 15eb7c170c9..4a1d566e96c 100644
--- a/test/lisp/htmlfontify-tests.el
+++ b/test/lisp/htmlfontify-tests.el
@@ -30,5 +30,17 @@
30 (symbol-function 30 (symbol-function
31 'htmlfontify-load-rgb-file)))) 31 'htmlfontify-load-rgb-file))))
32 32
33(ert-deftest htmlfontify-bug25468 ()
34 "Tests that htmlfontify can be loaded even if no shell is
35available (Bug#25468)."
36 (should (equal (let ((process-environment
37 (cons "SHELL=/does/not/exist" process-environment)))
38 (call-process
39 (expand-file-name (invocation-name) (invocation-directory))
40 nil nil nil
41 "--quick" "--batch"
42 (concat "--load=" (locate-library "htmlfontify"))))
43 0)))
44
33(provide 'htmlfontify-tests) 45(provide 'htmlfontify-tests)
34;; htmlfontify-tests.el ends here 46;; htmlfontify-tests.el ends here
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index fb632e2073d..b9f7fe7cde8 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -23,6 +23,15 @@
23(eval-when-compile 23(eval-when-compile
24 (require 'ibuf-macs)) 24 (require 'ibuf-macs))
25 25
26(defvar ibuffer-filter-groups)
27(defvar ibuffer-filtering-alist)
28(defvar ibuffer-filtering-qualifiers)
29(defvar ibuffer-save-with-custom)
30(defvar ibuffer-saved-filter-groups)
31(defvar ibuffer-saved-filters)
32(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier))
33(declare-function ibuffer-unary-operand "ibuf-ext" (filter))
34
26(ert-deftest ibuffer-autoload () 35(ert-deftest ibuffer-autoload ()
27 "Tests to see whether ibuffer has been autoloaded" 36 "Tests to see whether ibuffer has been autoloaded"
28 (skip-unless (not (featurep 'ibuf-ext))) 37 (skip-unless (not (featurep 'ibuf-ext)))
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
new file mode 100644
index 00000000000..5124cbbf962
--- /dev/null
+++ b/test/lisp/kmacro-tests.el
@@ -0,0 +1,890 @@
1;;; kmacro-tests.el --- Tests for kmacro.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell <gazally@runbox.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;;; Code:
25
26(require 'kmacro)
27(require 'ert)
28(require 'ert-x)
29
30;;; Test fixtures:
31
32(defmacro kmacro-tests-with-kmacro-clean-slate (&rest body)
33 "Create a clean environment for a kmacro test BODY to run in."
34 (declare (debug (body)))
35 `(cl-letf* ((kmacro-execute-before-append t)
36 (kmacro-ring-max 8)
37 (kmacro-repeat-no-prefix t)
38 (kmacro-call-repeat-key nil)
39 (kmacro-call-repeat-with-arg nil)
40
41 (kbd-macro-termination-hook nil)
42 (defining-kbd-macro nil)
43 (executing-kbd-macro nil)
44 (executing-kbd-macro-index 0)
45 (last-kbd-macro nil)
46
47 (kmacro-ring nil)
48
49 (kmacro-counter 0)
50 (kmacro-default-counter-format "%d")
51 (kmacro-counter-format "%d")
52 (kmacro-counter-format-start "%d")
53 (kmacro-counter-value-start 0)
54 (kmacro-last-counter 0)
55 (kmacro-initial-counter-value nil)
56
57 (kmacro-tests-macros nil)
58 (kmacro-tests-events nil)
59 (kmacro-tests-sequences nil))
60 (advice-add 'end-kbd-macro :after #'kmacro-tests-end-macro-advice)
61 (advice-add 'read-event :around #'kmacro-tests-read-event-advice )
62 (advice-add 'read-key-sequence :around #'kmacro-tests-read-key-sequence-advice)
63 (unwind-protect
64 (ert-with-test-buffer (:name "")
65 (switch-to-buffer (current-buffer))
66 ,@body)
67 (advice-remove 'read-key-sequence #'kmacro-tests-read-key-sequence-advice)
68 (advice-remove 'read-event #'kmacro-tests-read-event-advice)
69 (advice-remove 'end-kbd-macro #'kmacro-tests-end-macro-advice))))
70
71(defmacro kmacro-tests-deftest (name _args docstring &rest keys-and-body)
72 "Define a kmacro unit test.
73NAME is the name of the test, _ARGS should be nil, and DOCSTRING
74is required. To avoid having to duplicate ert's keyword parsing
75here, its keywords and values (if any) must be inside a list
76after the docstring, preceding the body, here combined with the
77body in KEYS-AND-BODY."
78 (declare (debug (&define name sexp stringp
79 [&optional (&rest &or [keywordp sexp])]
80 def-body))
81 (doc-string 3)
82 (indent 2))
83
84 (let* ((keys (when (and (listp (car keys-and-body))
85 (keywordp (caar keys-and-body)))
86 (car keys-and-body)))
87 (body (if keys (cdr keys-and-body)
88 keys-and-body)))
89 `(ert-deftest ,name ()
90 ,docstring ,@keys
91 (kmacro-tests-with-kmacro-clean-slate ,@body))))
92
93(defvar kmacro-tests-keymap
94 (let ((map (make-sparse-keymap)))
95 (dotimes (i 26)
96 (define-key map (string (+ ?a i)) 'self-insert-command))
97 (dotimes (i 10)
98 (define-key map (string (+ ?0 i)) 'self-insert-command))
99 ;; Define a few key sequences of different lengths.
100 (dolist (item '(("\C-a" . beginning-of-line)
101 ("\C-b" . backward-char)
102 ("\C-e" . end-of-line)
103 ("\C-f" . forward-char)
104 ("\C-r" . isearch-backward)
105 ("\C-u" . universal-argument)
106 ("\C-w" . kill-region)
107 ("\C-SPC" . set-mark-command)
108 ("\M-w" . kill-ring-save)
109 ("\M-x" . execute-extended-command)
110 ("\C-cd" . downcase-word)
111 ("\C-cxu" . upcase-word)
112 ("\C-cxq" . quoted-insert)
113 ("\C-cxi" . kmacro-insert-counter)
114 ("\C-x\C-k" . kmacro-keymap)))
115 (define-key map (car item) (cdr item)))
116 map)
117 "Keymap to use for testing keyboard macros.
118This is used to obtain consistent results even if tests are run
119in an environment with rebound keys.")
120
121(defvar kmacro-tests-events nil
122 "Input events used by the kmacro test in progress.")
123
124(defun kmacro-tests-read-event-advice (orig-func &rest args)
125 "Pop and return an event from `kmacro-tests-events'.
126Return the result of calling ORIG-FUNC with ARGS if
127`kmacro-tests-events' is empty, or if a keyboard macro is
128running."
129 (if (or executing-kbd-macro (null kmacro-tests-events))
130 (apply orig-func args)
131 (pop kmacro-tests-events)))
132
133(defvar kmacro-tests-sequences nil
134 "Input sequences used by the kmacro test in progress.")
135
136(defun kmacro-tests-read-key-sequence-advice (orig-func &rest args)
137 "Pop and return a string from `kmacro-tests-sequences'.
138Return the result of calling ORIG-FUNC with ARGS if
139`kmacro-tests-sequences' is empty, or if a keyboard macro is
140running."
141 (if (or executing-kbd-macro (null kmacro-tests-sequences))
142 (apply orig-func args)
143 (pop kmacro-tests-sequences)))
144
145(defvar kmacro-tests-macros nil
146 "Keyboard macros (in vector form) used by the kmacro test in progress.")
147
148(defun kmacro-tests-end-macro-advice (&rest _args)
149 "Pop a macro from `kmacro-tests-macros' and assign it to `last-kbd-macro'.
150If `kmacro-tests-macros' is empty, do nothing."
151 (when kmacro-tests-macros
152 (setq last-kbd-macro (pop kmacro-tests-macros))))
153
154;;; Some more powerful expectations:
155
156(defmacro kmacro-tests-should-insert (value &rest body)
157 "Verify that VALUE is inserted by the execution of BODY.
158Execute BODY, then check that the string VALUE was inserted
159into the current buffer at point."
160 (declare (debug (stringp body))
161 (indent 1))
162 (let ((g-p (cl-gensym))
163 (g-bsize (cl-gensym)))
164 `(let ((,g-p (point))
165 (,g-bsize (buffer-size)))
166 ,@body
167 (should (equal (buffer-substring ,g-p (point)) ,value))
168 (should (equal (- (buffer-size) ,g-bsize) (length ,value))))))
169
170(defmacro kmacro-tests-should-match-message (value &rest body)
171 "Verify that a message matching VALUE is issued while executing BODY.
172Execute BODY, and then if there is not a regexp match between
173VALUE and any text written to *Messages* during the execution,
174cause the current test to fail."
175 (declare (debug (form body))
176 (indent 1))
177 (let ((g-captured-messages (cl-gensym)))
178 `(ert-with-message-capture ,g-captured-messages
179 ,@body
180 (should (string-match-p ,value ,g-captured-messages)))))
181
182;;; Tests:
183
184(kmacro-tests-deftest kmacro-tests-test-insert-counter-01-nil ()
185 "`kmacro-insert-counter' adds one to macro counter with nil arg."
186 (kmacro-tests-should-insert "0"
187 (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
188 (kmacro-tests-should-insert "1"
189 (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
190
191(kmacro-tests-deftest kmacro-tests-test-insert-counter-02-int ()
192 "`kmacro-insert-counter' increments by value of list argument."
193 (kmacro-tests-should-insert "0"
194 (kmacro-tests-simulate-command '(kmacro-insert-counter 2)))
195 (kmacro-tests-should-insert "2"
196 (kmacro-tests-simulate-command '(kmacro-insert-counter 3)))
197 (kmacro-tests-should-insert "5"
198 (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
199
200(kmacro-tests-deftest kmacro-tests-test-insert-counter-03-list ()
201 "`kmacro-insert-counter' doesn't increment when given universal argument."
202 (kmacro-tests-should-insert "0"
203 (kmacro-tests-simulate-command '(kmacro-insert-counter (16))))
204 (kmacro-tests-should-insert "0"
205 (kmacro-tests-simulate-command '(kmacro-insert-counter (4)))))
206
207(kmacro-tests-deftest kmacro-tests-test-insert-counter-04-neg ()
208 "`kmacro-insert-counter' decrements with '- prefix argument"
209 (kmacro-tests-should-insert "0"
210 (kmacro-tests-simulate-command '(kmacro-insert-counter -)))
211 (kmacro-tests-should-insert "-1"
212 (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
213
214(kmacro-tests-deftest kmacro-tests-test-start-format-counter ()
215 "`kmacro-insert-counter' uses start value and format."
216 (kmacro-tests-simulate-command '(kmacro-set-counter 10))
217 (kmacro-tests-should-insert "10"
218 (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
219 (kmacro-tests-should-insert "11"
220 (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
221 (kmacro-set-format "c=%s")
222 (kmacro-tests-simulate-command '(kmacro-set-counter 50))
223 (kmacro-tests-should-insert "c=50"
224 (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
225
226(kmacro-tests-deftest kmacro-tests-test-start-macro-when-defining-macro ()
227 "Starting a macro while defining a macro does not start a second macro."
228 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
229 ;; We should now be in the macro-recording state.
230 (should defining-kbd-macro)
231 (should-not last-kbd-macro)
232 ;; Calling it again should leave us in the same state.
233 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
234 (should defining-kbd-macro)
235 (should-not last-kbd-macro))
236
237
238(kmacro-tests-deftest kmacro-tests-set-macro-counter-while-defining ()
239 "Use of the prefix arg with kmacro-start sets kmacro-counter."
240 ;; Give kmacro-start-macro an argument.
241 (kmacro-tests-simulate-command '(kmacro-start-macro 5))
242 (should defining-kbd-macro)
243 ;; Verify that the counter is set to that value.
244 (kmacro-tests-should-insert "5"
245 (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
246 ;; Change it while defining a macro.
247 (kmacro-tests-simulate-command '(kmacro-set-counter 1))
248 (kmacro-tests-should-insert "1"
249 (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
250 ;; Using universal arg to to set counter should reset to starting value.
251 (kmacro-tests-simulate-command '(kmacro-set-counter (4)) '(4))
252 (kmacro-tests-should-insert "5"
253 (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
254
255
256(kmacro-tests-deftest kmacro-tests-start-insert-counter-appends-to-macro ()
257 "Use of the universal arg appends to the previous macro."
258 (let ((kmacro-tests-macros (list (string-to-vector "hello"))))
259 ;; Start recording a macro.
260 (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil))
261 ;; Make sure we are recording.
262 (should defining-kbd-macro)
263 ;; Call it again and it should insert the counter.
264 (kmacro-tests-should-insert "0"
265 (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil)))
266 ;; We should still be in the recording state.
267 (should defining-kbd-macro)
268 ;; End recording with repeat count.
269 (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 3))
270 ;; Recording should be finished.
271 (should-not defining-kbd-macro)
272 ;; Now use prefix arg to append to the previous macro.
273 ;; This should run the previous macro first.
274 (kmacro-tests-should-insert "hello"
275 (kmacro-tests-simulate-command
276 '(kmacro-start-macro-or-insert-counter (4))))
277 ;; Verify that the recording state has changed.
278 (should (equal defining-kbd-macro 'append))))
279
280(kmacro-tests-deftest kmacro-tests-end-call-macro-prefix-args ()
281 "kmacro-end-call-macro changes behavior based on prefix arg."
282 ;; "Record" two macros.
283 (dotimes (i 2)
284 (kmacro-tests-define-macro (vconcat (format "macro #%d" (1+ i)))))
285 ;; With no prefix arg, it should call the second macro.
286 (kmacro-tests-should-insert "macro #2"
287 (kmacro-tests-simulate-command '(kmacro-end-or-call-macro nil)))
288 ;; With universal arg, it should call the first one.
289 (kmacro-tests-should-insert "macro #1"
290 (kmacro-tests-simulate-command '(kmacro-end-or-call-macro (4)))))
291
292(kmacro-tests-deftest kmacro-tests-end-and-call-macro ()
293 "Keyboard command to end and call macro works under various conditions."
294 ;; First, try it with no macro to record.
295 (setq kmacro-tests-macros '(""))
296 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
297 (condition-case err
298 (kmacro-tests-simulate-command '(kmacro-end-and-call-macro 2) 2)
299 (error (should (string= (cadr err)
300 "No kbd macro has been defined"))))
301
302 ;; Check that it stopped defining and that no macro was recorded.
303 (should-not defining-kbd-macro)
304 (should-not last-kbd-macro)
305
306 ;; Now try it while not recording, but first record a non-nil macro.
307 (kmacro-tests-define-macro "macro")
308 (kmacro-tests-should-insert "macro"
309 (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil))))
310
311(kmacro-tests-deftest kmacro-tests-end-and-call-macro-mouse ()
312 "Commands to end and call macro work under various conditions.
313This is a regression test for Bug#24992."
314 (:expected-result :failed)
315 (cl-letf (((symbol-function #'mouse-set-point) #'ignore))
316 ;; First, try it with no macro to record.
317 (setq kmacro-tests-macros '(""))
318 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
319 (condition-case err
320 (kmacro-tests-simulate-command '(kmacro-end-call-mouse 2) 2)
321 (error (should (string= (cadr err)
322 "No kbd macro has been defined"))))
323
324 ;; Check that it stopped defining and that no macro was recorded.
325 (should-not defining-kbd-macro)
326 (should-not last-kbd-macro)
327
328 ;; Now try it while not recording, but first record a non-nil macro.
329 (kmacro-tests-define-macro "macro")
330 (kmacro-tests-should-insert "macro"
331 (kmacro-tests-simulate-command '(kmacro-end-call-mouse nil)))))
332
333(kmacro-tests-deftest kmacro-tests-call-macro-hint-and-repeat ()
334 "`kmacro-call-macro' gives hint in Messages and sets up repeat keymap.
335This is a regression test for: Bug#3412, Bug#11817."
336 (kmacro-tests-define-macro [?m])
337 (let ((kmacro-call-repeat-key t)
338 (kmacro-call-repeat-with-arg t)
339 (overriding-terminal-local-map overriding-terminal-local-map)
340 (last-input-event ?e))
341 (message "") ; Clear the echo area. (Bug#3412)
342 (kmacro-tests-should-match-message "Type e to repeat macro"
343 (kmacro-tests-should-insert "mmmmmm"
344 (cl-letf (((symbol-function #'this-single-command-keys) (lambda ()
345 [?\C-x ?e])))
346 (kmacro-call-macro 3))
347 ;; Check that it set up for repeat, and run the repeat.
348 (funcall (lookup-key overriding-terminal-local-map "e"))))))
349
350(kmacro-tests-deftest
351 kmacro-tests-run-macro-command-recorded-in-macro ()
352 "No infinite loop if `kmacro-end-and-call-macro' is recorded in the macro.
353\(Bug#15126)"
354 (:expected-result :failed)
355 (ert-skip "Skipping due to Bug#24921 (an ERT bug)")
356 (kmacro-tests-define-macro (vconcat "foo" [return] "\M-x"
357 "kmacro-end-and-call-macro"))
358 (use-local-map kmacro-tests-keymap)
359 (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil)))
360
361
362(kmacro-tests-deftest kmacro-tests-test-ring-2nd-commands ()
363 "2nd macro in ring is displayed and executed normally and on repeat."
364 (use-local-map kmacro-tests-keymap)
365 ;; Record one macro, with count.
366 (push (vconcat "\C-cxi" "\C-u\C-cxi") kmacro-tests-macros)
367 (kmacro-tests-simulate-command '(kmacro-start-macro 1))
368 (kmacro-tests-simulate-command '(kmacro-end-macro nil))
369 ;; Check that execute and display do nothing with no 2nd macro.
370 (kmacro-tests-should-insert ""
371 (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil)))
372 (kmacro-tests-should-match-message "Only one keyboard macro defined"
373 (kmacro-tests-simulate-command '(kmacro-view-ring-2nd)))
374 ;; Record another one, with format.
375 (kmacro-set-format "=%d=")
376 (kmacro-tests-define-macro (vconcat "bar"))
377 ;; Execute the first one, mocked up to insert counter.
378 ;; Should get default format.
379 (kmacro-tests-should-insert "11"
380 (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil)))
381 ;; Now display the 2nd ring macro and check result.
382 (kmacro-tests-should-match-message "C-c x i C-u C-c x i"
383 (kmacro-view-ring-2nd)))
384
385(kmacro-tests-deftest kmacro-tests-fill-ring-and-rotate ()
386 "Macro ring can shift one way, shift the other way, swap and pop."
387 (cl-letf ((kmacro-ring-max 4))
388 ;; Record enough macros that the first one drops off the history.
389 (dotimes (n (1+ kmacro-ring-max))
390 (kmacro-tests-define-macro (make-vector (1+ n) (+ ?a n))))
391 ;; Cycle the ring and check that #2 comes up.
392 (kmacro-tests-should-match-message "2*b"
393 (kmacro-tests-simulate-command '(kmacro-cycle-ring-next nil)))
394 ;; Execute the current macro and check arguments.
395 (kmacro-tests-should-insert "bbbb"
396 (kmacro-call-macro 2 t))
397 ;; Cycle the ring the other way; #5 expected.
398 (kmacro-tests-should-match-message "5*e" (kmacro-cycle-ring-previous nil))
399 ;; Swapping the top two should give #4.
400 (kmacro-tests-should-match-message "4*d" (kmacro-swap-ring))
401 ;; Delete the top and expect #5.
402 (kmacro-tests-should-match-message "5*e" (kmacro-delete-ring-head))))
403
404
405(kmacro-tests-deftest kmacro-tests-test-ring-commands-when-no-macros ()
406 "Ring commands give appropriate message when no macros exist."
407 (dolist (cmd '((kmacro-cycle-ring-next nil)
408 (kmacro-cycle-ring-previous nil)
409 (kmacro-swap-ring)
410 (kmacro-delete-ring-head)
411 (kmacro-view-ring-2nd)
412 (kmacro-call-ring-2nd nil)
413 (kmacro-view-macro)))
414 (kmacro-tests-should-match-message "No keyboard macro defined"
415 (kmacro-tests-simulate-command cmd))))
416
417(kmacro-tests-deftest kmacro-tests-repeat-on-last-key ()
418 "Kmacro commands can be run in sequence without prefix keys."
419 (let* ((prefix (where-is-internal 'kmacro-keymap nil t))
420 ;; Make a sequence of events to run.
421 ;; Comments are expected output of mock macros
422 ;; on the first and second run of the sequence (see below).
423 (events (mapcar #'kmacro-tests-get-kmacro-key
424 '(kmacro-end-or-call-macro-repeat ;c / b
425 kmacro-end-or-call-macro-repeat ;c / b
426 kmacro-call-ring-2nd-repeat ;b / a
427 kmacro-cycle-ring-next
428 kmacro-end-or-call-macro-repeat ;a / a
429 kmacro-cycle-ring-previous
430 kmacro-end-or-call-macro-repeat ;c / b
431 kmacro-delete-ring-head
432 kmacro-end-or-call-macro-repeat ;b / a
433 )))
434 (kmacro-tests-macros (list [?a] [?b] [?c]))
435 ;; What we want kmacro to see as keyboard command sequence
436 (first-event (seq-concatenate
437 'vector
438 prefix
439 (vector (kmacro-tests-get-kmacro-key
440 'kmacro-end-or-call-macro-repeat)))))
441 (cl-letf
442 ;; standardize repeat options
443 ((kmacro-repeat-no-prefix t)
444 (kmacro-call-repeat-key t)
445 (kmacro-call-repeat-with-arg nil))
446 ;; "Record" two macros
447 (dotimes (_n 2)
448 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
449 (kmacro-tests-simulate-command '(kmacro-end-macro nil)))
450 ;; Start recording #3
451 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
452
453 ;; Set up pending keyboard events and a fresh buffer
454 ;; kmacro-set-counter is not one of the repeating kmacro
455 ;; commands so it should end the sequence.
456 (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-set-counter))
457 (kmacro-tests-events (append events (list end-key))))
458 (cl-letf (((symbol-function #'this-single-command-keys)
459 (lambda () first-event)))
460 (use-local-map kmacro-tests-keymap)
461 (kmacro-tests-should-insert "ccbacb"
462 ;; End #3 and launch loop to read events.
463 (kmacro-end-or-call-macro-repeat nil))))
464
465 ;; `kmacro-edit-macro-repeat' should also stop the sequence,
466 ;; so run it again with that at the end.
467 (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-edit-macro-repeat))
468 (kmacro-tests-events (append events (list end-key))))
469 (cl-letf (((symbol-function #'edit-kbd-macro) #'ignore)
470 ((symbol-function #'this-single-command-keys)
471 (lambda () first-event)))
472 (use-local-map kmacro-tests-keymap)
473 (kmacro-tests-should-insert "bbbbbaaba"
474 (kmacro-end-or-call-macro-repeat 3)))))))
475
476(kmacro-tests-deftest kmacro-tests-repeat-view-and-run ()
477 "Kmacro view cycles through ring and executes macro just viewed."
478 (let* ((prefix (where-is-internal 'kmacro-keymap nil t))
479 (kmacro-tests-events
480 (mapcar #'kmacro-tests-get-kmacro-key
481 (append (make-list 5 'kmacro-view-macro-repeat)
482 '(kmacro-end-or-call-macro-repeat
483 kmacro-set-counter))))
484 ;; Make kmacro see this as keyboard command sequence.
485 (first-event (seq-concatenate
486 'vector
487 prefix
488 (vector (kmacro-tests-get-kmacro-key
489 'kmacro-view-macro-repeat))))
490 ;; Construct a regexp to match the messages which should be
491 ;; produced by repeated view-repeats.
492 (macros-regexp (apply #'concat
493 (mapcar (lambda (c) (format ".+%s\n" c))
494 '("d" "c" "b" "a" "d" "c")))))
495 (cl-letf ((kmacro-repeat-no-prefix t)
496 (kmacro-call-repeat-key t)
497 (kmacro-call-repeat-with-arg nil)
498 ((symbol-function #'this-single-command-keys) (lambda ()
499 first-event)))
500 ;; "Record" some macros.
501 (dotimes (n 4)
502 (kmacro-tests-define-macro (make-vector 1 (+ ?a n))))
503
504 (use-local-map kmacro-tests-keymap)
505 ;; 6 views (the direct call plus the 5 in events) should
506 ;; cycle through the ring and get to the second-to-last
507 ;; macro defined.
508 (kmacro-tests-should-insert "c"
509 (kmacro-tests-should-match-message macros-regexp
510 (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil)))))))
511
512(kmacro-tests-deftest kmacro-tests-bind-to-key-when-recording ()
513 "Bind to key doesn't bind a key during macro recording."
514 (cl-letf ((global-map global-map)
515 (saved-binding (key-binding "\C-a"))
516 (kmacro-tests-sequences (list "\C-a")))
517 (kmacro-tests-simulate-command '(kmacro-start-macro 1))
518 (kmacro-bind-to-key nil)
519 (should (eq saved-binding (key-binding "\C-a")))))
520
521(kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro ()
522 "Bind to key, symbol or register fails when when no macro exists."
523 (should-error (kmacro-bind-to-key nil))
524 (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
525 (should-error (kmacro-to-register)))
526
527(kmacro-tests-deftest kmacro-tests-bind-to-key-bad-key-sequence ()
528 "Bind to key fails to bind to ^G."
529 (let ((global-map global-map)
530 (saved-binding (key-binding "\C-g"))
531 (kmacro-tests-sequences (list "\C-g")))
532 (kmacro-tests-define-macro [1])
533 (kmacro-bind-to-key nil)
534 (should (eq saved-binding (key-binding "\C-g")))))
535
536(kmacro-tests-deftest kmacro-tests-bind-to-key-with-key-sequence-in-use ()
537 "Bind to key respects yes-or-no-p when given already bound key sequence."
538 (kmacro-tests-define-macro (vconcat "abaab"))
539 (let ((global-map global-map)
540 (map (make-sparse-keymap))
541 (kmacro-tests-sequences (make-list 2 "\C-hi")))
542 (define-key map "\C-hi" 'info)
543 (use-local-map map)
544 ;; Try the command with yes-or-no-p set up to say no.
545 (cl-letf (((symbol-function #'yes-or-no-p)
546 (lambda (prompt)
547 (should (string-match-p "info" prompt))
548 (should (string-match-p "C-h i" prompt))
549 nil)))
550 (kmacro-bind-to-key nil))
551
552 (should (equal (where-is-internal 'info nil t)
553 (vconcat "\C-hi")))
554 ;; Try it again with yes.
555 (cl-letf (((symbol-function #' yes-or-no-p)
556 (lambda (_prompt) t)))
557 (kmacro-bind-to-key nil))
558
559 (should-not (equal (where-is-internal 'info global-map t)
560 (vconcat "\C-hi")))
561 (use-local-map nil)
562 (kmacro-tests-should-insert "abaab"
563 (funcall (key-binding "\C-hi")))))
564
565(kmacro-tests-deftest kmacro-tests-kmacro-bind-to-single-key ()
566 "Bind to key uses C-x C-k A when asked to bind to A."
567 (let ((global-map global-map)
568 (kmacro-tests-macros (list (string-to-vector "\C-cxi"))))
569 (use-local-map kmacro-tests-keymap)
570
571 ;; Record a macro with counter and format set.
572 (kmacro-set-format "<%d>")
573 (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter 5))
574 (kmacro-tests-simulate-command '(kmacro-end-macro nil))
575
576 (let ((kmacro-tests-sequences (list "A")))
577 (kmacro-bind-to-key nil))
578
579 ;; Record a second macro with different counter and format.
580 (kmacro-set-format "%d")
581 (kmacro-tests-define-macro [2])
582
583 ;; Check the bound key and run it and verify correct counter
584 ;; and format.
585 (should (equal (string-to-vector "\C-cxi")
586 (car (kmacro-extract-lambda
587 (key-binding "\C-x\C-kA")))))
588 (kmacro-tests-should-insert "<5>"
589 (funcall (key-binding "\C-x\C-kA")))))
590
591(kmacro-tests-deftest kmacro-tests-name-last-macro-unable-to-bind ()
592 "Name last macro won't bind to symbol which is already bound."
593 (kmacro-tests-define-macro [1])
594 ;; Set up a test symbol which looks like a function.
595 (setplist 'kmacro-tests-symbol-for-test nil)
596 (fset 'kmacro-tests-symbol-for-test #'ignore)
597 (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
598 ;; The empty string symbol also can't be bound.
599 (should-error (kmacro-name-last-macro (make-symbol ""))))
600
601(kmacro-tests-deftest kmacro-tests-name-last-macro-bind-and-rebind ()
602 "Name last macro can rebind a symbol it binds."
603 ;; Make sure our symbol is unbound.
604 (when (fboundp 'kmacro-tests-symbol-for-test)
605 (fmakunbound 'kmacro-tests-symbol-for-test))
606 (setplist 'kmacro-tests-symbol-for-test nil)
607 ;; Make two macros and bind them to the same symbol.
608 (dotimes (i 2)
609 (kmacro-tests-define-macro (make-vector (1+ i) (+ ?a i)))
610 (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)
611 (should (fboundp 'kmacro-tests-symbol-for-test)))
612
613 ;; Now run the function bound to the symbol. Result should be the
614 ;; second macro.
615 (kmacro-tests-should-insert "bb"
616 (kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test))))
617
618(kmacro-tests-deftest kmacro-tests-store-in-register ()
619 "Macro can be stored in and retrieved from a register."
620 (use-local-map kmacro-tests-keymap)
621 ;; Save and restore register 200 so we can use it for the test.
622 (let ((saved-reg-contents (get-register 200)))
623 (unwind-protect
624 (progn
625 ;; Define a macro, and save it to a register.
626 (kmacro-tests-define-macro (vconcat "a\C-a\C-cxu"))
627 (kmacro-to-register 200)
628 ;; Then make a new different macro.
629 (kmacro-tests-define-macro (vconcat "bb\C-a\C-cxu"))
630 ;; When called from the register, result should be first macro.
631 (kmacro-tests-should-insert "AAA"
632 (kmacro-tests-simulate-command '(jump-to-register 200 3) 3))
633 (kmacro-tests-should-insert "a C-a C-c x u"
634 (kmacro-tests-simulate-command '(insert-register 200 t) '(4))))
635 (set-register 200 saved-reg-contents))))
636
637(kmacro-tests-deftest kmacro-tests-step-edit-act ()
638 "Step-edit steps-through a macro with act and act-repeat."
639 (kmacro-tests-run-step-edit "he\C-u2lo"
640 :events (make-list 6 'act)
641 :result "hello"
642 :macro-result "he\C-u2lo")
643
644 (kmacro-tests-run-step-edit "f\C-aoo\C-abar"
645 :events (make-list 5 'act-repeat)
646 :result "baroof"
647 :macro-result "f\C-aoo\C-abar"))
648
649(kmacro-tests-deftest kmacro-tests-step-edit-skip ()
650 "Step-editing can skip parts of macro."
651 (kmacro-tests-run-step-edit "ofoofff"
652 :events '(skip skip-keep skip-keep skip-keep
653 skip-rest)
654 :result ""
655 :macro-result "foo"))
656
657(kmacro-tests-deftest kmacro-tests-step-edit-quit ()
658 "Quit while step-editing leaves macro unchanged."
659 (kmacro-tests-run-step-edit "bar"
660 :events '(help insert skip help quit)
661 :sequences '("f" "o" "o" "\C-j")
662 :result "foo"
663 :macro-result "bar"))
664
665(kmacro-tests-deftest kmacro-tests-step-insert ()
666 "Step edit can insert in macro."
667 (kmacro-tests-run-step-edit "fbazbop"
668 :events '(insert act insert-1 act-repeat)
669 :sequences '("o" "o" "\C-a" "\C-j" "\C-e")
670 :result "foobazbop"
671 :macro-result "oo\C-af\C-ebazbop"))
672
673(kmacro-tests-deftest kmacro-tests-step-edit-replace-digit-argument ()
674 "Step-edit replace can replace a numeric argument in a macro.
675This is a regression for item 1 in Bug#24991."
676 (:expected-result :failed)
677 (kmacro-tests-run-step-edit "\C-u3b\C-a\C-cxu"
678 :events '(act replace automatic)
679 :sequences '("8" "x" "\C-j")
680 :result "XXXXXXXX"
681 :macro-result "\C-u8x\C-a\C-cxu"))
682
683(kmacro-tests-deftest kmacro-tests-step-edit-replace ()
684 "Step-edit replace and replace-1 can replace parts of a macro."
685 (kmacro-tests-run-step-edit "a\C-a\C-cxu"
686 :events '(act act replace)
687 :sequences '("b" "c" "\C-j")
688 :result "bca"
689 :macro-result "a\C-abc")
690 (kmacro-tests-run-step-edit "a\C-a\C-cxucd"
691 :events '(act replace-1 automatic)
692 :sequences '("b")
693 :result "abcd"
694 :macro-result "ab\C-cxucd")
695 (kmacro-tests-run-step-edit "by"
696 :events '(act replace)
697 :sequences '("a" "r" "\C-j")
698 :result "bar"
699 :macro-result "bar"))
700
701(kmacro-tests-deftest kmacro-tests-step-edit-append ()
702 "Step edit append inserts after point, and append-end inserts at end."
703 (kmacro-tests-run-step-edit "f-b"
704 :events '(append append-end)
705 :sequences '("o" "o" "\C-j" "a" "r" "\C-j")
706 :result "foo-bar"
707 :macro-result "foo-bar")
708 (kmacro-tests-run-step-edit "x"
709 :events '(append)
710 :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j")
711 :result "Xy"
712 :macro-result "x\C-a\C-cxu\C-ey"))
713
714(kmacro-tests-deftest kmacro-tests-append-end-at-end-appends ()
715 "Append-end when already at end of macro appends to end of macro.
716This is a regression for item 2 in Bug#24991."
717 (:expected-result :failed)
718 (kmacro-tests-run-step-edit "x"
719 :events '(append-end)
720 :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j")
721 :result "Xy"
722 :macro-result "x\C-a\C-cxu\C-ey"))
723
724
725(kmacro-tests-deftest kmacro-tests-step-edit-skip-entire ()
726 "Skipping a whole macro in step-edit leaves macro unchanged.
727This is a regression for item 3 in Bug#24991."
728 (:expected-result :failed)
729 (kmacro-tests-run-step-edit "xyzzy"
730 :events '(skip-rest)
731 :result ""
732 :macro-result "xyzzy"))
733
734(kmacro-tests-deftest kmacro-tests-step-edit-step-through-negative-argument ()
735 "Step edit works on macros using negative universal argument.
736This is a regression for item 4 in Bug#24991."
737 (:expected-result :failed)
738 (kmacro-tests-run-step-edit "boo\C-u-\C-cu"
739 :events '(act-repeat automatic)
740 :result "BOO"
741 :macro-result "boo\C-u-\C-cd"))
742
743(kmacro-tests-deftest kmacro-tests-step-edit-with-quoted-insert ()
744 "Stepping through a macro that uses quoted insert leaves macro unchanged.
745This is a regression for item 5 in Bug#24991."
746 (:expected-result :failed)
747 (let ((read-quoted-char-radix 8))
748 (kmacro-tests-run-step-edit "\C-cxq17051i there"
749 :events '(act automatic)
750 :result "ḩi there"
751 :macro-result "\C-cxq17051i there")
752 (kmacro-tests-run-step-edit "g\C-cxq17051i"
753 :events '(act insert-1 automatic)
754 :sequences '("-")
755 :result "g-ḩi"
756 :macro-result "g-\C-cxq17051i")))
757
758(kmacro-tests-deftest kmacro-tests-step-edit-can-replace-meta-keys ()
759 "Replacing C-w with M-w produces the expected result.
760This is a regression for item 7 in Bug#24991."
761 (:expected-result :failed)
762 (kmacro-tests-run-step-edit "abc\C-b\C-b\C-SPC\C-f\C-w\C-e\C-y"
763 :events '(act-repeat act-repeat
764 act-repeat act-repeat
765 replace automatic)
766 :sequences '("\M-w" "\C-j")
767 :result "abcb"
768 :macro-result "abc\C-b\C-b\C-SPC\C-f\M-w\C-e\C-y")
769 (kmacro-tests-should-insert "abcb" (kmacro-call-macro nil)))
770
771(kmacro-tests-deftest kmacro-tests-step-edit-ignores-qr-map-commands ()
772 "Unimplemented commands from `query-replace-map' are ignored."
773 (kmacro-tests-run-step-edit "yep"
774 :events '(edit-replacement
775 act-and-show act-and-exit
776 delete-and-edit
777 recenter backup
778 scroll-up scroll-down
779 scroll-other-window
780 scroll-other-window-down
781 exit-prefix
782 act act act)
783 :result "yep"
784 :macro-result "yep"))
785
786(kmacro-tests-deftest
787 kmacro-tests-step-edit-edits-macro-with-extended-command ()
788 "Step-editing a macro which uses the minibuffer can change the macro."
789 (let ((mac (vconcat [?\M-x] "eval-expression" '[return]
790 "(insert-char (+ ?a \C-e" [?1] "))" '[return]))
791 (mac-after (vconcat [?\M-x] "eval-expression" '[return]
792 "(insert-char (+ ?a \C-e" [?2] "))" '[return])))
793
794 (kmacro-tests-run-step-edit mac
795 :events '(act act-repeat
796 act act-repeat act
797 replace-1 act-repeat act)
798 :sequences '("2")
799 :result "c"
800 :macro-result mac-after)))
801
802(kmacro-tests-deftest kmacro-tests-step-edit-step-through-isearch ()
803 "Step-editing can edit a macro which uses `isearch-backward' (Bug#22488)."
804 (:expected-result :failed)
805 (let ((mac (vconcat "test Input" '[return]
806 [?\C-r] "inp" '[return] "\C-cxu"))
807 (mac-after (vconcat "test input" '[return]
808 [?\C-r] "inp" '[return] "\C-cd")))
809
810 (kmacro-tests-run-step-edit mac
811 :events '(act-repeat act act
812 act-repeat act
813 replace-1)
814 :sequences '("\C-cd")
815 :result "test input\n"
816 :macro-result mac-after)))
817
818(kmacro-tests-deftest kmacro-tests-step-edit-cleans-up-hook ()
819 "Step-editing properly cleans up `post-command-hook.' (Bug #18708)"
820 (:expected-result :failed)
821 (let (post-command-hook)
822 (setq-local post-command-hook '(t))
823 (kmacro-tests-run-step-edit "x"
824 :events '(act)
825 :result "x"
826 :macro-result "x")
827 (kmacro-tests-simulate-command '(beginning-of-line))))
828
829(cl-defun kmacro-tests-run-step-edit
830 (macro &key events sequences result macro-result)
831 "Set up and run a test of `kmacro-step-edit-macro'.
832
833Run `kmacro-step-edit-macro' with MACRO defined as a keyboard macro
834and `read-event' and `read-key-sequence' set up to return items from
835EVENTS and SEQUENCES respectively. SEQUENCES may be nil, but
836EVENTS should not be. EVENTS should be a list of symbols bound
837in `kmacro-step-edit-map' or `query-replace' map, and this function
838will do the keymap lookup for you. SEQUENCES should contain
839return values for `read-key-sequence'.
840
841Before running the macro, the current buffer will be erased.
842RESULT is the string that should be inserted during the
843step-editing process, and MACRO-RESULT is the expected value of
844`last-kbd-macro' after the editing is complete."
845
846 (let* ((kmacro-tests-events (mapcar #'kmacro-tests-get-kmacro-step-edit-key events))
847 (kmacro-tests-sequences sequences))
848
849 (kmacro-tests-define-macro (string-to-vector macro))
850 (use-local-map kmacro-tests-keymap)
851 (erase-buffer)
852 (kmacro-step-edit-macro)
853 (when result
854 (should (equal result (buffer-string))))
855 (when macro-result
856 (should (equal last-kbd-macro (string-to-vector macro-result))))))
857
858;;; Utilities:
859
860(defun kmacro-tests-simulate-command (command &optional arg)
861 "Call `ert-simulate-command' after setting `current-prefix-arg'.
862Sets `current-prefix-arg' to ARG if it is non-nil, otherwise to
863the second element of COMMAND, before executing COMMAND using
864`ert-simulate-command'."
865 (let ((current-prefix-arg (or arg (cadr command))))
866 (ert-simulate-command command)))
867
868(defun kmacro-tests-define-macro (mac)
869 "Define MAC as a keyboard macro using kmacro commands."
870 (push mac kmacro-tests-macros)
871 (kmacro-tests-simulate-command '(kmacro-start-macro nil))
872 (should defining-kbd-macro)
873 (kmacro-tests-simulate-command '(kmacro-end-macro nil))
874 (should (equal mac last-kbd-macro)))
875
876(defun kmacro-tests-get-kmacro-key (sym)
877 "Look up kmacro command SYM in kmacro's keymap.
878Return the integer key value found."
879 (aref (where-is-internal sym kmacro-keymap t) 0))
880
881(defun kmacro-tests-get-kmacro-step-edit-key (sym)
882 "Return the first key bound to SYM in `kmacro-step-edit-map'."
883 (let ((where (aref (where-is-internal sym kmacro-step-edit-map t) 0)))
884 (if (consp where)
885 (car where)
886 where)))
887
888(provide 'kmacro-tests)
889
890;;; kmacro-tests.el ends here
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index efed8f8bed4..7c5fcb4838f 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -28,7 +28,7 @@
28 28
29(ert-deftest completion-test1 () 29(ert-deftest completion-test1 ()
30 (with-temp-buffer 30 (with-temp-buffer
31 (cl-flet* ((test/completion-table (string pred action) 31 (cl-flet* ((test/completion-table (_string _pred action)
32 (if (eq action 'lambda) 32 (if (eq action 'lambda)
33 nil 33 nil
34 "test: ")) 34 "test: "))
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 525709b92e7..0a59e3b42d1 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -22,7 +22,8 @@
22(require 'ert) 22(require 'ert)
23(require 'dbus) 23(require 'dbus)
24 24
25(setq dbus-debug nil) 25(defvar dbus-debug nil)
26(declare-function dbus-get-unique-name "dbusbind.c" (bus))
26 27
27(defvar dbus--test-enabled-session-bus 28(defvar dbus--test-enabled-session-bus
28 (and (featurep 'dbusbind) 29 (and (featurep 'dbusbind)
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 84749efa45b..7cb737c30e2 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -85,6 +85,20 @@ if (!/[ (:,='\"]/.test(value)) {
85 (should (= (current-column) x)) 85 (should (= (current-column) x))
86 (forward-line)))) 86 (forward-line))))
87 87
88(ert-deftest js-mode-auto-fill ()
89 (with-temp-buffer
90 (js-mode)
91 (setq fill-column 70)
92 (insert "/* ")
93 (dotimes (_ 16)
94 (insert "test "))
95 (do-auto-fill)
96 ;; The bug is that, after auto-fill, the second line starts with
97 ;; "/*", whereas it should start with " * ".
98 (goto-char (point-min))
99 (forward-line)
100 (should (looking-at " \\* test"))))
101
88(provide 'js-tests) 102(provide 'js-tests)
89 103
90;;; js-tests.el ends here 104;;; js-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 2df1bbf50d8..1e6b867d30b 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1156,6 +1156,27 @@ if do:
1156 (python-tests-look-at "that)") 1156 (python-tests-look-at "that)")
1157 (should (= (current-indentation) 6)))) 1157 (should (= (current-indentation) 6))))
1158 1158
1159(ert-deftest python-indent-electric-colon-4 ()
1160 "Test indentation case where there is one more-indented previous open block."
1161 (python-tests-with-temp-buffer
1162 "
1163def f():
1164 if True:
1165 a = 5
1166
1167 if True:
1168 a = 10
1169
1170 b = 3
1171
1172else
1173"
1174 (python-tests-look-at "else")
1175 (goto-char (line-end-position))
1176 (python-tests-self-insert ":")
1177 (python-tests-look-at "else" -1)
1178 (should (= (current-indentation) 4))))
1179
1159(ert-deftest python-indent-region-1 () 1180(ert-deftest python-indent-region-1 ()
1160 "Test indentation case from Bug#18843." 1181 "Test indentation case from Bug#18843."
1161 (let ((contents " 1182 (let ((contents "
@@ -2457,7 +2478,7 @@ if x:
2457 (python-tests-with-temp-buffer 2478 (python-tests-with-temp-buffer
2458 " \"\n" 2479 " \"\n"
2459 (goto-char (point-min)) 2480 (goto-char (point-min))
2460 (font-lock-fontify-buffer))) 2481 (call-interactively 'font-lock-fontify-buffer)))
2461 2482
2462 2483
2463;;; Shell integration 2484;;; Shell integration
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 6194cada1c6..f4849c4b21d 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -30,8 +30,9 @@
30 (insert "(a b") 30 (insert "(a b")
31 (save-excursion (insert " c d)")) 31 (save-excursion (insert " c d)"))
32 ,@body 32 ,@body
33 (cons (buffer-substring (point-min) (point)) 33 (with-no-warnings
34 (buffer-substring (point) (point-max))))) 34 (cons (buffer-substring (point-min) (point))
35 (buffer-substring (point) (point-max))))))
35 36
36 37
37(defmacro simple-test--transpositions (&rest body) 38(defmacro simple-test--transpositions (&rest body)
@@ -266,7 +267,6 @@
266 (with-temp-buffer 267 (with-temp-buffer
267 (setq buffer-undo-list nil) 268 (setq buffer-undo-list nil)
268 (insert "hello") 269 (insert "hello")
269 (car buffer-undo-list)
270 (undo-auto--boundaries 'test)))) 270 (undo-auto--boundaries 'test))))
271 271
272;;; Transposition with negative args (bug#20698, bug#21885) 272;;; Transposition with negative args (bug#20698, bug#21885)
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 6eb32ea7fc4..5372c37a179 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -218,5 +218,20 @@
218 (should (member "body" completions)) 218 (should (member "body" completions))
219 (should-not (member "article" completions))))) 219 (should-not (member "article" completions)))))
220 220
221(ert-deftest css-mdn-symbol-guessing ()
222 (dolist (item '(("@med" "ia" "@media")
223 ("@keyframes " "{" "@keyframes")
224 ("p::after" "" "::after")
225 ("p:before" "" ":before")
226 ("a:v" "isited" ":visited")
227 ("border-" "color: red" "border-color")
228 ("border-color: red" ";" "border-color")
229 ("border-color: red; color: green" ";" "color")))
230 (with-temp-buffer
231 (css-mode)
232 (insert (nth 0 item))
233 (save-excursion (insert (nth 1 item)))
234 (should (equal (nth 2 item) (css--mdn-find-symbol))))))
235
221(provide 'css-mode-tests) 236(provide 'css-mode-tests)
222;;; css-mode-tests.el ends here 237;;; css-mode-tests.el ends here
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
index 0a82b2521fb..f958fbc547a 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -226,7 +226,7 @@ The function must terminate as soon as callback returns nil."
226 226
227 227
228(defun tildify-space-undo-test--test 228(defun tildify-space-undo-test--test
229 (modes nbsp env-open &optional set-space-string) 229 (modes nbsp _env-open &optional set-space-string)
230 (with-temp-buffer 230 (with-temp-buffer
231 (setq-local buffer-file-coding-system 'utf-8) 231 (setq-local buffer-file-coding-system 'utf-8)
232 (dolist (mode modes) 232 (dolist (mode modes)
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
new file mode 100644
index 00000000000..807a411fa5d
--- /dev/null
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -0,0 +1,203 @@
1;; Copyright (C) 2017 Free Software Foundation, Inc
2
3;; Author: Dima Kogan <dima@secretsauce.net>
4;; Maintainer: emacs-devel@gnu.org
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Code:
22
23(require 'diff-mode)
24
25
26(ert-deftest diff-mode-test-ignore-trailing-dashes ()
27 "Check to make sure we successfully ignore trailing -- made by
28'git format-patch'. This is bug #9597"
29
30 ;; I made a test repo, put some files in it, made arbitrary changes
31 ;; and invoked 'git format-patch' to get a patch out of it. The
32 ;; patch and the before and after versions of the files appear here.
33 ;; The test simply tries to apply the patch. The patch contains
34 ;; trailing --, which confused diff-mode previously
35 (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17 00:00:00 2001
36From: Dima Kogan <dima@secretsauce.net>
37Date: Mon, 30 Jan 2017 22:24:13 -0800
38Subject: [PATCH] test commit
39
40---
41 fil | 3 ---
42 fil2 | 4 ----
43 2 files changed, 7 deletions(-)
44
45diff --git a/fil b/fil
46index 10344f1..2a56245 100644
47--- a/fil
48+++ b/fil
49@@ -2,10 +2,8 @@ Afrocentrism
50 Americanisms
51 Americanization
52 Americanizations
53-Americanized
54 Americanizes
55 Americanizing
56-Andrianampoinimerina
57 Anglicanisms
58 Antananarivo
59 Apalachicola
60@@ -15,6 +13,5 @@ Aristophanes
61 Aristotelian
62 Ashurbanipal
63 Australopithecus
64-Austronesian
65 Bangladeshis
66 Barquisimeto
67diff --git a/fil2 b/fil2
68index 8858f0d..86e8ea5 100644
69--- a/fil2
70+++ b/fil2
71@@ -1,20 +1,16 @@
72 whippoorwills
73 whitewashing
74 wholehearted
75-wholeheartedly
76 wholesomeness
77 wildernesses
78 windbreakers
79 wisecracking
80 withstanding
81-woodcarvings
82 woolgathering
83 workstations
84 worthlessness
85 wretchedness
86 wristwatches
87-wrongfulness
88 wrongheadedly
89 wrongheadedness
90-xylophonists
91 youthfulness
92--
932.11.0
94
95")
96 (fil_before "Afrocentrism
97Americanisms
98Americanization
99Americanizations
100Americanized
101Americanizes
102Americanizing
103Andrianampoinimerina
104Anglicanisms
105Antananarivo
106Apalachicola
107Appalachians
108Argentinians
109Aristophanes
110Aristotelian
111Ashurbanipal
112Australopithecus
113Austronesian
114Bangladeshis
115Barquisimeto
116")
117 (fil_after "Afrocentrism
118Americanisms
119Americanization
120Americanizations
121Americanizes
122Americanizing
123Anglicanisms
124Antananarivo
125Apalachicola
126Appalachians
127Argentinians
128Aristophanes
129Aristotelian
130Ashurbanipal
131Australopithecus
132Bangladeshis
133Barquisimeto
134")
135 (fil2_before "whippoorwills
136whitewashing
137wholehearted
138wholeheartedly
139wholesomeness
140wildernesses
141windbreakers
142wisecracking
143withstanding
144woodcarvings
145woolgathering
146workstations
147worthlessness
148wretchedness
149wristwatches
150wrongfulness
151wrongheadedly
152wrongheadedness
153xylophonists
154youthfulness
155")
156 (fil2_after "whippoorwills
157whitewashing
158wholehearted
159wholesomeness
160wildernesses
161windbreakers
162wisecracking
163withstanding
164woolgathering
165workstations
166worthlessness
167wretchedness
168wristwatches
169wrongheadedly
170wrongheadedness
171youthfulness
172")
173 (temp-dir (make-temp-file "diff-mode-test" 'dir)))
174
175 (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
176 (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
177 (unwind-protect
178 (progn
179 (with-current-buffer buf (insert fil_before) (save-buffer))
180 (with-current-buffer buf2 (insert fil2_before) (save-buffer))
181
182 (with-temp-buffer
183 (cd temp-dir)
184 (insert patch)
185 (beginning-of-buffer)
186 (diff-apply-hunk)
187 (diff-apply-hunk)
188 (diff-apply-hunk))
189
190 (should (equal (with-current-buffer buf (buffer-string))
191 fil_after))
192 (should (equal (with-current-buffer buf2 (buffer-string))
193 fil2_after)))
194
195 (ignore-errors
196 (with-current-buffer buf (set-buffer-modified-p nil))
197 (kill-buffer buf)
198 (with-current-buffer buf2 (set-buffer-modified-p nil))
199 (kill-buffer buf2)
200 (delete-directory temp-dir 'recursive))))))
201
202
203(provide 'diff-mode-tests)
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 0f2182a6a75..d0da2094db7 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -134,6 +134,21 @@ Parser is called with and without 'symbol-qnames argument.")
134 (append xml-default-ns 134 (append xml-default-ns
135 '(("F" . "FOOBAR:")))))))))) 135 '(("F" . "FOOBAR:"))))))))))
136 136
137;; Test bug #23440 (proper expansion of default namespace)
138; Test data for default namespace
139(defvar xml-parse-test--default-namespace-qnames
140 (cons "<something xmlns=\"myns:\"><whatever></whatever></something>"
141 '((myns:something
142 ((("http://www.w3.org/2000/xmlns/" . "")
143 . "myns:"))
144 (myns:whatever nil)))))
145
146(ert-deftest xml-parse-test-default-namespace-qnames ()
147 (with-temp-buffer
148 (insert (car xml-parse-test--default-namespace-qnames))
149 (should (equal (cdr xml-parse-test--default-namespace-qnames)
150 (xml-parse-region nil nil nil nil 'symbol-qnames)))))
151
137;; Local Variables: 152;; Local Variables:
138;; no-byte-compile: t 153;; no-byte-compile: t
139;; End: 154;; End:
diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css
index 3a00739bfc4..0845c02c299 100644
--- a/test/manual/indent/css-mode.css
+++ b/test/manual/indent/css-mode.css
@@ -43,3 +43,30 @@ article:hover
43{ 43{
44 color: black; 44 color: black;
45} 45}
46
47/* bug:13425 */
48div:first-child,
49div:last-child,
50div[disabled],
51div::before {
52 font: 15px "Helvetica Neue",
53 Helvetica,
54 Arial,
55 "Nimbus Sans L",
56 sans-serif;
57 font: 15px "Helvetica Neue", Helvetica, Arial,
58 "Nimbus Sans L", sans-serif;
59 transform: matrix(1.0, 2.0,
60 3.0, 4.0,
61 5.0, 6.0);
62 transform: matrix(
63 1.0, 2.0,
64 3.0, 4.0,
65 5.0, 6.0
66 );
67}
68@font-face {
69 src: url("Sans-Regular.eot") format("eot"),
70 url("Sans-Regular.woff") format("woff"),
71 url("Sans-Regular.ttf") format("truetype");
72}
diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss
index e1ec90a5299..f9911ad11b7 100644
--- a/test/manual/indent/scss-mode.scss
+++ b/test/manual/indent/scss-mode.scss
@@ -16,20 +16,20 @@ nav {
16 } 16 }
17} 17}
18nav ul { 18nav ul {
19 margin: 0; 19 margin: 0;
20 padding: 0; 20 padding: 0;
21 list-style: none; 21 list-style: none;
22} 22}
23 23
24nav li { 24nav li {
25 display: inline-block; 25 display: inline-block;
26} 26}
27 27
28nav a var 28nav a var
29{ 29{
30 display: block; 30 display: block;
31 padding: 6px 12px; 31 padding: 6px 12px;
32 text-decoration: none; 32 text-decoration: none;
33} 33}
34 34
35$name: foo; 35$name: foo;
@@ -67,10 +67,28 @@ button {
67 67
68// bug:21230 68// bug:21230
69$list: ( 69$list: (
70 ('a', #000000, #fff) 70 ('a', #000000, #fff)
71 ('b', #000000, #fff) 71 ('b', #000000, #fff)
72 ('c', #000000, #fff) 72 ('c', #000000, #fff)
73 ('d', #000000, #fff) 73 ('d', #000000, #fff)
74 ('e', #000000, #fff) 74 ('e', #000000, #fff)
75 ('f', #000000, #fff) 75 ('f', #000000, #fff)
76); 76);
77
78// bug:13425
79div:first-child,
80div:last-child {
81 @include foo-mixin(
82 $foo: 'foo',
83 $bar: 'bar',
84 );
85
86 font: 15px "Helvetica Neue", Helvetica, Arial,
87 "Nimbus Sans L", sans-serif;
88
89 div:first-child,
90 div:last-child {
91 font: 15px "Helvetica Neue", Helvetica, Arial,
92 "Nimbus Sans L", sans-serif;
93 }
94}
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
new file mode 100644
index 00000000000..1167efd6a66
--- /dev/null
+++ b/test/manual/scroll-tests.el
@@ -0,0 +1,130 @@
1;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; This program 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 of the License, or
10;; (at your option) any later version.
11
12;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; These are mostly automated ert tests, but they don't work in batch
23;; mode which is why they are under test/manual.
24
25;;; Code:
26
27(require 'ert)
28(eval-when-compile (require 'cl-lib))
29
30(defun scroll-tests-up-and-down (margin &optional effective-margin)
31 (unless effective-margin
32 (setq effective-margin margin))
33 (erase-buffer)
34 (insert (mapconcat #'number-to-string
35 (number-sequence 1 200) "\n"))
36 (goto-char 1)
37 (sit-for 0)
38 (let ((scroll-margin margin)
39 (wstart (window-start)))
40 ;; Stopping before `scroll-margin' so we shouldn't have
41 ;; scrolled.
42 (let ((current-prefix-arg (- (window-text-height) 1 effective-margin)))
43 (call-interactively 'next-line))
44 (sit-for 0)
45 (should (= wstart (window-start)))
46 ;; Passing `scroll-margin' should trigger scrolling.
47 (call-interactively 'next-line)
48 (sit-for 0)
49 (should (/= wstart (window-start)))
50 ;; Scroll back to top.
51 (let ((current-prefix-arg (window-start)))
52 (call-interactively 'scroll-down-command))
53 (sit-for 0)
54 (should (= 1 (window-start)))))
55
56(defmacro scroll-tests-with-buffer-window (&rest body)
57 (declare (debug t))
58 `(with-temp-buffer
59 (with-selected-window (display-buffer (current-buffer))
60 ,@body)))
61
62(ert-deftest scroll-tests-scroll-margin-0 ()
63 (skip-unless (not noninteractive))
64 (scroll-tests-with-buffer-window
65 (scroll-tests-up-and-down 0)))
66
67(ert-deftest scroll-tests-scroll-margin-negative ()
68 "A negative `scroll-margin' should be the same as 0."
69 (skip-unless (not noninteractive))
70 (scroll-tests-with-buffer-window
71 (scroll-tests-up-and-down -10 0)))
72
73(ert-deftest scroll-tests-scroll-margin-max ()
74 (skip-unless (not noninteractive))
75 (scroll-tests-with-buffer-window
76 (let ((max-margin (/ (window-text-height) 4)))
77 (scroll-tests-up-and-down max-margin))))
78
79(ert-deftest scroll-tests-scroll-margin-over-max ()
80 "A `scroll-margin' more than max should be the same as max."
81 (skip-unless (not noninteractive))
82 (scroll-tests-with-buffer-window
83 (set-window-text-height nil 7)
84 (let ((max-margin (/ (window-text-height) 4)))
85 (scroll-tests-up-and-down (+ max-margin 1) max-margin)
86 (scroll-tests-up-and-down (+ max-margin 2) max-margin))))
87
88(defun scroll-tests--point-in-middle-of-window-p ()
89 (= (count-lines (window-start) (window-point))
90 (/ (1- (window-text-height)) 2)))
91
92(cl-defun scroll-tests--scroll-margin-whole-window (&key with-line-spacing)
93 "Test `maximum-scroll-margin' at 0.5.
94With a high `scroll-margin', this should keep cursor in the
95middle of the window."
96 (let ((maximum-scroll-margin 0.5)
97 (scroll-margin 100))
98 (scroll-tests-with-buffer-window
99 (setq-local line-spacing with-line-spacing)
100 ;; Choose an odd number, so there is one line in the middle.
101 (set-window-text-height nil 7)
102 ;; `set-window-text-height' doesn't count `line-spacing'.
103 (when with-line-spacing
104 (window-resize nil (* line-spacing 7) nil nil 'pixels))
105 (erase-buffer)
106 (insert (mapconcat #'number-to-string
107 (number-sequence 1 200) "\n"))
108 (goto-char 1)
109 (sit-for 0)
110 (call-interactively 'scroll-up-command)
111 (sit-for 0)
112 (should (scroll-tests--point-in-middle-of-window-p))
113 (call-interactively 'scroll-up-command)
114 (sit-for 0)
115 (should (scroll-tests--point-in-middle-of-window-p))
116 (call-interactively 'scroll-down-command)
117 (sit-for 0)
118 (should (scroll-tests--point-in-middle-of-window-p)))))
119
120(ert-deftest scroll-tests-scroll-margin-whole-window ()
121 (skip-unless (not noninteractive))
122 (scroll-tests--scroll-margin-whole-window))
123
124(ert-deftest scroll-tests-scroll-margin-whole-window-line-spacing ()
125 ;; `line-spacing' has no effect on tty displays.
126 (skip-unless (display-graphic-p))
127 (scroll-tests--scroll-margin-whole-window :with-line-spacing 3))
128
129
130;;; scroll-tests.el ends here
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
new file mode 100644
index 00000000000..6edde0b137b
--- /dev/null
+++ b/test/src/syntax-tests.el
@@ -0,0 +1,85 @@
1;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-
2
3;; Copyright (C) 2017 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 of the License, or
10;; (at your option) 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 <http://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'ert)
23
24(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
25 "Continue a parse that stopped in the middle of a comment marker."
26 (with-temp-buffer
27 (let ((table (make-syntax-table)))
28 (modify-syntax-entry ?/ ". 124")
29 (modify-syntax-entry ?* ". 23b")
30 (set-syntax-table table))
31 (insert "/*C*/\nX")
32 (goto-char (point-min))
33 (let* ((pointC (progn (search-forward "C") (1- (point))))
34 (preC (1- pointC))
35 (pointX (progn (search-forward "X") (1- (point))))
36 (aftC (+ 2 pointC))
37 (ppsC (parse-partial-sexp (point-min) pointC))
38 (pps-preC (parse-partial-sexp (point-min) preC))
39 (pps-aftC (parse-partial-sexp (point-min) aftC))
40 (ppsX (parse-partial-sexp (point-min) pointX)))
41 ;; C should be inside comment.
42 (should (= (nth 0 ppsC) 0))
43 (should (eq (nth 4 ppsC) t))
44 (should (= (nth 8 ppsC) (- pointC 2)))
45 ;; X should not be in comment or list.
46 (should (= (nth 0 ppsX) 0))
47 (should-not (nth 4 ppsX))
48 ;; Try using OLDSTATE.
49 (should (equal (parse-partial-sexp preC pointC nil nil pps-preC)
50 ppsC))
51 (should (equal (parse-partial-sexp pointC aftC nil nil ppsC)
52 pps-aftC))
53 (should (equal (parse-partial-sexp preC aftC nil nil pps-preC)
54 pps-aftC))
55 (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
56 ppsX)))))
57
58(ert-deftest parse-partial-sexp-paren-comments ()
59 "Test syntax parsing with paren comment markers.
60Specifically, where the first character of the comment marker is
61also has open paren syntax (see Bug#24870)."
62 (with-temp-buffer
63 (let ((table (make-syntax-table)))
64 (modify-syntax-entry ?\{ "(}1nb" table)
65 (modify-syntax-entry ?\} "){4nb" table)
66 (modify-syntax-entry ?- ". 123" table)
67 (set-syntax-table table))
68 (insert "{-C-}\nX")
69 (goto-char (point-min))
70 (let* ((pointC (progn (search-forward "C") (1- (point))))
71 (pointX (progn (search-forward "X") (1- (point))))
72 (ppsC (parse-partial-sexp (point-min) pointC))
73 (ppsX (parse-partial-sexp (point-min) pointX)))
74 ;; C should be inside nestable comment, not list.
75 (should (= (nth 0 ppsC) 0))
76 (should (= (nth 4 ppsC) 1))
77 (should (= (nth 8 ppsC) (- pointC 2)))
78 ;; X should not be in comment or list.
79 (should (= (nth 0 ppsX) 0))
80 (should-not (nth 4 ppsX))
81 ;; Try using OLDSTATE.
82 (should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
83 ppsX)))))
84
85;;; syntax-tests.el ends here