summaryrefslogtreecommitdiff
path: root/test/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp')
-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
21 files changed, 1998 insertions, 140 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 @@
(should-not (abbrev-table-p []))
;; Missing :abbrev-table-modiff counter:
(should-not (abbrev-table-p (obarray-make)))
- (let* ((table (obarray-make)))
- (should (abbrev-table-empty-p (make-abbrev-table)))))
+ (should (abbrev-table-empty-p (make-abbrev-table))))
(ert-deftest abbrev-make-abbrev-table-test ()
;; 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 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'autorevert)
(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
auto-revert-stop-on-user-input nil)
(defconst auto-revert--timeout 10
- "Time to wait until a message appears in the *Messages* buffer.")
+ "Time to wait for a message.")
+
+(defvar auto-revert--messages nil
+ "Used to collect messages issued during a section of a test.")
(defun auto-revert--wait-for-revert (buffer)
- "Wait until the *Messages* buffer reports reversion of BUFFER."
+ "Wait until a message reports reversion of BUFFER.
+This expects `auto-revert--messages' to be bound by
+`ert-with-message-capture' before calling."
(with-timeout (auto-revert--timeout nil)
- (with-current-buffer "*Messages*"
- (while
- (null (string-match
- (format-message "Reverting buffer `%s'." (buffer-name buffer))
- (buffer-string)))
- (if (with-current-buffer buffer auto-revert-use-notify)
- (read-event nil nil 0.1)
- (sleep-for 0.1))))))
+ (while
+ (null (string-match
+ (format-message "Reverting buffer `%s'." (buffer-name buffer))
+ auto-revert--messages))
+ (if (with-current-buffer buffer auto-revert-use-notify)
+ (read-event nil nil 0.1)
+ (sleep-for 0.1)))))
(ert-deftest auto-revert-test00-auto-revert-mode ()
"Check autorevert for a file."
@@ -51,41 +56,38 @@
buf)
(unwind-protect
(progn
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (write-region "any text" nil tmpfile nil 'no-message)
+ (write-region "any text" nil tmpfile nil 'no-message)
(setq buf (find-file-noselect tmpfile))
- (with-current-buffer buf
- (should (string-equal (buffer-string) "any text"))
- ;; `buffer-stale--default-function' checks for
- ;; `verify-visited-file-modtime'. We must ensure that it
- ;; returns nil.
- (sleep-for 1)
- (auto-revert-mode 1)
- (should auto-revert-mode)
+ (with-current-buffer buf
+ (ert-with-message-capture auto-revert--messages
+ (should (string-equal (buffer-string) "any text"))
+ ;; `buffer-stale--default-function' checks for
+ ;; `verify-visited-file-modtime'. We must ensure that it
+ ;; returns nil.
+ (sleep-for 1)
+ (auto-revert-mode 1)
+ (should auto-revert-mode)
- ;; Modify file. We wait for a second, in order to have
- ;; another timestamp.
- (sleep-for 1)
- (write-region "another text" nil tmpfile nil 'no-message)
+ ;; Modify file. We wait for a second, in order to have
+ ;; another timestamp.
+ (sleep-for 1)
+ (write-region "another text" nil tmpfile nil 'no-message)
- ;; Check, that the buffer has been reverted.
- (auto-revert--wait-for-revert buf)
+ ;; Check, that the buffer has been reverted.
+ (auto-revert--wait-for-revert buf))
(should (string-match "another text" (buffer-string)))
;; When the buffer is modified, it shall not be reverted.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (set-buffer-modified-p t)
- (sleep-for 1)
- (write-region "any text" nil tmpfile nil 'no-message)
+ (ert-with-message-capture auto-revert--messages
+ (set-buffer-modified-p t)
+ (sleep-for 1)
+ (write-region "any text" nil tmpfile nil 'no-message)
- ;; Check, that the buffer hasn't been reverted.
- (auto-revert--wait-for-revert buf)
+ ;; Check, that the buffer hasn't been reverted.
+ (auto-revert--wait-for-revert buf))
(should-not (string-match "any text" (buffer-string)))))
;; Exit.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))
@@ -106,13 +108,11 @@
(make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
buf1 buf2)
(unwind-protect
- (progn
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (write-region "any text" nil tmpfile1 nil 'no-message)
- (setq buf1 (find-file-noselect tmpfile1))
- (write-region "any text" nil tmpfile2 nil 'no-message)
- (setq buf2 (find-file-noselect tmpfile2))
+ (ert-with-message-capture auto-revert--messages
+ (write-region "any text" nil tmpfile1 nil 'no-message)
+ (setq buf1 (find-file-noselect tmpfile1))
+ (write-region "any text" nil tmpfile2 nil 'no-message)
+ (setq buf2 (find-file-noselect tmpfile2))
(dolist (buf (list buf1 buf2))
(with-current-buffer buf
@@ -148,7 +148,6 @@
(should (string-match "another text" (buffer-string))))))
;; Exit.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors
(dolist (buf (list buf1 buf2))
(with-current-buffer buf (set-buffer-modified-p nil))
@@ -165,8 +164,6 @@
buf)
(unwind-protect
(progn
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
(write-region "any text" nil tmpfile nil 'no-message)
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
@@ -184,42 +181,38 @@
'before-revert-hook
(lambda () (delete-file buffer-file-name))
nil t)
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 1)
- (write-region "another text" nil tmpfile nil 'no-message)
- ;; Check, that the buffer hasn't been reverted. File
- ;; notification should be disabled, falling back to
- ;; polling.
- (auto-revert--wait-for-revert buf)
+ (ert-with-message-capture auto-revert--messages
+ (sleep-for 1)
+ (write-region "another text" nil tmpfile nil 'no-message)
+ (auto-revert--wait-for-revert buf))
+ ;; Check, that the buffer hasn't been reverted. File
+ ;; notification should be disabled, falling back to
+ ;; polling.
(should (string-match "any text" (buffer-string)))
- (should-not auto-revert-use-notify)
+ ;; With w32notify, the 'stopped' events are not sent.
+ (or (eq file-notify--library 'w32notify)
+ (should-not auto-revert-use-notify))
;; Once the file has been recreated, the buffer shall be
;; reverted.
(kill-local-variable 'before-revert-hook)
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 1)
- (write-region "another text" nil tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (auto-revert--wait-for-revert buf)
+ (ert-with-message-capture auto-revert--messages
+ (sleep-for 1)
+ (write-region "another text" nil tmpfile nil 'no-message)
+ (auto-revert--wait-for-revert buf))
+ ;; Check, that the buffer has been reverted.
(should (string-match "another text" (buffer-string)))
;; An empty file shall still be reverted.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 1)
- (write-region "" nil tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (auto-revert--wait-for-revert buf)
+ (ert-with-message-capture auto-revert--messages
+ (sleep-for 1)
+ (write-region "" nil tmpfile nil 'no-message)
+ (auto-revert--wait-for-revert buf))
+ ;; Check, that the buffer has been reverted.
(should (string-equal "" (buffer-string)))))
;; Exit.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(kill-buffer buf))
@@ -232,9 +225,7 @@
(let ((tmpfile (make-temp-file "auto-revert-test"))
buf)
(unwind-protect
- (progn
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
+ (ert-with-message-capture auto-revert--messages
(write-region "any text" nil tmpfile nil 'no-message)
(setq buf (find-file-noselect tmpfile))
(with-current-buffer buf
@@ -259,7 +250,6 @@
(string-match "modified text\nanother text" (buffer-string)))))
;; Exit.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
@@ -283,33 +273,29 @@
(should
(string-match name (substring-no-properties (buffer-string))))
- ;; Delete file. We wait for a second, in order to have
- ;; another timestamp.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 1)
- (delete-file tmpfile)
-
- ;; Check, that the buffer has been reverted.
- (auto-revert--wait-for-revert buf)
+ (ert-with-message-capture auto-revert--messages
+ ;; Delete file. We wait for a second, in order to have
+ ;; another timestamp.
+ (sleep-for 1)
+ (delete-file tmpfile)
+ (auto-revert--wait-for-revert buf))
+ ;; Check, that the buffer has been reverted.
(should-not
(string-match name (substring-no-properties (buffer-string))))
- ;; Make dired buffer modified. Check, that the buffer has
- ;; been still reverted.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (set-buffer-modified-p t)
- (sleep-for 1)
- (write-region "any text" nil tmpfile nil 'no-message)
+ (ert-with-message-capture auto-revert--messages
+ ;; Make dired buffer modified. Check, that the buffer has
+ ;; been still reverted.
+ (set-buffer-modified-p t)
+ (sleep-for 1)
+ (write-region "any text" nil tmpfile nil 'no-message)
- ;; Check, that the buffer has been reverted.
- (auto-revert--wait-for-revert buf)
+ (auto-revert--wait-for-revert buf))
+ ;; Check, that the buffer has been reverted.
(should
(string-match name (substring-no-properties (buffer-string))))))
;; Exit.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors
(with-current-buffer buf (set-buffer-modified-p nil))
(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."
(should (= 0 (cl-count -5 list)))
(should (= 0 (cl-count 2 list :start 2 :end 4)))
(should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo)))))
- (should (= 4 (cl-count 'foo list :test (lambda (a b) (cl-evenp b)))))
- (should (equal (cl-count 'foo list :test (lambda (a b) (cl-oddp b)))
- (cl-count 'foo list :test-not (lambda (a b) (cl-evenp b)))))))
+ (should (= 4 (cl-count 'foo list :test (lambda (_a b) (cl-evenp b)))))
+ (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b)))
+ (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp b)))))))
;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
(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 @@
(.test-two (cdr (assq 'test-two symbol))))
(list .test-one .test-two
.test-two .test-two)))
- (cl-letf (((symbol-function #'make-symbol) (lambda (x) 'symbol)))
+ (cl-letf (((symbol-function #'make-symbol) (lambda (_x) 'symbol)))
(macroexpand
'(let-alist data (list .test-one .test-two
.test-two .test-two))))))
@@ -51,8 +51,7 @@
(ert-deftest let-alist-cons ()
(should
(equal
- (let ((.external "ext")
- (.external.too "et"))
+ (let ((.external "ext"))
(let-alist '((test-two . 0)
(test-three . 1)
(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 @@
+;;;; testcases.el -- Test cases for testcover-tests.el
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; * This file should not be loaded directly. It is meant to be read
+;; by `testcover-tests-build-test-cases'.
+;;
+;; * Test cases begin with ;; ==== name ====. The symbol name between
+;; the ===='s is used to create the name of the test.
+;;
+;; * Following the beginning comment place the test docstring and
+;; any tags or keywords for ERT. These will be spliced into the
+;; ert-deftest for the test.
+;;
+;; * To separate the above from the test case code, use another
+;; comment: ;; ====
+;;
+;; * These special comments should start at the beginning of a line.
+;;
+;; * `testcover-tests-skeleton' will prompt you for a test name and
+;; insert the special comments.
+;;
+;; * The test case code should be annotated with %%% at the end of
+;; each form where a tan splotch is expected, and !!! at the end
+;; of each form where a red mark is expected.
+;;
+;; * If Testcover is working correctly on your code sample, using
+;; `testcover-tests-markup-region' and
+;; `testcover-tests-unmarkup-region' can make creating test cases
+;; easier.
+
+;;; Code:
+;;; Test Cases:
+
+;; ==== constants-bug-25316 ====
+"Testcover doesn't splotch constants."
+:expected-result :failed
+;; ====
+(defconst testcover-testcase-const "apples")
+(defun testcover-testcase-zero () 0)
+(defun testcover-testcase-list-consts ()
+ (list
+ emacs-version 10
+ "hello"
+ `(a b c ,testcover-testcase-const)
+ '(1 2 3)
+ testcover-testcase-const
+ (testcover-testcase-zero)
+ nil))
+
+(defun testcover-testcase-add-to-const-list (arg)
+ (cons arg%%% (testcover-testcase-list-consts))%%%)
+
+(should (equal (testcover-testcase-add-to-const-list 'a)
+ `(a ,emacs-version 10 "hello" (a b c "apples") (1 2 3)
+ "apples" 0 nil)))
+
+;; ==== customize-defcustom-bug-25326 ====
+"Testcover doesn't prevent testing of defcustom values."
+:expected-result :failed
+;; ====
+(defgroup testcover-testcase nil
+ "Test case for testcover"
+ :group 'lisp
+ :prefix "testcover-testcase-"
+ :version "26.0")
+(defcustom testcover-testcase-flag t
+ "Test value used by testcover-tests.el"
+ :type 'boolean
+ :group 'testcover-testcase)
+(defun testcover-testcase-get-flag ()
+ testcover-testcase-flag)
+
+(testcover-testcase-get-flag)
+(setq testcover-testcase-flag (not testcover-testcase-flag))
+(testcover-testcase-get-flag)
+
+;; ==== no-returns ====
+"Testcover doesn't splotch functions which don't return."
+;; ====
+(defun testcover-testcase-play-ball (retval)
+ (catch 'ball
+ (throw 'ball retval%%%))%%%) ; catch gets marked but not throw
+
+(defun testcover-testcase-not-my-favorite-error-message ()
+ (signal 'wrong-type-argument (list 'consp nil)))
+
+(should (testcover-testcase-play-ball t))
+(condition-case nil
+ (testcover-testcase-not-my-favorite-error-message)
+ (error nil))
+
+;; ==== noreturn-symbol ====
+"Wrapping a form with noreturn prevents splotching."
+;; ====
+(defun testcover-testcase-cancel (spacecraft)
+ (error "no destination for %s" spacecraft))
+(defun testcover-testcase-launch (spacecraft planet)
+ (if (null planet)
+ (noreturn (testcover-testcase-cancel spacecraft%%%))
+ (list spacecraft%%% planet%%%)%%%)%%%)
+(defun testcover-testcase-launch-2 (spacecraft planet)
+ (if (null planet%%%)%%%
+ (testcover-testcase-cancel spacecraft%%%)!!!
+ (list spacecraft!!! planet!!!)!!!)!!!)
+(should (equal (testcover-testcase-launch "Curiosity" "Mars") '("Curiosity" "Mars")))
+(condition-case err
+ (testcover-testcase-launch "Voyager" nil)
+ (error err))
+(condition-case err
+ (testcover-testcase-launch-2 "Voyager II" nil)
+ (error err))
+
+(should-error (testcover-testcase-launch "Voyager" nil))
+(should-error (testcover-testcase-launch-2 "Voyager II" nil))
+
+;; ==== 1-value-symbol-bug-25316 ====
+"Wrapping a form with 1value prevents splotching."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-always-zero (num)
+ (- num%%% num%%%)%%%)
+(defun testcover-testcase-still-always-zero (num)
+ (1value (- num%%% num%%% (- num%%% num%%%)%%%)))
+(defun testcover-testcase-never-called (num)
+ (1value (/ num!!! num!!!)!!!)!!!)
+(should (eql 0 (testcover-testcase-always-zero 3)))
+(should (eql 0 (testcover-testcase-still-always-zero 5)))
+
+;; ==== dotimes-dolist ====
+"Dolist and dotimes with a 1valued return value are 1valued."
+;; ====
+(defun testcover-testcase-do-over (things)
+ (dolist (thing things%%%)
+ (list thing))
+ (dolist (thing things%%% 42)
+ (list thing))
+ (dolist (thing things%%% things%%%)
+ (list thing))%%%)
+(defun testcover-testcase-do-more (count)
+ (dotimes (num count%%%)
+ (+ num num))
+ (dotimes (num count%%% count%%%)
+ (+ num num))%%%
+ (dotimes (num count%%% 0)
+ (+ num num)))
+(should (equal '(a b c) (testcover-testcase-do-over '(a b c))))
+(should (eql 0 (testcover-testcase-do-more 2)))
+
+;; ==== let-last-form ====
+"A let form is 1valued if its last form is 1valued."
+;; ====
+(defun testcover-testcase-double (num)
+ (let ((double (* num%%% 2)%%%))
+ double%%%)%%%)
+(defun testcover-testcase-nullbody-let (num)
+ (let* ((square (* num%%% num%%%)%%%)
+ (double (* 2 num%%%)%%%))))
+(defun testcover-testcase-answer ()
+ (let ((num 100))
+ 42))
+(should-not (testcover-testcase-nullbody-let 3))
+(should (eql (testcover-testcase-answer) 42))
+(should (eql (testcover-testcase-double 10) 20))
+
+;; ==== if-with-1value-clauses ====
+"An if is 1valued if both then and else are 1valued."
+;; ====
+(defun testcover-testcase-describe (val)
+ (if (zerop val%%%)%%%
+ "a number"
+ "a different number"))
+(defun testcover-testcase-describe-2 (val)
+ (if (zerop val)
+ "zero"
+ "not zero"))
+(defun testcover-testcase-describe-3 (val)
+ (if (zerop val%%%)%%%
+ "zero"
+ (format "%d" val%%%)%%%)%%%)
+(should (equal (testcover-testcase-describe 0) "a number"))
+(should (equal (testcover-testcase-describe-2 0) "zero"))
+(should (equal (testcover-testcase-describe-2 1) "not zero"))
+(should (equal (testcover-testcase-describe-3 1) "1"))
+
+;; ==== cond-with-1value-clauses ====
+"A cond form is marked 1valued if all clauses are 1valued."
+;; ====
+(defun testcover-testcase-cond (num)
+ (cond
+ ((eql num%%% 0)%%% 'a)
+ ((eql num%%% 1)%%% 'b)
+ ((eql num!!! 2)!!! 'c)))
+(defun testcover-testcase-cond-2 (num)
+ (cond
+ ((eql num%%% 0)%%% (cons 'a 0)!!!)
+ ((eql num%%% 1)%%% 'b))%%%)
+(should (eql (testcover-testcase-cond 1) 'b))
+(should (eql (testcover-testcase-cond-2 1) 'b))
+
+;; ==== condition-case-with-1value-components ====
+"A condition-case is marked 1valued if its body and handlers are."
+;; ====
+(defun testcover-testcase-cc (arg)
+ (condition-case nil
+ (if (null arg%%%)%%%
+ (error "foo")
+ "0")!!!
+ (error nil)))
+(should-not (testcover-testcase-cc nil))
+
+;; ==== quotes-within-backquotes-bug-25316 ====
+"Forms to instrument are found within quotes within backquotes."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-make-list ()
+ (list 'defun 'defvar))
+(defmacro testcover-testcase-bq-macro (arg)
+ (declare (debug t))
+ `(memq ,arg%%% '(defconst ,@(testcover-testcase-make-list)))%%%)
+(defun testcover-testcase-use-bq-macro (arg)
+ (testcover-testcase-bq-macro arg%%%)%%%)
+(should (equal '(defun defvar) (testcover-testcase-use-bq-macro 'defun)))
+
+;; ==== progn-functions ====
+"Some forms are 1value if their last argument is 1value."
+;; ====
+(defun testcover-testcase-one (arg)
+ (progn
+ (setq arg (1- arg%%%)%%%)%%%)%%%
+ (progn
+ (setq arg (1+ arg%%%)%%%)%%%
+ 1))
+
+(should (eql 1 (testcover-testcase-one 0)))
+;; ==== prog1-functions ====
+"Some forms are 1value if their first argument is 1value."
+;; ====
+(defun testcover-testcase-unwinder (arg)
+ (unwind-protect
+ (if ( > arg%%% 0)%%%
+ 1
+ 0)
+ (format "unwinding %s!" arg%%%)%%%))
+(defun testcover-testcase-divider (arg)
+ (unwind-protect
+ (/ 100 arg%%%)%%%
+ (format "unwinding! %s" arg%%%)%%%)%%%)
+
+(should (eq 0 (testcover-testcase-unwinder 0)))
+(should (eq 1 (testcover-testcase-divider 100)))
+
+;; ==== compose-functions ====
+"Some functions are 1value if all their arguments are 1value."
+;; ====
+(defconst testcover-testcase-count 3)
+(defun testcover-testcase-number ()
+ (+ 1 testcover-testcase-count))
+(defun testcover-testcase-more ()
+ (+ 1 (testcover-testcase-number) testcover-testcase-count))
+
+(should (equal (testcover-testcase-more) 8))
+
+;; ==== apply-quoted-symbol ====
+"Apply with a quoted function symbol treated as 1value if function is."
+;; ====
+(defun testcover-testcase-numlist (flag)
+ (if flag%%%
+ '(1 2 3)
+ '(4 5 6)))
+(defun testcover-testcase-sum (flag)
+ (apply '+ (testcover-testcase-numlist flag%%%)))
+(defun testcover-testcase-label ()
+ (apply 'message "edebug uses: %s %s" (list 1 2)!!!)!!!)
+
+(should (equal 6 (testcover-testcase-sum t)))
+
+;; ==== backquote-1value-bug-24509 ====
+"Commas within backquotes are recognized as non-1value."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-lambda (&rest body)
+ `(lambda () ,@body))
+
+(defun testcover-testcase-example ()
+ (let ((lambda-1 (testcover-testcase-lambda (format "lambda-%d" 1))%%%)
+ (lambda-2 (testcover-testcase-lambda (format "lambda-%d" 2))%%%))
+ (concat (funcall lambda-1%%%)%%% " "
+ (funcall lambda-2%%%)%%%)%%%)%%%)
+
+(defmacro testcover-testcase-message-symbol (name)
+ `(message "%s" ',name))
+
+(defun testcover-testcase-example-2 ()
+ (concat
+ (testcover-testcase-message-symbol foo)%%%
+ (testcover-testcase-message-symbol bar)%%%)%%%)
+
+(should (equal "lambda-1 lambda-2" (testcover-testcase-example)))
+(should (equal "foobar" (testcover-testcase-example-2)))
+
+;; ==== pcase-bug-24688 ====
+"Testcover copes with condition-case within backquoted list."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-pcase (form)
+ (pcase form%%%
+ (`(condition-case ,var ,protected-form . ,handlers)
+ (list var%%% protected-form%%% handlers%%%)%%%)
+ (_ nil))%%%)
+
+(should (equal (testcover-testcase-pcase '(condition-case a
+ (/ 5 a)
+ (error 0)))
+ '(a (/ 5 a) ((error 0)))))
+
+;; ==== defun-in-backquote-bug-11307-and-24743 ====
+"Testcover handles defun forms within backquoted list."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-defun (name &rest body)
+ (declare (debug (symbolp def-body)))
+ `(defun ,name () ,@body))
+
+(testcover-testcase-defun foo (+ 1 2))
+(testcover-testcase-defun bar (+ 3 4))
+(should (eql (foo) 3))
+(should (eql (bar) 7))
+
+;; ==== closure-1value-bug ====
+"Testcover does not mark closures as 1value."
+:expected-result :failed
+;; ====
+;; -*- lexical-binding:t -*-
+(setq testcover-testcase-foo nil)
+(setq testcover-testcase-bar 0)
+
+(defun testcover-testcase-baz (arg)
+ (setq testcover-testcase-foo
+ (lambda () (+ arg testcover-testcase-bar%%%))))
+
+(testcover-testcase-baz 2)
+(should (equal 2 (funcall testcover-testcase-foo)))
+(testcover-testcase-baz 3)
+(should (equal 3 (funcall testcover-testcase-foo)))
+
+;; ==== by-value-vs-by-reference-bug-25351 ====
+"An object created by a 1value expression may be modified by other code."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-ab ()
+ (list 'a 'b))
+(defun testcover-testcase-change-it (arg)
+ (setf (cadr arg%%%)%%% 'c)%%%
+ arg%%%)
+
+(should (equal (testcover-testcase-change-it (testcover-testcase-ab)) '(a c)))
+(should (equal (testcover-testcase-ab) '(a b)))
+
+;; ==== 1value-error-test ====
+"Forms wrapped by `1value' should always return the same value."
+;; ====
+(defun testcover-testcase-thing (arg)
+ (1value (list 1 arg 3)))
+
+(should (equal '(1 2 3) (testcover-testcase-thing 2)))
+(should-error (testcover-testcase-thing 3))
+
+;; ==== dotted-backquote ====
+"Testcover correctly instruments dotted backquoted lists."
+;; ====
+(defun testcover-testcase-dotted-bq (flag extras)
+ (let* ((bq
+ `(a b c . ,(and flag extras%%%))))
+ bq))
+
+(should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e))))
+(should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e))))
+
+;; ==== backquoted-vector-bug-25316 ====
+"Testcover reinstruments within backquoted vectors."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-vec (a b c)
+ `[,a%%% ,(list b%%% c%%%)%%%]%%%)
+
+(defun testcover-testcase-vec-in-list (d e f)
+ `([[,d%%% ,e%%%] ,f%%%])%%%)
+
+(defun testcover-testcase-vec-arg (num)
+ (list `[,num%%%]%%%)%%%)
+
+(should (equal [1 (2 3)] (testcover-testcase-vec 1 2 3)))
+(should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6)))
+(should (equal '([100]) (testcover-testcase-vec-arg 100)))
+
+;; ==== vector-in-macro-spec-bug-25316 ====
+"Testcover reinstruments within vectors."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-nth-case (arg vec)
+ (declare (indent 1)
+ (debug (form (vector &rest form))))
+ `(eval (aref ,vec%%% ,arg%%%))%%%)
+
+(defun testcover-testcase-use-nth-case (choice val)
+ (testcover-testcase-nth-case choice
+ [(+ 1 val!!!)!!!
+ (- 1 val%%%)%%%
+ (* 7 val)
+ (/ 4 val!!!)!!!]))
+
+(should (eql 42 (testcover-testcase-use-nth-case 2 6)))
+(should (eql 49 (testcover-testcase-use-nth-case 2 7)))
+(should (eql 0 (testcover-testcase-use-nth-case 1 1 )))
+
+;; ==== mapcar-is-not-compose ====
+"Mapcar with 1value arguments is not 1value."
+:expected-result :failed
+;; ====
+(defvar testcover-testcase-num 0)
+(defun testcover-testcase-add-num (n)
+ (+ testcover-testcase-num n))
+(defun testcover-testcase-mapcar-sides ()
+ (mapcar 'testcover-testcase-add-num '(1 2 3)))
+
+(setq testcover-testcase-num 1)
+(should (equal (testcover-testcase-mapcar-sides) '(2 3 4)))
+(setq testcover-testcase-num 2)
+(should (equal (testcover-testcase-mapcar-sides) '(3 4 5)))
+
+;; ==== function-with-edebug-spec-bug-25316 ====
+"Functions can have edebug specs too.
+See c-make-font-lock-search-function for an example in the Emacs
+sources. The other issue is that it's ok to use quote in an
+edebug spec, so testcover needs to cope with that."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-make-function (forms)
+ `(lambda (flag) (if flag 0 ,@forms%%%))%%%)
+
+(def-edebug-spec testcover-testcase-make-function
+ (("quote" (&rest def-form))))
+
+(defun testcover-testcase-thing ()
+ (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%)
+
+(defun testcover-testcase-use-thing ()
+ (funcall (testcover-testcase-thing)%%% nil)%%%)
+
+(should (equal (testcover-testcase-use-thing) 15))
+
+;; ==== backquoted-dotted-alist ====
+"Testcover can instrument a dotted alist constructed with backquote."
+;; ====
+(defun testcover-testcase-make-alist (expr entries)
+ `((0 . ,expr%%%) . ,entries%%%)%%%)
+
+(should (equal (testcover-testcase-make-alist "foo" '((1 . "bar") (2 . "baz")))
+ '((0 . "foo") (1 . "bar") (2 . "baz"))))
+
+;; ==== coverage-of-the-unknown-symbol-bug-25471 ====
+"Testcover correctly records coverage of code which uses `unknown'"
+:expected-result :failed
+;; ====
+(defun testcover-testcase-how-do-i-know-you (name)
+ (let ((val 'unknown))
+ (when (equal name%%% "Bob")%%%
+ (setq val 'known)!!!)
+ val%%%)%%%)
+
+(should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown))
+
+;; 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 @@
+;;; testcover-tests.el --- Testcover test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; Testcover test suite.
+;; * All the test cases are in testcover-resources/testcover-cases.el.
+;; See that file for an explanation of the test case format.
+;; * `testcover-tests-define-tests', which is run when this file is
+;; loaded, reads testcover-resources/testcover-cases.el and defines
+;; ERT tests for each test case.
+
+;;; Code:
+
+(require 'ert)
+(require 'testcover)
+(require 'skeleton)
+
+;; Use `eval-and-compile' around all these definitions because they're
+;; used by the macro `testcover-tests-define-tests'.
+
+(eval-and-compile
+ (defvar testcover-tests-file-dir
+ (expand-file-name
+ "testcover-resources/"
+ (file-name-directory (or (bound-and-true-p byte-compile-current-file)
+ load-file-name
+ buffer-file-name)))
+ "Directory of the \"testcover-tests.el\" file."))
+
+(eval-and-compile
+ (defvar testcover-tests-test-cases
+ (expand-file-name "testcases.el" testcover-tests-file-dir)
+ "File containing marked up code to instrument and check."))
+
+;; Convert Testcover's overlays to plain text.
+
+(eval-and-compile
+ (defun testcover-tests-markup-region (beg end &rest optargs)
+ "Mark up test code within region between BEG and END.
+Convert Testcover's tan and red splotches to %%% and !!! for
+testcases.el. This can be used to create test cases if Testcover
+is working correctly on a code sample. OPTARGS are optional
+arguments for `testcover-start'."
+ (interactive "r")
+ (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
+ (code (buffer-substring beg end))
+ (marked-up-code))
+ (unwind-protect
+ (progn
+ (with-temp-file tempfile
+ (insert code))
+ (save-current-buffer
+ (let ((buf (find-file-noselect tempfile)))
+ (set-buffer buf)
+ (apply 'testcover-start (cons tempfile optargs))
+ (testcover-mark-all buf)
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (let ((ov-face (overlay-get overlay 'face)))
+ (goto-char (overlay-end overlay))
+ (cond
+ ((eq ov-face 'testcover-nohits) (insert "!!!"))
+ ((eq ov-face 'testcover-1value) (insert "%%%"))
+ (t nil))))
+ (setq marked-up-code (buffer-string)))
+ (set-buffer-modified-p nil)))
+ (ignore-errors (kill-buffer (find-file-noselect tempfile)))
+ (ignore-errors (delete-file tempfile)))
+
+ ;; Now replace the original code with the marked up code.
+ (delete-region beg end)
+ (insert marked-up-code))))
+
+(eval-and-compile
+ (defun testcover-tests-unmarkup-region (beg end)
+ "Remove the markup used in testcases.el between BEG and END."
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "!!!\\|%%%" nil t)
+ (replace-match ""))))))
+
+(define-skeleton testcover-tests-skeleton
+ "Write a testcase for testcover-tests.el."
+ "Enter name of test: "
+ ";; ==== " str " ====\n"
+ "\"docstring\"\n"
+ ";; Directives for ERT should go here, if any.\n"
+ ";; ====\n"
+ ";; Replace this line with annotated test code.\n")
+
+;; Check a test case.
+
+(eval-and-compile
+ (defun testcover-tests-run-test-case (marked-up-code)
+ "Test the operation of Testcover on the string MARKED-UP-CODE."
+ (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")))
+ (unwind-protect
+ (progn
+ (with-temp-file tempfile
+ (insert marked-up-code))
+ ;; Remove the marks and mark the code up again. The original
+ ;; and recreated versions should match.
+ (save-current-buffer
+ (set-buffer (find-file-noselect tempfile))
+ ;; Fail the test if the debugger tries to become active,
+ ;; which will happen if Testcover's reinstrumentation
+ ;; leaves an edebug-enter in the code. This will also
+ ;; prevent debugging these tests using Edebug.
+ (cl-letf (((symbol-function #'edebug-enter)
+ (lambda (&rest _args)
+ (ert-fail
+ (concat "Debugger invoked during test run "
+ "(possible edebug-enter not replaced)")))))
+ (dolist (byte-compile '(t nil))
+ (testcover-tests-unmarkup-region (point-min) (point-max))
+ (unwind-protect
+ (testcover-tests-markup-region (point-min) (point-max) byte-compile)
+ (set-buffer-modified-p nil))
+ (should (string= marked-up-code
+ (buffer-string)))))))
+ (ignore-errors (kill-buffer (find-file-noselect tempfile)))
+ (ignore-errors (delete-file tempfile))))))
+
+;; Convert test case file to ert-defmethod.
+
+(eval-and-compile
+ (defun testcover-tests-build-test-cases ()
+ "Parse the test case file and return a list of ERT test definitions.
+Construct and return a list of `ert-deftest' forms. See testcases.el
+for documentation of the test definition format."
+ (let (results)
+ (with-temp-buffer
+ (insert-file-contents testcover-tests-test-cases)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^;; ==== \\([^ ]+?\\) ====\n"
+ "\\(\\(?:.*\n\\)*?\\)"
+ ";; ====\n"
+ "\\(\\(?:.*\n\\)*?\\)"
+ "\\(\\'\\|;; ====\\)")
+ nil t)
+ (let ((name (match-string 1))
+ (splice (car (read-from-string
+ (format "(%s)" (match-string 2)))))
+ (code (match-string 3)))
+ (push
+ `(ert-deftest ,(intern (concat "testcover-tests-" name)) ()
+ ,@splice
+ (testcover-tests-run-test-case ,code))
+ results))
+ (beginning-of-line)))
+ results)))
+
+;; Define all the tests.
+
+(defmacro testcover-tests-define-tests ()
+ "Construct and define ERT test methods using the test case file."
+ (let* ((test-cases (testcover-tests-build-test-cases)))
+ `(progn ,@test-cases)))
+
+(testcover-tests-define-tests)
+
+(provide 'testcover-tests)
+
+;;; 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 @@
(require 'ert)
(require 'faces)
+(defgroup faces--test nil ""
+ :group 'faces--test)
+
(defface faces--test1
'((t :background "black" :foreground "black"))
- "")
+ ""
+ :group 'faces--test)
(defface faces--test2
'((t :box 1))
- "")
+ ""
+ :group 'faces--test)
(ert-deftest faces--test-color-at-point ()
(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
str
(make-string ffap-max-region-length #xa)
(format "%s ENDS HERE" file)))
- (mark-whole-buffer)
+ (call-interactively 'mark-whole-buffer)
(should (equal "" (ffap-string-at-point)))
(should (equal '(1 1) ffap-string-at-point-region)))))
(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 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'filenotify)
(require 'tramp)
@@ -703,21 +704,19 @@ delivered."
(should auto-revert-notify-watch-descriptor)
;; Modify file. We wait for a second, in order to have
- ;; another timestamp.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 1)
- (write-region
- "another text" nil file-notify--test-tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (with-current-buffer (get-buffer-create "*Messages*")
- (file-notify--wait-for-events
- timeout
- (string-match
+ ;; another timestamp.
+ (ert-with-message-capture captured-messages
+ (sleep-for 1)
+ (write-region
+ "another text" nil file-notify--test-tmpfile nil 'no-message)
+
+ ;; Check, that the buffer has been reverted.
+ (file-notify--wait-for-events
+ timeout
+ (string-match
(format-message "Reverting buffer `%s'." (buffer-name buf))
- (buffer-string))))
- (should (string-match "another text" (buffer-string)))
+ captured-messages))
+ (should (string-match "another text" (buffer-string))))
;; Stop file notification. Autorevert shall still work via polling.
(file-notify-rm-watch auto-revert-notify-watch-descriptor)
@@ -728,27 +727,24 @@ delivered."
;; Modify file. We wait for two seconds, in order to
;; have another timestamp. One second seems to be too
- ;; short.
- (with-current-buffer (get-buffer-create "*Messages*")
- (narrow-to-region (point-max) (point-max)))
- (sleep-for 2)
- (write-region
- "foo bla" nil file-notify--test-tmpfile nil 'no-message)
-
- ;; Check, that the buffer has been reverted.
- (with-current-buffer (get-buffer-create "*Messages*")
- (file-notify--wait-for-events
- timeout
- (string-match
- (format-message "Reverting buffer `%s'." (buffer-name buf))
- (buffer-string))))
- (should (string-match "foo bla" (buffer-string))))
+ ;; short.
+ (ert-with-message-capture captured-messages
+ (sleep-for 2)
+ (write-region
+ "foo bla" nil file-notify--test-tmpfile nil 'no-message)
+
+ ;; Check, that the buffer has been reverted.
+ (file-notify--wait-for-events
+ timeout
+ (string-match
+ (format-message "Reverting buffer `%s'." (buffer-name buf))
+ captured-messages))
+ (should (string-match "foo bla" (buffer-string)))))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
;; Cleanup.
- (with-current-buffer "*Messages*" (widen))
(ignore-errors (kill-buffer buf))
(file-notify--test-cleanup))))
@@ -850,6 +846,13 @@ delivered."
;; After deleting the parent directory, the descriptor must
;; not be valid anymore.
(should-not (file-notify-valid-p file-notify--test-desc))
+ ;; w32notify doesn't generate 'stopped' events when the parent
+ ;; directory is deleted, which doesn't provide a chance for
+ ;; filenotify.el to remove the descriptor from the internal
+ ;; hash table it maintains. So we must remove the descriptor
+ ;; manually.
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -906,6 +909,8 @@ delivered."
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc))
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -975,6 +980,8 @@ delivered."
(file-notify--test-read-event)
(delete-file file)))
(delete-directory file-notify--test-tmpfile)
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -1184,6 +1191,9 @@ the file watch."
(delete-directory file-notify--test-tmpfile 'recursive))
(should-not (file-notify-valid-p file-notify--test-desc1))
(should-not (file-notify-valid-p file-notify--test-desc2))
+ (when (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc1)
+ (file-notify--rm-descriptor file-notify--test-desc2))
;; The environment shall be cleaned up.
(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 @@
(symbol-function
'htmlfontify-load-rgb-file))))
+(ert-deftest htmlfontify-bug25468 ()
+ "Tests that htmlfontify can be loaded even if no shell is
+available (Bug#25468)."
+ (should (equal (let ((process-environment
+ (cons "SHELL=/does/not/exist" process-environment)))
+ (call-process
+ (expand-file-name (invocation-name) (invocation-directory))
+ nil nil nil
+ "--quick" "--batch"
+ (concat "--load=" (locate-library "htmlfontify"))))
+ 0)))
+
(provide 'htmlfontify-tests)
;; 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 @@
(eval-when-compile
(require 'ibuf-macs))
+(defvar ibuffer-filter-groups)
+(defvar ibuffer-filtering-alist)
+(defvar ibuffer-filtering-qualifiers)
+(defvar ibuffer-save-with-custom)
+(defvar ibuffer-saved-filter-groups)
+(defvar ibuffer-saved-filters)
+(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier))
+(declare-function ibuffer-unary-operand "ibuf-ext" (filter))
+
(ert-deftest ibuffer-autoload ()
"Tests to see whether ibuffer has been autoloaded"
(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 @@
+;;; kmacro-tests.el --- Tests for kmacro.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'kmacro)
+(require 'ert)
+(require 'ert-x)
+
+;;; Test fixtures:
+
+(defmacro kmacro-tests-with-kmacro-clean-slate (&rest body)
+ "Create a clean environment for a kmacro test BODY to run in."
+ (declare (debug (body)))
+ `(cl-letf* ((kmacro-execute-before-append t)
+ (kmacro-ring-max 8)
+ (kmacro-repeat-no-prefix t)
+ (kmacro-call-repeat-key nil)
+ (kmacro-call-repeat-with-arg nil)
+
+ (kbd-macro-termination-hook nil)
+ (defining-kbd-macro nil)
+ (executing-kbd-macro nil)
+ (executing-kbd-macro-index 0)
+ (last-kbd-macro nil)
+
+ (kmacro-ring nil)
+
+ (kmacro-counter 0)
+ (kmacro-default-counter-format "%d")
+ (kmacro-counter-format "%d")
+ (kmacro-counter-format-start "%d")
+ (kmacro-counter-value-start 0)
+ (kmacro-last-counter 0)
+ (kmacro-initial-counter-value nil)
+
+ (kmacro-tests-macros nil)
+ (kmacro-tests-events nil)
+ (kmacro-tests-sequences nil))
+ (advice-add 'end-kbd-macro :after #'kmacro-tests-end-macro-advice)
+ (advice-add 'read-event :around #'kmacro-tests-read-event-advice )
+ (advice-add 'read-key-sequence :around #'kmacro-tests-read-key-sequence-advice)
+ (unwind-protect
+ (ert-with-test-buffer (:name "")
+ (switch-to-buffer (current-buffer))
+ ,@body)
+ (advice-remove 'read-key-sequence #'kmacro-tests-read-key-sequence-advice)
+ (advice-remove 'read-event #'kmacro-tests-read-event-advice)
+ (advice-remove 'end-kbd-macro #'kmacro-tests-end-macro-advice))))
+
+(defmacro kmacro-tests-deftest (name _args docstring &rest keys-and-body)
+ "Define a kmacro unit test.
+NAME is the name of the test, _ARGS should be nil, and DOCSTRING
+is required. To avoid having to duplicate ert's keyword parsing
+here, its keywords and values (if any) must be inside a list
+after the docstring, preceding the body, here combined with the
+body in KEYS-AND-BODY."
+ (declare (debug (&define name sexp stringp
+ [&optional (&rest &or [keywordp sexp])]
+ def-body))
+ (doc-string 3)
+ (indent 2))
+
+ (let* ((keys (when (and (listp (car keys-and-body))
+ (keywordp (caar keys-and-body)))
+ (car keys-and-body)))
+ (body (if keys (cdr keys-and-body)
+ keys-and-body)))
+ `(ert-deftest ,name ()
+ ,docstring ,@keys
+ (kmacro-tests-with-kmacro-clean-slate ,@body))))
+
+(defvar kmacro-tests-keymap
+ (let ((map (make-sparse-keymap)))
+ (dotimes (i 26)
+ (define-key map (string (+ ?a i)) 'self-insert-command))
+ (dotimes (i 10)
+ (define-key map (string (+ ?0 i)) 'self-insert-command))
+ ;; Define a few key sequences of different lengths.
+ (dolist (item '(("\C-a" . beginning-of-line)
+ ("\C-b" . backward-char)
+ ("\C-e" . end-of-line)
+ ("\C-f" . forward-char)
+ ("\C-r" . isearch-backward)
+ ("\C-u" . universal-argument)
+ ("\C-w" . kill-region)
+ ("\C-SPC" . set-mark-command)
+ ("\M-w" . kill-ring-save)
+ ("\M-x" . execute-extended-command)
+ ("\C-cd" . downcase-word)
+ ("\C-cxu" . upcase-word)
+ ("\C-cxq" . quoted-insert)
+ ("\C-cxi" . kmacro-insert-counter)
+ ("\C-x\C-k" . kmacro-keymap)))
+ (define-key map (car item) (cdr item)))
+ map)
+ "Keymap to use for testing keyboard macros.
+This is used to obtain consistent results even if tests are run
+in an environment with rebound keys.")
+
+(defvar kmacro-tests-events nil
+ "Input events used by the kmacro test in progress.")
+
+(defun kmacro-tests-read-event-advice (orig-func &rest args)
+ "Pop and return an event from `kmacro-tests-events'.
+Return the result of calling ORIG-FUNC with ARGS if
+`kmacro-tests-events' is empty, or if a keyboard macro is
+running."
+ (if (or executing-kbd-macro (null kmacro-tests-events))
+ (apply orig-func args)
+ (pop kmacro-tests-events)))
+
+(defvar kmacro-tests-sequences nil
+ "Input sequences used by the kmacro test in progress.")
+
+(defun kmacro-tests-read-key-sequence-advice (orig-func &rest args)
+ "Pop and return a string from `kmacro-tests-sequences'.
+Return the result of calling ORIG-FUNC with ARGS if
+`kmacro-tests-sequences' is empty, or if a keyboard macro is
+running."
+ (if (or executing-kbd-macro (null kmacro-tests-sequences))
+ (apply orig-func args)
+ (pop kmacro-tests-sequences)))
+
+(defvar kmacro-tests-macros nil
+ "Keyboard macros (in vector form) used by the kmacro test in progress.")
+
+(defun kmacro-tests-end-macro-advice (&rest _args)
+ "Pop a macro from `kmacro-tests-macros' and assign it to `last-kbd-macro'.
+If `kmacro-tests-macros' is empty, do nothing."
+ (when kmacro-tests-macros
+ (setq last-kbd-macro (pop kmacro-tests-macros))))
+
+;;; Some more powerful expectations:
+
+(defmacro kmacro-tests-should-insert (value &rest body)
+ "Verify that VALUE is inserted by the execution of BODY.
+Execute BODY, then check that the string VALUE was inserted
+into the current buffer at point."
+ (declare (debug (stringp body))
+ (indent 1))
+ (let ((g-p (cl-gensym))
+ (g-bsize (cl-gensym)))
+ `(let ((,g-p (point))
+ (,g-bsize (buffer-size)))
+ ,@body
+ (should (equal (buffer-substring ,g-p (point)) ,value))
+ (should (equal (- (buffer-size) ,g-bsize) (length ,value))))))
+
+(defmacro kmacro-tests-should-match-message (value &rest body)
+ "Verify that a message matching VALUE is issued while executing BODY.
+Execute BODY, and then if there is not a regexp match between
+VALUE and any text written to *Messages* during the execution,
+cause the current test to fail."
+ (declare (debug (form body))
+ (indent 1))
+ (let ((g-captured-messages (cl-gensym)))
+ `(ert-with-message-capture ,g-captured-messages
+ ,@body
+ (should (string-match-p ,value ,g-captured-messages)))))
+
+;;; Tests:
+
+(kmacro-tests-deftest kmacro-tests-test-insert-counter-01-nil ()
+ "`kmacro-insert-counter' adds one to macro counter with nil arg."
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
+ (kmacro-tests-should-insert "1"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
+
+(kmacro-tests-deftest kmacro-tests-test-insert-counter-02-int ()
+ "`kmacro-insert-counter' increments by value of list argument."
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter 2)))
+ (kmacro-tests-should-insert "2"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter 3)))
+ (kmacro-tests-should-insert "5"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
+
+(kmacro-tests-deftest kmacro-tests-test-insert-counter-03-list ()
+ "`kmacro-insert-counter' doesn't increment when given universal argument."
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter (16))))
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter (4)))))
+
+(kmacro-tests-deftest kmacro-tests-test-insert-counter-04-neg ()
+ "`kmacro-insert-counter' decrements with '- prefix argument"
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter -)))
+ (kmacro-tests-should-insert "-1"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
+
+(kmacro-tests-deftest kmacro-tests-test-start-format-counter ()
+ "`kmacro-insert-counter' uses start value and format."
+ (kmacro-tests-simulate-command '(kmacro-set-counter 10))
+ (kmacro-tests-should-insert "10"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
+ (kmacro-tests-should-insert "11"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
+ (kmacro-set-format "c=%s")
+ (kmacro-tests-simulate-command '(kmacro-set-counter 50))
+ (kmacro-tests-should-insert "c=50"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
+
+(kmacro-tests-deftest kmacro-tests-test-start-macro-when-defining-macro ()
+ "Starting a macro while defining a macro does not start a second macro."
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ ;; We should now be in the macro-recording state.
+ (should defining-kbd-macro)
+ (should-not last-kbd-macro)
+ ;; Calling it again should leave us in the same state.
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ (should defining-kbd-macro)
+ (should-not last-kbd-macro))
+
+
+(kmacro-tests-deftest kmacro-tests-set-macro-counter-while-defining ()
+ "Use of the prefix arg with kmacro-start sets kmacro-counter."
+ ;; Give kmacro-start-macro an argument.
+ (kmacro-tests-simulate-command '(kmacro-start-macro 5))
+ (should defining-kbd-macro)
+ ;; Verify that the counter is set to that value.
+ (kmacro-tests-should-insert "5"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
+ ;; Change it while defining a macro.
+ (kmacro-tests-simulate-command '(kmacro-set-counter 1))
+ (kmacro-tests-should-insert "1"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
+ ;; Using universal arg to to set counter should reset to starting value.
+ (kmacro-tests-simulate-command '(kmacro-set-counter (4)) '(4))
+ (kmacro-tests-should-insert "5"
+ (kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
+
+
+(kmacro-tests-deftest kmacro-tests-start-insert-counter-appends-to-macro ()
+ "Use of the universal arg appends to the previous macro."
+ (let ((kmacro-tests-macros (list (string-to-vector "hello"))))
+ ;; Start recording a macro.
+ (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil))
+ ;; Make sure we are recording.
+ (should defining-kbd-macro)
+ ;; Call it again and it should insert the counter.
+ (kmacro-tests-should-insert "0"
+ (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil)))
+ ;; We should still be in the recording state.
+ (should defining-kbd-macro)
+ ;; End recording with repeat count.
+ (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 3))
+ ;; Recording should be finished.
+ (should-not defining-kbd-macro)
+ ;; Now use prefix arg to append to the previous macro.
+ ;; This should run the previous macro first.
+ (kmacro-tests-should-insert "hello"
+ (kmacro-tests-simulate-command
+ '(kmacro-start-macro-or-insert-counter (4))))
+ ;; Verify that the recording state has changed.
+ (should (equal defining-kbd-macro 'append))))
+
+(kmacro-tests-deftest kmacro-tests-end-call-macro-prefix-args ()
+ "kmacro-end-call-macro changes behavior based on prefix arg."
+ ;; "Record" two macros.
+ (dotimes (i 2)
+ (kmacro-tests-define-macro (vconcat (format "macro #%d" (1+ i)))))
+ ;; With no prefix arg, it should call the second macro.
+ (kmacro-tests-should-insert "macro #2"
+ (kmacro-tests-simulate-command '(kmacro-end-or-call-macro nil)))
+ ;; With universal arg, it should call the first one.
+ (kmacro-tests-should-insert "macro #1"
+ (kmacro-tests-simulate-command '(kmacro-end-or-call-macro (4)))))
+
+(kmacro-tests-deftest kmacro-tests-end-and-call-macro ()
+ "Keyboard command to end and call macro works under various conditions."
+ ;; First, try it with no macro to record.
+ (setq kmacro-tests-macros '(""))
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ (condition-case err
+ (kmacro-tests-simulate-command '(kmacro-end-and-call-macro 2) 2)
+ (error (should (string= (cadr err)
+ "No kbd macro has been defined"))))
+
+ ;; Check that it stopped defining and that no macro was recorded.
+ (should-not defining-kbd-macro)
+ (should-not last-kbd-macro)
+
+ ;; Now try it while not recording, but first record a non-nil macro.
+ (kmacro-tests-define-macro "macro")
+ (kmacro-tests-should-insert "macro"
+ (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil))))
+
+(kmacro-tests-deftest kmacro-tests-end-and-call-macro-mouse ()
+ "Commands to end and call macro work under various conditions.
+This is a regression test for Bug#24992."
+ (:expected-result :failed)
+ (cl-letf (((symbol-function #'mouse-set-point) #'ignore))
+ ;; First, try it with no macro to record.
+ (setq kmacro-tests-macros '(""))
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ (condition-case err
+ (kmacro-tests-simulate-command '(kmacro-end-call-mouse 2) 2)
+ (error (should (string= (cadr err)
+ "No kbd macro has been defined"))))
+
+ ;; Check that it stopped defining and that no macro was recorded.
+ (should-not defining-kbd-macro)
+ (should-not last-kbd-macro)
+
+ ;; Now try it while not recording, but first record a non-nil macro.
+ (kmacro-tests-define-macro "macro")
+ (kmacro-tests-should-insert "macro"
+ (kmacro-tests-simulate-command '(kmacro-end-call-mouse nil)))))
+
+(kmacro-tests-deftest kmacro-tests-call-macro-hint-and-repeat ()
+ "`kmacro-call-macro' gives hint in Messages and sets up repeat keymap.
+This is a regression test for: Bug#3412, Bug#11817."
+ (kmacro-tests-define-macro [?m])
+ (let ((kmacro-call-repeat-key t)
+ (kmacro-call-repeat-with-arg t)
+ (overriding-terminal-local-map overriding-terminal-local-map)
+ (last-input-event ?e))
+ (message "") ; Clear the echo area. (Bug#3412)
+ (kmacro-tests-should-match-message "Type e to repeat macro"
+ (kmacro-tests-should-insert "mmmmmm"
+ (cl-letf (((symbol-function #'this-single-command-keys) (lambda ()
+ [?\C-x ?e])))
+ (kmacro-call-macro 3))
+ ;; Check that it set up for repeat, and run the repeat.
+ (funcall (lookup-key overriding-terminal-local-map "e"))))))
+
+(kmacro-tests-deftest
+ kmacro-tests-run-macro-command-recorded-in-macro ()
+ "No infinite loop if `kmacro-end-and-call-macro' is recorded in the macro.
+\(Bug#15126)"
+ (:expected-result :failed)
+ (ert-skip "Skipping due to Bug#24921 (an ERT bug)")
+ (kmacro-tests-define-macro (vconcat "foo" [return] "\M-x"
+ "kmacro-end-and-call-macro"))
+ (use-local-map kmacro-tests-keymap)
+ (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil)))
+
+
+(kmacro-tests-deftest kmacro-tests-test-ring-2nd-commands ()
+ "2nd macro in ring is displayed and executed normally and on repeat."
+ (use-local-map kmacro-tests-keymap)
+ ;; Record one macro, with count.
+ (push (vconcat "\C-cxi" "\C-u\C-cxi") kmacro-tests-macros)
+ (kmacro-tests-simulate-command '(kmacro-start-macro 1))
+ (kmacro-tests-simulate-command '(kmacro-end-macro nil))
+ ;; Check that execute and display do nothing with no 2nd macro.
+ (kmacro-tests-should-insert ""
+ (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil)))
+ (kmacro-tests-should-match-message "Only one keyboard macro defined"
+ (kmacro-tests-simulate-command '(kmacro-view-ring-2nd)))
+ ;; Record another one, with format.
+ (kmacro-set-format "=%d=")
+ (kmacro-tests-define-macro (vconcat "bar"))
+ ;; Execute the first one, mocked up to insert counter.
+ ;; Should get default format.
+ (kmacro-tests-should-insert "11"
+ (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil)))
+ ;; Now display the 2nd ring macro and check result.
+ (kmacro-tests-should-match-message "C-c x i C-u C-c x i"
+ (kmacro-view-ring-2nd)))
+
+(kmacro-tests-deftest kmacro-tests-fill-ring-and-rotate ()
+ "Macro ring can shift one way, shift the other way, swap and pop."
+ (cl-letf ((kmacro-ring-max 4))
+ ;; Record enough macros that the first one drops off the history.
+ (dotimes (n (1+ kmacro-ring-max))
+ (kmacro-tests-define-macro (make-vector (1+ n) (+ ?a n))))
+ ;; Cycle the ring and check that #2 comes up.
+ (kmacro-tests-should-match-message "2*b"
+ (kmacro-tests-simulate-command '(kmacro-cycle-ring-next nil)))
+ ;; Execute the current macro and check arguments.
+ (kmacro-tests-should-insert "bbbb"
+ (kmacro-call-macro 2 t))
+ ;; Cycle the ring the other way; #5 expected.
+ (kmacro-tests-should-match-message "5*e" (kmacro-cycle-ring-previous nil))
+ ;; Swapping the top two should give #4.
+ (kmacro-tests-should-match-message "4*d" (kmacro-swap-ring))
+ ;; Delete the top and expect #5.
+ (kmacro-tests-should-match-message "5*e" (kmacro-delete-ring-head))))
+
+
+(kmacro-tests-deftest kmacro-tests-test-ring-commands-when-no-macros ()
+ "Ring commands give appropriate message when no macros exist."
+ (dolist (cmd '((kmacro-cycle-ring-next nil)
+ (kmacro-cycle-ring-previous nil)
+ (kmacro-swap-ring)
+ (kmacro-delete-ring-head)
+ (kmacro-view-ring-2nd)
+ (kmacro-call-ring-2nd nil)
+ (kmacro-view-macro)))
+ (kmacro-tests-should-match-message "No keyboard macro defined"
+ (kmacro-tests-simulate-command cmd))))
+
+(kmacro-tests-deftest kmacro-tests-repeat-on-last-key ()
+ "Kmacro commands can be run in sequence without prefix keys."
+ (let* ((prefix (where-is-internal 'kmacro-keymap nil t))
+ ;; Make a sequence of events to run.
+ ;; Comments are expected output of mock macros
+ ;; on the first and second run of the sequence (see below).
+ (events (mapcar #'kmacro-tests-get-kmacro-key
+ '(kmacro-end-or-call-macro-repeat ;c / b
+ kmacro-end-or-call-macro-repeat ;c / b
+ kmacro-call-ring-2nd-repeat ;b / a
+ kmacro-cycle-ring-next
+ kmacro-end-or-call-macro-repeat ;a / a
+ kmacro-cycle-ring-previous
+ kmacro-end-or-call-macro-repeat ;c / b
+ kmacro-delete-ring-head
+ kmacro-end-or-call-macro-repeat ;b / a
+ )))
+ (kmacro-tests-macros (list [?a] [?b] [?c]))
+ ;; What we want kmacro to see as keyboard command sequence
+ (first-event (seq-concatenate
+ 'vector
+ prefix
+ (vector (kmacro-tests-get-kmacro-key
+ 'kmacro-end-or-call-macro-repeat)))))
+ (cl-letf
+ ;; standardize repeat options
+ ((kmacro-repeat-no-prefix t)
+ (kmacro-call-repeat-key t)
+ (kmacro-call-repeat-with-arg nil))
+ ;; "Record" two macros
+ (dotimes (_n 2)
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ (kmacro-tests-simulate-command '(kmacro-end-macro nil)))
+ ;; Start recording #3
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+
+ ;; Set up pending keyboard events and a fresh buffer
+ ;; kmacro-set-counter is not one of the repeating kmacro
+ ;; commands so it should end the sequence.
+ (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-set-counter))
+ (kmacro-tests-events (append events (list end-key))))
+ (cl-letf (((symbol-function #'this-single-command-keys)
+ (lambda () first-event)))
+ (use-local-map kmacro-tests-keymap)
+ (kmacro-tests-should-insert "ccbacb"
+ ;; End #3 and launch loop to read events.
+ (kmacro-end-or-call-macro-repeat nil))))
+
+ ;; `kmacro-edit-macro-repeat' should also stop the sequence,
+ ;; so run it again with that at the end.
+ (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-edit-macro-repeat))
+ (kmacro-tests-events (append events (list end-key))))
+ (cl-letf (((symbol-function #'edit-kbd-macro) #'ignore)
+ ((symbol-function #'this-single-command-keys)
+ (lambda () first-event)))
+ (use-local-map kmacro-tests-keymap)
+ (kmacro-tests-should-insert "bbbbbaaba"
+ (kmacro-end-or-call-macro-repeat 3)))))))
+
+(kmacro-tests-deftest kmacro-tests-repeat-view-and-run ()
+ "Kmacro view cycles through ring and executes macro just viewed."
+ (let* ((prefix (where-is-internal 'kmacro-keymap nil t))
+ (kmacro-tests-events
+ (mapcar #'kmacro-tests-get-kmacro-key
+ (append (make-list 5 'kmacro-view-macro-repeat)
+ '(kmacro-end-or-call-macro-repeat
+ kmacro-set-counter))))
+ ;; Make kmacro see this as keyboard command sequence.
+ (first-event (seq-concatenate
+ 'vector
+ prefix
+ (vector (kmacro-tests-get-kmacro-key
+ 'kmacro-view-macro-repeat))))
+ ;; Construct a regexp to match the messages which should be
+ ;; produced by repeated view-repeats.
+ (macros-regexp (apply #'concat
+ (mapcar (lambda (c) (format ".+%s\n" c))
+ '("d" "c" "b" "a" "d" "c")))))
+ (cl-letf ((kmacro-repeat-no-prefix t)
+ (kmacro-call-repeat-key t)
+ (kmacro-call-repeat-with-arg nil)
+ ((symbol-function #'this-single-command-keys) (lambda ()
+ first-event)))
+ ;; "Record" some macros.
+ (dotimes (n 4)
+ (kmacro-tests-define-macro (make-vector 1 (+ ?a n))))
+
+ (use-local-map kmacro-tests-keymap)
+ ;; 6 views (the direct call plus the 5 in events) should
+ ;; cycle through the ring and get to the second-to-last
+ ;; macro defined.
+ (kmacro-tests-should-insert "c"
+ (kmacro-tests-should-match-message macros-regexp
+ (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil)))))))
+
+(kmacro-tests-deftest kmacro-tests-bind-to-key-when-recording ()
+ "Bind to key doesn't bind a key during macro recording."
+ (cl-letf ((global-map global-map)
+ (saved-binding (key-binding "\C-a"))
+ (kmacro-tests-sequences (list "\C-a")))
+ (kmacro-tests-simulate-command '(kmacro-start-macro 1))
+ (kmacro-bind-to-key nil)
+ (should (eq saved-binding (key-binding "\C-a")))))
+
+(kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro ()
+ "Bind to key, symbol or register fails when when no macro exists."
+ (should-error (kmacro-bind-to-key nil))
+ (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
+ (should-error (kmacro-to-register)))
+
+(kmacro-tests-deftest kmacro-tests-bind-to-key-bad-key-sequence ()
+ "Bind to key fails to bind to ^G."
+ (let ((global-map global-map)
+ (saved-binding (key-binding "\C-g"))
+ (kmacro-tests-sequences (list "\C-g")))
+ (kmacro-tests-define-macro [1])
+ (kmacro-bind-to-key nil)
+ (should (eq saved-binding (key-binding "\C-g")))))
+
+(kmacro-tests-deftest kmacro-tests-bind-to-key-with-key-sequence-in-use ()
+ "Bind to key respects yes-or-no-p when given already bound key sequence."
+ (kmacro-tests-define-macro (vconcat "abaab"))
+ (let ((global-map global-map)
+ (map (make-sparse-keymap))
+ (kmacro-tests-sequences (make-list 2 "\C-hi")))
+ (define-key map "\C-hi" 'info)
+ (use-local-map map)
+ ;; Try the command with yes-or-no-p set up to say no.
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (should (string-match-p "info" prompt))
+ (should (string-match-p "C-h i" prompt))
+ nil)))
+ (kmacro-bind-to-key nil))
+
+ (should (equal (where-is-internal 'info nil t)
+ (vconcat "\C-hi")))
+ ;; Try it again with yes.
+ (cl-letf (((symbol-function #' yes-or-no-p)
+ (lambda (_prompt) t)))
+ (kmacro-bind-to-key nil))
+
+ (should-not (equal (where-is-internal 'info global-map t)
+ (vconcat "\C-hi")))
+ (use-local-map nil)
+ (kmacro-tests-should-insert "abaab"
+ (funcall (key-binding "\C-hi")))))
+
+(kmacro-tests-deftest kmacro-tests-kmacro-bind-to-single-key ()
+ "Bind to key uses C-x C-k A when asked to bind to A."
+ (let ((global-map global-map)
+ (kmacro-tests-macros (list (string-to-vector "\C-cxi"))))
+ (use-local-map kmacro-tests-keymap)
+
+ ;; Record a macro with counter and format set.
+ (kmacro-set-format "<%d>")
+ (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter 5))
+ (kmacro-tests-simulate-command '(kmacro-end-macro nil))
+
+ (let ((kmacro-tests-sequences (list "A")))
+ (kmacro-bind-to-key nil))
+
+ ;; Record a second macro with different counter and format.
+ (kmacro-set-format "%d")
+ (kmacro-tests-define-macro [2])
+
+ ;; Check the bound key and run it and verify correct counter
+ ;; and format.
+ (should (equal (string-to-vector "\C-cxi")
+ (car (kmacro-extract-lambda
+ (key-binding "\C-x\C-kA")))))
+ (kmacro-tests-should-insert "<5>"
+ (funcall (key-binding "\C-x\C-kA")))))
+
+(kmacro-tests-deftest kmacro-tests-name-last-macro-unable-to-bind ()
+ "Name last macro won't bind to symbol which is already bound."
+ (kmacro-tests-define-macro [1])
+ ;; Set up a test symbol which looks like a function.
+ (setplist 'kmacro-tests-symbol-for-test nil)
+ (fset 'kmacro-tests-symbol-for-test #'ignore)
+ (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
+ ;; The empty string symbol also can't be bound.
+ (should-error (kmacro-name-last-macro (make-symbol ""))))
+
+(kmacro-tests-deftest kmacro-tests-name-last-macro-bind-and-rebind ()
+ "Name last macro can rebind a symbol it binds."
+ ;; Make sure our symbol is unbound.
+ (when (fboundp 'kmacro-tests-symbol-for-test)
+ (fmakunbound 'kmacro-tests-symbol-for-test))
+ (setplist 'kmacro-tests-symbol-for-test nil)
+ ;; Make two macros and bind them to the same symbol.
+ (dotimes (i 2)
+ (kmacro-tests-define-macro (make-vector (1+ i) (+ ?a i)))
+ (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)
+ (should (fboundp 'kmacro-tests-symbol-for-test)))
+
+ ;; Now run the function bound to the symbol. Result should be the
+ ;; second macro.
+ (kmacro-tests-should-insert "bb"
+ (kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test))))
+
+(kmacro-tests-deftest kmacro-tests-store-in-register ()
+ "Macro can be stored in and retrieved from a register."
+ (use-local-map kmacro-tests-keymap)
+ ;; Save and restore register 200 so we can use it for the test.
+ (let ((saved-reg-contents (get-register 200)))
+ (unwind-protect
+ (progn
+ ;; Define a macro, and save it to a register.
+ (kmacro-tests-define-macro (vconcat "a\C-a\C-cxu"))
+ (kmacro-to-register 200)
+ ;; Then make a new different macro.
+ (kmacro-tests-define-macro (vconcat "bb\C-a\C-cxu"))
+ ;; When called from the register, result should be first macro.
+ (kmacro-tests-should-insert "AAA"
+ (kmacro-tests-simulate-command '(jump-to-register 200 3) 3))
+ (kmacro-tests-should-insert "a C-a C-c x u"
+ (kmacro-tests-simulate-command '(insert-register 200 t) '(4))))
+ (set-register 200 saved-reg-contents))))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-act ()
+ "Step-edit steps-through a macro with act and act-repeat."
+ (kmacro-tests-run-step-edit "he\C-u2lo"
+ :events (make-list 6 'act)
+ :result "hello"
+ :macro-result "he\C-u2lo")
+
+ (kmacro-tests-run-step-edit "f\C-aoo\C-abar"
+ :events (make-list 5 'act-repeat)
+ :result "baroof"
+ :macro-result "f\C-aoo\C-abar"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-skip ()
+ "Step-editing can skip parts of macro."
+ (kmacro-tests-run-step-edit "ofoofff"
+ :events '(skip skip-keep skip-keep skip-keep
+ skip-rest)
+ :result ""
+ :macro-result "foo"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-quit ()
+ "Quit while step-editing leaves macro unchanged."
+ (kmacro-tests-run-step-edit "bar"
+ :events '(help insert skip help quit)
+ :sequences '("f" "o" "o" "\C-j")
+ :result "foo"
+ :macro-result "bar"))
+
+(kmacro-tests-deftest kmacro-tests-step-insert ()
+ "Step edit can insert in macro."
+ (kmacro-tests-run-step-edit "fbazbop"
+ :events '(insert act insert-1 act-repeat)
+ :sequences '("o" "o" "\C-a" "\C-j" "\C-e")
+ :result "foobazbop"
+ :macro-result "oo\C-af\C-ebazbop"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-replace-digit-argument ()
+ "Step-edit replace can replace a numeric argument in a macro.
+This is a regression for item 1 in Bug#24991."
+ (:expected-result :failed)
+ (kmacro-tests-run-step-edit "\C-u3b\C-a\C-cxu"
+ :events '(act replace automatic)
+ :sequences '("8" "x" "\C-j")
+ :result "XXXXXXXX"
+ :macro-result "\C-u8x\C-a\C-cxu"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-replace ()
+ "Step-edit replace and replace-1 can replace parts of a macro."
+ (kmacro-tests-run-step-edit "a\C-a\C-cxu"
+ :events '(act act replace)
+ :sequences '("b" "c" "\C-j")
+ :result "bca"
+ :macro-result "a\C-abc")
+ (kmacro-tests-run-step-edit "a\C-a\C-cxucd"
+ :events '(act replace-1 automatic)
+ :sequences '("b")
+ :result "abcd"
+ :macro-result "ab\C-cxucd")
+ (kmacro-tests-run-step-edit "by"
+ :events '(act replace)
+ :sequences '("a" "r" "\C-j")
+ :result "bar"
+ :macro-result "bar"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-append ()
+ "Step edit append inserts after point, and append-end inserts at end."
+ (kmacro-tests-run-step-edit "f-b"
+ :events '(append append-end)
+ :sequences '("o" "o" "\C-j" "a" "r" "\C-j")
+ :result "foo-bar"
+ :macro-result "foo-bar")
+ (kmacro-tests-run-step-edit "x"
+ :events '(append)
+ :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j")
+ :result "Xy"
+ :macro-result "x\C-a\C-cxu\C-ey"))
+
+(kmacro-tests-deftest kmacro-tests-append-end-at-end-appends ()
+ "Append-end when already at end of macro appends to end of macro.
+This is a regression for item 2 in Bug#24991."
+ (:expected-result :failed)
+ (kmacro-tests-run-step-edit "x"
+ :events '(append-end)
+ :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j")
+ :result "Xy"
+ :macro-result "x\C-a\C-cxu\C-ey"))
+
+
+(kmacro-tests-deftest kmacro-tests-step-edit-skip-entire ()
+ "Skipping a whole macro in step-edit leaves macro unchanged.
+This is a regression for item 3 in Bug#24991."
+ (:expected-result :failed)
+ (kmacro-tests-run-step-edit "xyzzy"
+ :events '(skip-rest)
+ :result ""
+ :macro-result "xyzzy"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-step-through-negative-argument ()
+ "Step edit works on macros using negative universal argument.
+This is a regression for item 4 in Bug#24991."
+ (:expected-result :failed)
+ (kmacro-tests-run-step-edit "boo\C-u-\C-cu"
+ :events '(act-repeat automatic)
+ :result "BOO"
+ :macro-result "boo\C-u-\C-cd"))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-with-quoted-insert ()
+ "Stepping through a macro that uses quoted insert leaves macro unchanged.
+This is a regression for item 5 in Bug#24991."
+ (:expected-result :failed)
+ (let ((read-quoted-char-radix 8))
+ (kmacro-tests-run-step-edit "\C-cxq17051i there"
+ :events '(act automatic)
+ :result "ḩi there"
+ :macro-result "\C-cxq17051i there")
+ (kmacro-tests-run-step-edit "g\C-cxq17051i"
+ :events '(act insert-1 automatic)
+ :sequences '("-")
+ :result "g-ḩi"
+ :macro-result "g-\C-cxq17051i")))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-can-replace-meta-keys ()
+ "Replacing C-w with M-w produces the expected result.
+This is a regression for item 7 in Bug#24991."
+ (:expected-result :failed)
+ (kmacro-tests-run-step-edit "abc\C-b\C-b\C-SPC\C-f\C-w\C-e\C-y"
+ :events '(act-repeat act-repeat
+ act-repeat act-repeat
+ replace automatic)
+ :sequences '("\M-w" "\C-j")
+ :result "abcb"
+ :macro-result "abc\C-b\C-b\C-SPC\C-f\M-w\C-e\C-y")
+ (kmacro-tests-should-insert "abcb" (kmacro-call-macro nil)))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-ignores-qr-map-commands ()
+ "Unimplemented commands from `query-replace-map' are ignored."
+ (kmacro-tests-run-step-edit "yep"
+ :events '(edit-replacement
+ act-and-show act-and-exit
+ delete-and-edit
+ recenter backup
+ scroll-up scroll-down
+ scroll-other-window
+ scroll-other-window-down
+ exit-prefix
+ act act act)
+ :result "yep"
+ :macro-result "yep"))
+
+(kmacro-tests-deftest
+ kmacro-tests-step-edit-edits-macro-with-extended-command ()
+ "Step-editing a macro which uses the minibuffer can change the macro."
+ (let ((mac (vconcat [?\M-x] "eval-expression" '[return]
+ "(insert-char (+ ?a \C-e" [?1] "))" '[return]))
+ (mac-after (vconcat [?\M-x] "eval-expression" '[return]
+ "(insert-char (+ ?a \C-e" [?2] "))" '[return])))
+
+ (kmacro-tests-run-step-edit mac
+ :events '(act act-repeat
+ act act-repeat act
+ replace-1 act-repeat act)
+ :sequences '("2")
+ :result "c"
+ :macro-result mac-after)))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-step-through-isearch ()
+ "Step-editing can edit a macro which uses `isearch-backward' (Bug#22488)."
+ (:expected-result :failed)
+ (let ((mac (vconcat "test Input" '[return]
+ [?\C-r] "inp" '[return] "\C-cxu"))
+ (mac-after (vconcat "test input" '[return]
+ [?\C-r] "inp" '[return] "\C-cd")))
+
+ (kmacro-tests-run-step-edit mac
+ :events '(act-repeat act act
+ act-repeat act
+ replace-1)
+ :sequences '("\C-cd")
+ :result "test input\n"
+ :macro-result mac-after)))
+
+(kmacro-tests-deftest kmacro-tests-step-edit-cleans-up-hook ()
+ "Step-editing properly cleans up `post-command-hook.' (Bug #18708)"
+ (:expected-result :failed)
+ (let (post-command-hook)
+ (setq-local post-command-hook '(t))
+ (kmacro-tests-run-step-edit "x"
+ :events '(act)
+ :result "x"
+ :macro-result "x")
+ (kmacro-tests-simulate-command '(beginning-of-line))))
+
+(cl-defun kmacro-tests-run-step-edit
+ (macro &key events sequences result macro-result)
+ "Set up and run a test of `kmacro-step-edit-macro'.
+
+Run `kmacro-step-edit-macro' with MACRO defined as a keyboard macro
+and `read-event' and `read-key-sequence' set up to return items from
+EVENTS and SEQUENCES respectively. SEQUENCES may be nil, but
+EVENTS should not be. EVENTS should be a list of symbols bound
+in `kmacro-step-edit-map' or `query-replace' map, and this function
+will do the keymap lookup for you. SEQUENCES should contain
+return values for `read-key-sequence'.
+
+Before running the macro, the current buffer will be erased.
+RESULT is the string that should be inserted during the
+step-editing process, and MACRO-RESULT is the expected value of
+`last-kbd-macro' after the editing is complete."
+
+ (let* ((kmacro-tests-events (mapcar #'kmacro-tests-get-kmacro-step-edit-key events))
+ (kmacro-tests-sequences sequences))
+
+ (kmacro-tests-define-macro (string-to-vector macro))
+ (use-local-map kmacro-tests-keymap)
+ (erase-buffer)
+ (kmacro-step-edit-macro)
+ (when result
+ (should (equal result (buffer-string))))
+ (when macro-result
+ (should (equal last-kbd-macro (string-to-vector macro-result))))))
+
+;;; Utilities:
+
+(defun kmacro-tests-simulate-command (command &optional arg)
+ "Call `ert-simulate-command' after setting `current-prefix-arg'.
+Sets `current-prefix-arg' to ARG if it is non-nil, otherwise to
+the second element of COMMAND, before executing COMMAND using
+`ert-simulate-command'."
+ (let ((current-prefix-arg (or arg (cadr command))))
+ (ert-simulate-command command)))
+
+(defun kmacro-tests-define-macro (mac)
+ "Define MAC as a keyboard macro using kmacro commands."
+ (push mac kmacro-tests-macros)
+ (kmacro-tests-simulate-command '(kmacro-start-macro nil))
+ (should defining-kbd-macro)
+ (kmacro-tests-simulate-command '(kmacro-end-macro nil))
+ (should (equal mac last-kbd-macro)))
+
+(defun kmacro-tests-get-kmacro-key (sym)
+ "Look up kmacro command SYM in kmacro's keymap.
+Return the integer key value found."
+ (aref (where-is-internal sym kmacro-keymap t) 0))
+
+(defun kmacro-tests-get-kmacro-step-edit-key (sym)
+ "Return the first key bound to SYM in `kmacro-step-edit-map'."
+ (let ((where (aref (where-is-internal sym kmacro-step-edit-map t) 0)))
+ (if (consp where)
+ (car where)
+ where)))
+
+(provide 'kmacro-tests)
+
+;;; 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 @@
(ert-deftest completion-test1 ()
(with-temp-buffer
- (cl-flet* ((test/completion-table (string pred action)
+ (cl-flet* ((test/completion-table (_string _pred action)
(if (eq action 'lambda)
nil
"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 @@
(require 'ert)
(require 'dbus)
-(setq dbus-debug nil)
+(defvar dbus-debug nil)
+(declare-function dbus-get-unique-name "dbusbind.c" (bus))
(defvar dbus--test-enabled-session-bus
(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)) {
(should (= (current-column) x))
(forward-line))))
+(ert-deftest js-mode-auto-fill ()
+ (with-temp-buffer
+ (js-mode)
+ (setq fill-column 70)
+ (insert "/* ")
+ (dotimes (_ 16)
+ (insert "test "))
+ (do-auto-fill)
+ ;; The bug is that, after auto-fill, the second line starts with
+ ;; "/*", whereas it should start with " * ".
+ (goto-char (point-min))
+ (forward-line)
+ (should (looking-at " \\* test"))))
+
(provide 'js-tests)
;;; 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:
(python-tests-look-at "that)")
(should (= (current-indentation) 6))))
+(ert-deftest python-indent-electric-colon-4 ()
+ "Test indentation case where there is one more-indented previous open block."
+ (python-tests-with-temp-buffer
+ "
+def f():
+ if True:
+ a = 5
+
+ if True:
+ a = 10
+
+ b = 3
+
+else
+"
+ (python-tests-look-at "else")
+ (goto-char (line-end-position))
+ (python-tests-self-insert ":")
+ (python-tests-look-at "else" -1)
+ (should (= (current-indentation) 4))))
+
(ert-deftest python-indent-region-1 ()
"Test indentation case from Bug#18843."
(let ((contents "
@@ -2457,7 +2478,7 @@ if x:
(python-tests-with-temp-buffer
" \"\n"
(goto-char (point-min))
- (font-lock-fontify-buffer)))
+ (call-interactively 'font-lock-fontify-buffer)))
;;; 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 @@
(insert "(a b")
(save-excursion (insert " c d)"))
,@body
- (cons (buffer-substring (point-min) (point))
- (buffer-substring (point) (point-max)))))
+ (with-no-warnings
+ (cons (buffer-substring (point-min) (point))
+ (buffer-substring (point) (point-max))))))
(defmacro simple-test--transpositions (&rest body)
@@ -266,7 +267,6 @@
(with-temp-buffer
(setq buffer-undo-list nil)
(insert "hello")
- (car buffer-undo-list)
(undo-auto--boundaries 'test))))
;;; 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 @@
(should (member "body" completions))
(should-not (member "article" completions)))))
+(ert-deftest css-mdn-symbol-guessing ()
+ (dolist (item '(("@med" "ia" "@media")
+ ("@keyframes " "{" "@keyframes")
+ ("p::after" "" "::after")
+ ("p:before" "" ":before")
+ ("a:v" "isited" ":visited")
+ ("border-" "color: red" "border-color")
+ ("border-color: red" ";" "border-color")
+ ("border-color: red; color: green" ";" "color")))
+ (with-temp-buffer
+ (css-mode)
+ (insert (nth 0 item))
+ (save-excursion (insert (nth 1 item)))
+ (should (equal (nth 2 item) (css--mdn-find-symbol))))))
+
(provide 'css-mode-tests)
;;; 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."
(defun tildify-space-undo-test--test
- (modes nbsp env-open &optional set-space-string)
+ (modes nbsp _env-open &optional set-space-string)
(with-temp-buffer
(setq-local buffer-file-coding-system 'utf-8)
(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 @@
+;; Copyright (C) 2017 Free Software Foundation, Inc
+
+;; Author: Dima Kogan <dima@secretsauce.net>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'diff-mode)
+
+
+(ert-deftest diff-mode-test-ignore-trailing-dashes ()
+ "Check to make sure we successfully ignore trailing -- made by
+'git format-patch'. This is bug #9597"
+
+ ;; I made a test repo, put some files in it, made arbitrary changes
+ ;; and invoked 'git format-patch' to get a patch out of it. The
+ ;; patch and the before and after versions of the files appear here.
+ ;; The test simply tries to apply the patch. The patch contains
+ ;; trailing --, which confused diff-mode previously
+ (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17 00:00:00 2001
+From: Dima Kogan <dima@secretsauce.net>
+Date: Mon, 30 Jan 2017 22:24:13 -0800
+Subject: [PATCH] test commit
+
+---
+ fil | 3 ---
+ fil2 | 4 ----
+ 2 files changed, 7 deletions(-)
+
+diff --git a/fil b/fil
+index 10344f1..2a56245 100644
+--- a/fil
++++ b/fil
+@@ -2,10 +2,8 @@ Afrocentrism
+ Americanisms
+ Americanization
+ Americanizations
+-Americanized
+ Americanizes
+ Americanizing
+-Andrianampoinimerina
+ Anglicanisms
+ Antananarivo
+ Apalachicola
+@@ -15,6 +13,5 @@ Aristophanes
+ Aristotelian
+ Ashurbanipal
+ Australopithecus
+-Austronesian
+ Bangladeshis
+ Barquisimeto
+diff --git a/fil2 b/fil2
+index 8858f0d..86e8ea5 100644
+--- a/fil2
++++ b/fil2
+@@ -1,20 +1,16 @@
+ whippoorwills
+ whitewashing
+ wholehearted
+-wholeheartedly
+ wholesomeness
+ wildernesses
+ windbreakers
+ wisecracking
+ withstanding
+-woodcarvings
+ woolgathering
+ workstations
+ worthlessness
+ wretchedness
+ wristwatches
+-wrongfulness
+ wrongheadedly
+ wrongheadedness
+-xylophonists
+ youthfulness
+--
+2.11.0
+
+")
+ (fil_before "Afrocentrism
+Americanisms
+Americanization
+Americanizations
+Americanized
+Americanizes
+Americanizing
+Andrianampoinimerina
+Anglicanisms
+Antananarivo
+Apalachicola
+Appalachians
+Argentinians
+Aristophanes
+Aristotelian
+Ashurbanipal
+Australopithecus
+Austronesian
+Bangladeshis
+Barquisimeto
+")
+ (fil_after "Afrocentrism
+Americanisms
+Americanization
+Americanizations
+Americanizes
+Americanizing
+Anglicanisms
+Antananarivo
+Apalachicola
+Appalachians
+Argentinians
+Aristophanes
+Aristotelian
+Ashurbanipal
+Australopithecus
+Bangladeshis
+Barquisimeto
+")
+ (fil2_before "whippoorwills
+whitewashing
+wholehearted
+wholeheartedly
+wholesomeness
+wildernesses
+windbreakers
+wisecracking
+withstanding
+woodcarvings
+woolgathering
+workstations
+worthlessness
+wretchedness
+wristwatches
+wrongfulness
+wrongheadedly
+wrongheadedness
+xylophonists
+youthfulness
+")
+ (fil2_after "whippoorwills
+whitewashing
+wholehearted
+wholesomeness
+wildernesses
+windbreakers
+wisecracking
+withstanding
+woolgathering
+workstations
+worthlessness
+wretchedness
+wristwatches
+wrongheadedly
+wrongheadedness
+youthfulness
+")
+ (temp-dir (make-temp-file "diff-mode-test" 'dir)))
+
+ (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
+ (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
+ (unwind-protect
+ (progn
+ (with-current-buffer buf (insert fil_before) (save-buffer))
+ (with-current-buffer buf2 (insert fil2_before) (save-buffer))
+
+ (with-temp-buffer
+ (cd temp-dir)
+ (insert patch)
+ (beginning-of-buffer)
+ (diff-apply-hunk)
+ (diff-apply-hunk)
+ (diff-apply-hunk))
+
+ (should (equal (with-current-buffer buf (buffer-string))
+ fil_after))
+ (should (equal (with-current-buffer buf2 (buffer-string))
+ fil2_after)))
+
+ (ignore-errors
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)
+ (with-current-buffer buf2 (set-buffer-modified-p nil))
+ (kill-buffer buf2)
+ (delete-directory temp-dir 'recursive))))))
+
+
+(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.")
(append xml-default-ns
'(("F" . "FOOBAR:"))))))))))
+;; Test bug #23440 (proper expansion of default namespace)
+; Test data for default namespace
+(defvar xml-parse-test--default-namespace-qnames
+ (cons "<something xmlns=\"myns:\"><whatever></whatever></something>"
+ '((myns:something
+ ((("http://www.w3.org/2000/xmlns/" . "")
+ . "myns:"))
+ (myns:whatever nil)))))
+
+(ert-deftest xml-parse-test-default-namespace-qnames ()
+ (with-temp-buffer
+ (insert (car xml-parse-test--default-namespace-qnames))
+ (should (equal (cdr xml-parse-test--default-namespace-qnames)
+ (xml-parse-region nil nil nil nil 'symbol-qnames)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
View Lorry Controller Status