mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00
Code Issues Releases Activity
master
emacs/test/lisp/simple-tests.el
Eli Zaretskii f475a1a254 ; Fix simple-tests as fallout of last change 
* test/lisp/simple-tests.el
(simple-execute-extended-command--shorter): Fix test broken by new
kill-whole-line tests.  (Bug#65734)
2024-06-27 11:37:15 +03:00

1284 lines
48 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; simple-tests.el --- Tests for simple.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2024 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.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 <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'ert-x)
(eval-when-compile (require 'cl-lib))
(defun simple-test--buffer-substrings ()
"Return cons of buffer substrings before and after point."
(cons (buffer-substring (point-min) (point))
(buffer-substring (point) (point-max))))
(defmacro simple-test--dummy-buffer (&rest body)
(declare (indent 0)
(debug t))
`(with-temp-buffer
(emacs-lisp-mode)
(setq indent-tabs-mode nil)
(insert "(a b")
(save-excursion (insert " c d)"))
,@body
(with-no-warnings (simple-test--buffer-substrings))))
(defconst simple-test-point-tag "<POINT>")
(defconst simple-test-mark-tag "<MARK>")
(defun simple-test--set-buffer-text-point-mark (description)
"Set the current buffer's text, point and mark according to
DESCRIPTION.
Erase current buffer and insert DESCRIPTION. Set point to the
first occurrence of `simple-test-point-tag' (\"<POINT>\") in the
buffer, removing it. If there is no `simple-test-point-tag', set
point to the beginning of the buffer. If there is a
`simple-test-mark-tag' (\"<MARK>\"), remove it, and set an active
mark there."
(erase-buffer)
(insert description)
(goto-char (point-min))
(when (search-forward simple-test-mark-tag nil t)
(delete-char (- (length simple-test-mark-tag)))
(push-mark (point) nil 'activate))
(goto-char (point-min))
(when (search-forward simple-test-point-tag nil t)
(delete-char (- (length simple-test-point-tag)))))
(defun simple-test--get-buffer-text-point-mark ()
"Inverse of `simple-test--set-buffer-text-point-mark'."
(cond
((not mark-active)
(concat (buffer-substring-no-properties (point-min) (point))
simple-test-point-tag
(buffer-substring-no-properties (point) (point-max))))
((< (mark) (point))
(concat (buffer-substring-no-properties (point-min) (mark))
simple-test-mark-tag
(buffer-substring-no-properties (mark) (point))
simple-test-point-tag
(buffer-substring-no-properties (point) (point-max))))
(t
(concat (buffer-substring-no-properties (point-min) (point))
simple-test-point-tag
(buffer-substring-no-properties (point) (mark))
simple-test-mark-tag
(buffer-substring-no-properties (mark) (point-max))))))
;;; `count-words'
(ert-deftest simple-test-count-words-bug-41761 ()
(with-temp-buffer
(dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil))))
(should (= (count-words (point-min) (point-max)) 10))))
;;; `count-lines'
(ert-deftest simple-test-count-lines ()
(with-temp-buffer
(should (= (count-lines (point-min) (point-max)) 0))
(insert "foo")
(should (= (count-lines (point-min) (point-max)) 1))
(insert "\nbar\nbaz\n")
(should (= (count-lines (point-min) (point-max)) 3))
(insert "r\n")
(should (= (count-lines (point-min) (point-max)) 4))))
(ert-deftest simple-test-count-lines/ignore-invisible-lines ()
(with-temp-buffer
(insert "foo\nbar")
(should (= (count-lines (point-min) (point-max) t) 2))
(insert (propertize "\nbar\nbaz\nzut" 'invisible t))
(should (= (count-lines (point-min) (point-max) t) 2))))
(ert-deftest simple-text-count-lines-non-ascii ()
(with-temp-buffer
(insert "あ\nい\nう\nえ\nお\n")
(should (= (count-lines (point) (point)) 0))))
;;; `execute-extended-command'
(ert-deftest simple-execute-extended-command--shorter ()
;; This test can be flaky with completion frameworks other than the
;; default, so just skip it in interactive sessions.
(skip-unless noninteractive)
(should (equal (execute-extended-command--shorter
"display-line-numbers-mode"
"display-line")
;; Depending on the tests performed and their order, we
;; could have loaded Dired, which defines commands
;; starting with "dir".
(if (featurep 'dired)
"dis-n"
"di-n"))))
(ert-deftest simple-execute-extended-command--describe-binding-msg ()
(let ((text-quoting-style 'grave))
(should (equal (execute-extended-command--describe-binding-msg
'foo "m" nil)
"You can run the command `foo' with m"))
(should (equal (execute-extended-command--describe-binding-msg
'foo [14] nil)
"You can run the command `foo' with C-n"))
(should (equal (execute-extended-command--describe-binding-msg
'display-line-numbers-mode nil "di-n")
"You can run the command `display-line-numbers-mode' with M-x di-n"))))
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
(debug t))
`(with-temp-buffer
(emacs-lisp-mode)
(insert "(s1) (s2) (s3) (s4) (s5)")
(backward-sexp 1)
,@body
(simple-test--buffer-substrings)))
;;; Transposition with negative args (bug#20698, bug#21885)
(ert-deftest simple-transpose-subr ()
(should (equal (simple-test--transpositions (transpose-sexps -1))
'("(s1) (s2) (s4)" . " (s3) (s5)")))
(should (equal (simple-test--transpositions (transpose-sexps -2))
'("(s1) (s4)" . " (s2) (s3) (s5)"))))
;;; `newline'
(ert-deftest newline ()
(should-error (newline -1))
(should (equal (simple-test--dummy-buffer (newline 1))
'("(a b\n" . " c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-mode -1)
(call-interactively #'newline))
'("(a b\n" . " c d)")))
(should (equal (simple-test--dummy-buffer
(let ((current-prefix-arg 5))
(call-interactively #'newline)))
'("(a b\n\n\n\n\n" . " c d)")))
(should (equal (simple-test--dummy-buffer (newline 5))
'("(a b\n\n\n\n\n" . " c d)")))
(should (equal (simple-test--dummy-buffer
(forward-char 1)
(newline 1))
'("(a b \n" . "c d)"))))
(ert-deftest newline-indent ()
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(newline 1))
'("(a b\n" . " c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(newline 1 'interactive))
'("(a b\n " . "c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(let ((current-prefix-arg nil))
(call-interactively #'newline)
(call-interactively #'newline)))
'("(a b\n\n " . "c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(newline 5 'interactive))
'("(a b\n\n\n\n\n " . "c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(let ((current-prefix-arg 5))
(call-interactively #'newline)))
'("(a b\n\n\n\n\n " . "c d)")))
(should (equal (simple-test--dummy-buffer
(forward-char 1)
(electric-indent-local-mode 1)
(newline 1 'interactive))
'("(a b\n " . "c d)"))))
;;; `open-line'
(ert-deftest open-line ()
(should-error (open-line -1))
(should-error (open-line))
(should (equal (simple-test--dummy-buffer (open-line 1))
'("(a b" . "\n c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-mode -1)
(call-interactively #'open-line))
'("(a b" . "\n c d)")))
(should (equal (simple-test--dummy-buffer
(let ((current-prefix-arg 5))
(call-interactively #'open-line)))
'("(a b" . "\n\n\n\n\n c d)")))
(should (equal (simple-test--dummy-buffer (open-line 5))
'("(a b" . "\n\n\n\n\n c d)")))
(should (equal (simple-test--dummy-buffer
(forward-char 1)
(open-line 1))
'("(a b " . "\nc d)"))))
(ert-deftest open-line-margin-and-prefix ()
(should (equal (simple-test--dummy-buffer
(let ((left-margin 10))
(open-line 3)))
'("(a b" . "\n\n\n c d)")))
(should (equal (simple-test--dummy-buffer
(forward-line 0)
(let ((left-margin 2))
(open-line 1)))
'(" " . "\n (a b c d)")))
(should (equal (simple-test--dummy-buffer
(let ((fill-prefix "- - "))
(open-line 1)))
'("(a b" . "\n c d)")))
(should (equal (simple-test--dummy-buffer
(forward-line 0)
(let ((fill-prefix "- - "))
(open-line 1)))
'("- - " . "\n(a b c d)"))))
;; For a while, from 24 Oct - 21 Nov 2015, `open-line' in the Emacs
;; development tree became sensitive to `electric-indent-mode', which
;; it had not been before. This sensitivity was reverted for the
;; Emacs 25 release, so it could be discussed further (see thread
;; "Questioning the new behavior of `open-line'." on the Emacs Devel
;; mailing list, and bug #21884).
(ert-deftest open-line-indent ()
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(open-line 1))
'("(a b" . "\n c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(open-line 1))
'("(a b" . "\n c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(let ((current-prefix-arg nil))
(call-interactively #'open-line)
(call-interactively #'open-line)))
'("(a b" . "\n\n c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(open-line 5))
'("(a b" . "\n\n\n\n\n c d)")))
(should (equal (simple-test--dummy-buffer
(electric-indent-local-mode 1)
(let ((current-prefix-arg 5))
(call-interactively #'open-line)))
'("(a b" . "\n\n\n\n\n c d)")))
(should (equal (simple-test--dummy-buffer
(forward-char 1)
(electric-indent-local-mode 1)
(open-line 1))
'("(a b " . "\nc d)"))))
;; From 24 Oct - 21 Nov 2015, `open-line' took a second argument
;; INTERACTIVE and ran `post-self-insert-hook' if the argument was
;; true. This test tested that. Currently, however, `open-line'
;; does not run `post-self-insert-hook' at all, so for now
;; this test just makes sure that it doesn't.
(ert-deftest open-line-hook ()
(let* ((x 0)
(inc (lambda () (setq x (1+ x)))))
(simple-test--dummy-buffer
(add-hook 'post-self-insert-hook inc nil 'local)
(open-line 1))
(should (= x 0))
(simple-test--dummy-buffer
(add-hook 'post-self-insert-hook inc nil 'local)
(open-line 1))
(should (= x 0))
(unwind-protect
(progn
(add-hook 'post-self-insert-hook inc)
(simple-test--dummy-buffer
(open-line 1))
(should (= x 0))
(simple-test--dummy-buffer
(open-line 10))
(should (= x 0)))
(remove-hook 'post-self-insert-hook inc))))
;;; `delete-indentation'
(ert-deftest simple-delete-indentation-no-region ()
"Test `delete-indentation' when no mark is set; see bug#35021."
(with-temp-buffer
(insert " first \n second \n third \n fourth ")
(should-not (mark t))
;; Without prefix argument.
(should-not (call-interactively #'delete-indentation))
(should (equal (simple-test--buffer-substrings)
'(" first \n second \n third" . " fourth ")))
(should-not (call-interactively #'delete-indentation))
(should (equal (simple-test--buffer-substrings)
'(" first \n second" . " third fourth ")))
;; With prefix argument.
(goto-char (point-min))
(let ((current-prefix-arg '(4)))
(should-not (call-interactively #'delete-indentation)))
(should (equal (simple-test--buffer-substrings)
'(" first" . " second third fourth ")))))
(ert-deftest simple-delete-indentation-inactive-region ()
"Test `delete-indentation' with an inactive region."
(with-temp-buffer
(insert " first \n second \n third ")
(set-marker (mark-marker) (point-min))
(should (mark t))
(should-not (call-interactively #'delete-indentation))
(should (equal (simple-test--buffer-substrings)
'(" first \n second" . " third ")))))
(ert-deftest simple-delete-indentation-blank-line ()
"Test `delete-indentation' does not skip blank lines.
See bug#35036."
(with-temp-buffer
(insert "\n\n third \n \n \n sixth \n\n")
;; Without prefix argument.
(should-not (delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("\n\n third \n \n \n sixth \n" . "")))
(should-not (delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("\n\n third \n \n \n sixth" . "")))
(should-not (delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("\n\n third \n \n" . "sixth")))
;; With prefix argument.
(goto-char (point-min))
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'("" . "\n third \n \nsixth")))
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'("" . "third \n \nsixth")))
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'("third" . "\nsixth")))
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'("third" . " sixth")))))
(ert-deftest simple-delete-indentation-boundaries ()
"Test `delete-indentation' motion at buffer boundaries."
(with-temp-buffer
(insert " first \n second \n third ")
;; Stay at EOB.
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'(" first \n second \n third " . "")))
;; Stay at BOB.
(forward-line -1)
(save-restriction
(narrow-to-region (point) (pos-eol))
(should-not (delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("" . " second ")))
;; Go to EOB.
(should-not (delete-indentation t))
(should (equal (simple-test--buffer-substrings)
'(" second " . ""))))
;; Go to BOB.
(end-of-line 0)
(should-not (delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("" . " first \n second \n third ")))))
(ert-deftest simple-delete-indentation-region ()
"Test `delete-indentation' with an active region."
(with-temp-buffer
;; Empty region.
(insert " first ")
(should-not (delete-indentation nil (point) (point)))
(should (equal (simple-test--buffer-substrings)
'(" first " . "")))
;; Single line.
(should-not (delete-indentation nil (pos-bol) (1- (point))))
(should (equal (simple-test--buffer-substrings)
'("" . " first ")))
(should-not (delete-indentation nil (1+ (point)) (pos-eol)))
(should (equal (simple-test--buffer-substrings)
'(" " . "first ")))
(should-not (delete-indentation nil (pos-bol) (pos-eol)))
(should (equal (simple-test--buffer-substrings)
'("" . " first ")))
;; Multiple lines.
(goto-char (point-max))
(insert "\n second \n third \n fourth ")
(goto-char (point-min))
(should-not (delete-indentation nil (pos-eol) (pos-bol 2)))
(should (equal (simple-test--buffer-substrings)
'(" first" . " second \n third \n fourth ")))
(should-not (delete-indentation nil (point) (1+ (pos-bol 2))))
(should (equal (simple-test--buffer-substrings)
'(" first second" . " third \n fourth ")))
;; Prefix argument overrides region.
(should-not (delete-indentation t (point-min) (point)))
(should (equal (simple-test--buffer-substrings)
'(" first second third" . " fourth ")))))
(ert-deftest simple-delete-indentation-prefix ()
"Test `delete-indentation' with a fill prefix."
(with-temp-buffer
(insert "> first \n> second \n> third \n> fourth ")
(let ((fill-prefix ""))
(delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("> first \n> second \n> third" . " > fourth ")))
(let ((fill-prefix "<"))
(delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("> first \n> second" . " > third > fourth ")))
(let ((fill-prefix ">"))
(delete-indentation))
(should (equal (simple-test--buffer-substrings)
'("> first" . " second > third > fourth ")))))
;;; `delete-trailing-whitespace'
(ert-deftest simple-delete-trailing-whitespace--bug-21766 ()
"Test bug#21766: delete-whitespace sometimes deletes non-whitespace."
(defvar python-indent-guess-indent-offset) ; to avoid a warning
(let ((python (featurep 'python))
(python-indent-guess-indent-offset nil)
(delete-trailing-lines t))
(unwind-protect
(with-temp-buffer
(python-mode)
(insert (concat "query = \"\"\"WITH filtered AS \n"
"WHERE \n"
"\"\"\".format(fv_)\n"
"\n"
"\n"))
(delete-trailing-whitespace)
(should (string-equal (buffer-string)
(concat "query = \"\"\"WITH filtered AS\n"
"WHERE\n"
"\"\"\".format(fv_)\n"))))
;; Let's clean up if running interactive
(unless (or noninteractive python)
(unload-feature 'python)))))
(ert-deftest simple-delete-trailing-whitespace--formfeeds ()
"Test formfeeds are not deleted but whitespace past them is."
(with-temp-buffer
(with-syntax-table (make-syntax-table)
(modify-syntax-entry ?\f " ") ; Make sure \f is whitespace
(insert " \f \n \f \f \n\nlast\n")
(delete-trailing-whitespace)
(should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n"))
(should (equal ?\s (char-syntax ?\f)))
(should (equal ?\s (char-syntax ?\n))))))
;;; undo tests
(defun simple-tests--exec (cmds)
(dolist (cmd cmds)
(setq last-command this-command)
(setq this-command cmd)
(run-hooks 'pre-command-hook)
(command-execute cmd)
(run-hooks 'post-command-hook)
(undo-boundary)))
(ert-deftest simple-tests--undo ()
(with-temp-buffer
(buffer-enable-undo)
(dolist (x '("a" "b" "c" "d" "e"))
(insert x)
(undo-boundary))
(should (equal (buffer-string) "abcde"))
(simple-tests--exec '(undo undo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo))
(should (equal (buffer-string) "abcd"))
(simple-tests--exec '(undo))
(should (equal (buffer-string) "abcde"))
(simple-tests--exec '(backward-char undo undo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-redo))
(should (equal (buffer-string) "abcd"))
(simple-tests--exec '(undo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-redo undo-redo))
(should (equal (buffer-string) "abcde"))
(simple-tests--exec '(undo undo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-only undo-only))
(should (equal (buffer-string) "a"))
(simple-tests--exec '(backward-char undo-redo undo-redo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-redo undo-redo))
(should (equal (buffer-string) "abcde"))))
(ert-deftest simple-tests--undo-in-region ()
;; Test undo/redo in region.
(with-temp-buffer
;; Enable `transient-mark-mode' so `region-active-p' works as
;; expected. `region-active-p' is used to determine whether to
;; perform regional undo in `undo'.
(transient-mark-mode)
(buffer-enable-undo)
(dolist (x '("a" "b" "c" "d" "e"))
(insert x)
(undo-boundary))
(should (equal (buffer-string) "abcde"))
;; The test does this: activate region, `undo', break the undo
;; chain (by deactivating and reactivating the region), then
;; `undo-only'. There used to be a bug in
;; `undo-make-selective-list' that makes `undo-only' error out in
;; that case, which is fixed by in the same commit as this change.
(simple-tests--exec '(move-beginning-of-line
push-mark-command
forward-char
forward-char
undo))
(should (equal (buffer-string) "acde"))
(simple-tests--exec '(move-beginning-of-line
push-mark-command
forward-char
forward-char
undo-only))
(should (equal (buffer-string) "abcde"))
;; Rest are simple redo in region tests.
(simple-tests--exec '(undo-redo))
(should (equal (buffer-string) "acde"))
(simple-tests--exec '(undo-redo))
(should (equal (buffer-string) "abcde"))))
(defun simple-tests--sans-leading-nil (lst)
"Return LST sans the leading nils."
(while (and (consp lst) (null (car lst)))
(setq lst (cdr lst)))
lst)
(ert-deftest simple-tests--undo-equiv-table ()
(with-temp-buffer
(buffer-enable-undo)
(transient-mark-mode)
(let ((ul-hash-table (make-hash-table :test #'equal)))
(dolist (x '("a" "b" "c"))
(insert x)
(puthash x (simple-tests--sans-leading-nil buffer-undo-list)
ul-hash-table)
(undo-boundary))
(should (equal (buffer-string) "abc"))
;; Tests mappings in `undo-equiv-table'.
(simple-tests--exec '(undo))
(should (equal (buffer-string) "ab"))
(should (eq (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
(gethash "b" ul-hash-table)))
(simple-tests--exec '(backward-char undo))
(should (equal (buffer-string) "abc"))
(should (eq (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
(gethash "c" ul-hash-table)))
;; Undo in region should map to 'undo-in-region.
(simple-tests--exec '(backward-char
push-mark-command
move-end-of-line
undo))
(should (equal (buffer-string) "ab"))
(should (eq (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
'undo-in-region))
;; The undo that undoes to the beginning should map to t.
(deactivate-mark 'force)
(simple-tests--exec '(backward-char
undo undo undo
undo undo undo))
(should (equal (buffer-string) ""))
(should (eq (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
t))
;; Erroneous nil undo should map to 'empty.
(insert "a")
(undo-boundary)
(push nil buffer-undo-list)
(simple-tests--exec '(backward-char undo))
(should (equal (buffer-string) "a"))
(should (eq (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
'empty))
;; But if the previous record is a redo record, its mapping
;; shouldn't change.
(insert "e")
(undo-boundary)
(should (equal (buffer-string) "ea"))
(puthash "e" (simple-tests--sans-leading-nil buffer-undo-list)
ul-hash-table)
(insert "a")
(undo-boundary)
(simple-tests--exec '(backward-char undo))
(should (equal (buffer-string) "ea"))
(push nil buffer-undo-list)
(simple-tests--exec '(forward-char undo))
;; Buffer content should change since we just undid a nil
;; record.
(should (equal (buffer-string) "ea"))
;; The previous redo record shouldn't map to empty.
(should (equal (gethash (simple-tests--sans-leading-nil
buffer-undo-list)
undo-equiv-table)
(gethash "e" ul-hash-table))))))
;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
(should
undo-auto-current-boundary-timer))
(ert-deftest undo-auto--boundaries-added ()
;; The change in the buffer should have caused addition
;; to undo-auto--undoably-changed-buffers.
(should
(with-temp-buffer
(setq buffer-undo-list nil)
(insert "hello")
(member (current-buffer) undo-auto--undoably-changed-buffers)))
;; The head of buffer-undo-list should be the insertion event, and
;; therefore not nil
(should
(with-temp-buffer
(setq buffer-undo-list nil)
(insert "hello")
(car buffer-undo-list)))
;; Now the head of the buffer-undo-list should be a boundary and so
;; nil. We have to call auto-boundary explicitly because we are out
;; of the command loop
(should-not
(with-temp-buffer
(setq buffer-undo-list nil)
(insert "hello")
(undo-auto--boundaries 'test))))
;; Test for a regression introduced by undo-auto--boundaries changes.
;; https://lists.gnu.org/r/emacs-devel/2015-11/msg01652.html
(defun undo-test-kill-c-a-then-undo ()
(with-temp-buffer
(switch-to-buffer (current-buffer))
(setq buffer-undo-list nil)
(insert "a\nb\nc\n")
(goto-char (point-max))
;; We use a keyboard macro because it adds undo events in the same
;; way as if a user were involved.
(kmacro-call-macro nil nil nil
[left
;; Delete "c"
backspace
left left left
;; Delete "a"
backspace
;; C-/ or undo
67108911
])
(point)))
(defun undo-test-point-after-forward-kill ()
(with-temp-buffer
(switch-to-buffer (current-buffer))
(setq buffer-undo-list nil)
(insert "kill word forward")
;; Move to word "word".
(goto-char 6)
(kmacro-call-macro nil nil nil
[
;; kill-word
C-delete
;; undo
67108911
])
(point)))
(ert-deftest undo-point-in-wrong-place ()
(should
;; returns 5 with the bug
(= 2
(undo-test-kill-c-a-then-undo)))
(should
(= 6
(undo-test-point-after-forward-kill))))
(defmacro simple-test-undo-with-switched-buffer (buffer &rest body)
(declare (indent 1) (debug t))
(let ((before-buffer (make-symbol "before-buffer")))
`(let ((,before-buffer (current-buffer)))
(unwind-protect
(progn
(switch-to-buffer ,buffer)
,@body)
(switch-to-buffer ,before-buffer)))))
;; This tests for a regression in emacs 25.0 see bug #23632
(ert-deftest simple-test-undo-extra-boundary-in-tex ()
(should
(string=
""
(simple-test-undo-with-switched-buffer
"temp.tex"
(latex-mode)
;; This macro calls `latex-insert-block'
(execute-kbd-macro
(read-kbd-macro
"
C-c C-o ;; latex-insert-block
RET ;; newline
C-/ ;; undo
"
))
(buffer-substring-no-properties
(point-min)
(point-max))))))
(ert-deftest missing-record-point-in-undo ()
"Check point is being restored correctly.
See Bug#21722."
(should
(= 5
(with-temp-buffer
(generate-new-buffer " *temp*")
(emacs-lisp-mode)
(setq buffer-undo-list nil)
(insert "(progn (end-of-line) (insert \"hello\"))")
(beginning-of-line)
(forward-char 4)
(undo-boundary)
(eval-defun nil)
(undo-boundary)
(undo)
(point)))))
;;; `eval-expression'
(ert-deftest eval-expression-print-format-sym ()
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
(let ((current-prefix-arg '(4)))
(call-interactively #'eval-expression)
(should (equal (buffer-string) "t"))))))
(ert-deftest eval-expression-print-format-sym-echo ()
;; We can only check the echo area when running interactive.
(skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
(let ((current-prefix-arg nil))
(message nil)
(call-interactively #'eval-expression)
(should (equal (current-message) "t"))))))
(ert-deftest eval-expression-print-format-small-int ()
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?A)))
(let ((current-prefix-arg '(4)))
(erase-buffer)
(call-interactively #'eval-expression)
(should (equal (buffer-string) "65")))
(let ((current-prefix-arg 0))
(erase-buffer)
(call-interactively #'eval-expression)
(should (equal (buffer-string) "65 (#o101, #x41, ?A)"))))))
(ert-deftest eval-expression-print-format-small-int-echo ()
(skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?A)))
(let ((current-prefix-arg nil))
(message nil)
(call-interactively #'eval-expression)
(should (equal (current-message) "65 (#o101, #x41, ?A)"))))))
(ert-deftest eval-expression-print-format-large-int ()
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?B))
(eval-expression-print-maximum-character ?A))
(let ((current-prefix-arg '(4)))
(erase-buffer)
(call-interactively #'eval-expression)
(should (equal (buffer-string) "66")))
(let ((current-prefix-arg 0))
(erase-buffer)
(call-interactively #'eval-expression)
(should (equal (buffer-string) "66 (#o102, #x42)")))
(let ((current-prefix-arg -1))
(erase-buffer)
(call-interactively #'eval-expression)
(should (equal (buffer-string) "66 (#o102, #x42, ?B)"))))))
(ert-deftest eval-expression-print-format-large-int-echo ()
(skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?B))
(eval-expression-print-maximum-character ?A))
(let ((current-prefix-arg nil))
(message nil)
(call-interactively #'eval-expression)
(should (equal (current-message) "66 (#o102, #x42)")))
(let ((current-prefix-arg '-))
(message nil)
(call-interactively #'eval-expression)
(should (equal (current-message) "66 (#o102, #x42, ?B)"))))))
(ert-deftest command-execute-prune-command-history ()
"Check that Bug#31211 is fixed."
(let ((history-length 1)
(command-history ()))
(dotimes (_ (1+ history-length))
(command-execute "" t))
(should (= (length command-history) history-length))))
;;; `line-number-at-pos'
(ert-deftest line-number-at-pos-in-widen-buffer ()
(let ((target-line 3))
(with-temp-buffer
(insert "a\nb\nc\nd\n")
(goto-char (point-min))
(forward-line (1- target-line))
(should (equal (line-number-at-pos) target-line))
(should (equal (line-number-at-pos nil t) target-line)))))
(ert-deftest line-number-at-pos-in-narrow-buffer ()
(let ((target-line 3))
(with-temp-buffer
(insert "a\nb\nc\nd\n")
(goto-char (point-min))
(forward-line (1- target-line))
(narrow-to-region (pos-bol) (pos-eol))
(should (equal (line-number-at-pos) 1))
(should (equal (line-number-at-pos nil t) target-line)))))
(ert-deftest line-number-at-pos-keeps-restriction ()
(with-temp-buffer
(insert "a\nb\nc\nd\n")
(goto-char (point-min))
(forward-line 2)
(narrow-to-region (pos-bol) (pos-eol))
(should (equal (line-number-at-pos) 1))
(should (equal (line-number-at-pos nil t) 3))
(should (equal (line-number-at-pos) 1))))
(ert-deftest line-number-at-pos-keeps-point ()
(let (pos)
(with-temp-buffer
(insert "a\nb\nc\nd\n")
(goto-char (point-min))
(forward-line 2)
(setq pos (point))
(should (equal (line-number-at-pos) 3))
(should (equal (line-number-at-pos nil t) 3))
(should (equal pos (point))))))
(ert-deftest line-number-at-pos-when-passing-point ()
(with-temp-buffer
(insert "a\nb\nc\nd\n")
(should (equal (line-number-at-pos 1) 1))
(should (equal (line-number-at-pos 3) 2))
(should (equal (line-number-at-pos 5) 3))
(should (equal (line-number-at-pos 7) 4))))
;;; Auto fill.
(ert-deftest auto-fill-mode-no-break-before-length-of-fill-prefix ()
(with-temp-buffer
(setq-local fill-prefix " ")
(set-fill-column 5)
;; Shouldn't break after 'foo' (3 characters) when the next
;; line is indented >= to that, that wouldn't result in shorter
;; lines.
(insert "foo bar")
(do-auto-fill)
(should (string-equal (buffer-string) "foo bar"))))
;;; Shell command.
(ert-deftest simple-tests-async-shell-command-30280 ()
"Test for https://debbugs.gnu.org/30280 ."
(let* ((async-shell-command-buffer 'new-buffer)
(async-shell-command-display-buffer nil)
(base "name")
(first (buffer-name (generate-new-buffer base)))
(second (generate-new-buffer-name base))
;; `save-window-excursion' doesn't restore frame configurations.
(pop-up-frames nil)
(inhibit-message t)
(emacs (expand-file-name invocation-name invocation-directory)))
(skip-unless (file-executable-p emacs))
;; Let `shell-command' create the buffer as needed.
(kill-buffer first)
(unwind-protect
(save-window-excursion
;; One command has no output, the other does.
;; Removing the -eval argument also yields no output, but
;; then both commands exit simultaneously when
;; `accept-process-output' is called on the second command.
(dolist (form '("(sleep-for 8)" "(message \"\")"))
(async-shell-command (format "%s -Q -batch -eval '%s'"
emacs form)
first))
;; First command should neither have nor display output.
(let* ((buffer (get-buffer first))
(process (get-buffer-process buffer)))
(should (buffer-live-p buffer))
(should process)
(should (zerop (buffer-size buffer)))
(should (not (get-buffer-window buffer))))
;; Second command should both have and display output.
(let* ((buffer (get-buffer second))
(process (get-buffer-process buffer)))
(should (buffer-live-p buffer))
(should process)
(should (accept-process-output process 4 nil t))
(should (> (buffer-size buffer) 0))
(should (get-buffer-window buffer))))
(dolist (name (list first second))
(let* ((buffer (get-buffer name))
(process (and buffer (get-buffer-process buffer))))
(when process (delete-process process))
(when buffer (kill-buffer buffer)))))))
;;; Tests for shell-command-dont-erase-buffer
(defmacro with-shell-command-dont-erase-buffer (str output-buffer-is-current &rest body)
(declare (debug (sexp form body)) (indent 2))
(let ((command (make-symbol "command"))
(caller-buf (make-symbol "caller-buf"))
(output-buf (make-symbol "output-buf")))
`(let* ((,caller-buf (generate-new-buffer "caller-buf"))
(,output-buf (if ,output-buffer-is-current ,caller-buf
(generate-new-buffer "output-buf")))
(emacs (expand-file-name invocation-name invocation-directory))
(,command
(format "%s -Q --batch --eval %s"
emacs (shell-quote-argument (format "(princ %S)" ,str))))
(inhibit-message t))
(unwind-protect
;; Feature must work the same regardless how we specify the 2nd arg of `shell-command', ie,
;; as a buffer, buffer name (or t, if the output must go to the current buffer).
(dolist (output (append (list ,output-buf (buffer-name ,output-buf))
(if ,output-buffer-is-current '(t) nil)))
(dolist (save-pos '(erase nil beg-last-out end-last-out save-point))
(let ((shell-command-dont-erase-buffer save-pos))
(with-current-buffer ,output-buf (erase-buffer))
(with-current-buffer ,caller-buf
(dotimes (_ 2) (shell-command ,command output)))
(with-current-buffer ,output-buf
,@body))))
(kill-buffer ,caller-buf)
(when (buffer-live-p ,output-buf)
(kill-buffer ,output-buf))))))
(ert-deftest simple-tests-shell-command-39067 ()
"The output buffer is erased or not according to `shell-command-dont-erase-buffer'."
(let ((str "foo\\n"))
(dolist (output-current '(t nil))
(with-shell-command-dont-erase-buffer str output-current
(let ((expected (cond ((eq shell-command-dont-erase-buffer 'erase) str)
((null shell-command-dont-erase-buffer)
(if output-current (concat str str)
str))
(t (concat str str)))))
(should (string= expected (buffer-string))))))))
(ert-deftest simple-tests-shell-command-dont-erase-buffer ()
"The point is set at the expected position after execution of the command."
(let* ((str "foo\\n")
(expected-point `((beg-last-out . ,(1+ (length str)))
(end-last-out . ,(1+ (* 2 (length str))))
(save-point . 1)
(erase . ,(1+ (length str)))
(nil . ,(1+ (length str))))))
(dolist (output-buffer-is-current '(nil))
(with-shell-command-dont-erase-buffer str output-buffer-is-current
(should (= (point) (alist-get shell-command-dont-erase-buffer expected-point)))))))
(ert-deftest test-undo-region ()
(with-temp-buffer
(insert "This is a test\n")
(goto-char (point-min))
(setq buffer-undo-list nil)
(downcase-word 1)
(should (= (length (delq nil (undo-make-selective-list 1 9))) 2))
;; FIXME: These should give 0, but currently give 1.
;;(should (= (length (delq nil (undo-make-selective-list 4 9))) 0))
;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0))
(should (= (length (delq nil (undo-make-selective-list 6 9))) 0))))
(ert-deftest test-yank-in-context ()
(should
(equal
(with-temp-buffer
(sh-mode)
(insert "echo \"foo\"")
(kill-new "\"bar\"")
(goto-char 8)
(yank-in-context)
(buffer-string))
"echo \"f\\\"bar\\\"oo\""))
(should
(equal
(with-temp-buffer
(sh-mode)
(insert "echo \"foo\"")
(kill-new "'bar'")
(goto-char 8)
(yank-in-context)
(buffer-string))
"echo \"f'bar'oo\""))
(should
(equal
(with-temp-buffer
(sh-mode)
(insert "echo 'foo'")
(kill-new "'bar'")
(goto-char 8)
(yank-in-context)
(buffer-string))
"echo 'f'\\''bar'\\''oo'")))
;;; Tests for `zap-to-char'
(defmacro with-zap-to-char-test (original result &rest body)
(declare (indent 2) (debug (stringp stringp body)))
`(with-temp-buffer
(insert ,original)
(goto-char (point-min))
,@body
(should (equal (buffer-string) ,result))))
(ert-deftest simple-tests-zap-to-char ()
(with-zap-to-char-test "abcde" "de"
(zap-to-char 1 ?c))
(with-zap-to-char-test "abcde abc123" "123"
(zap-to-char 2 ?c))
(let ((case-fold-search t))
(with-zap-to-char-test "abcdeCXYZ" "deCXYZ"
(zap-to-char 1 ?C))
(with-zap-to-char-test "abcdeCXYZ" "XYZ"
(zap-to-char 1 ?C 'interactive))))
;;; Tests for `kill-whole-line'
(declare-function org-fold-hide-sublevels "org-fold" (levels))
(ert-deftest kill-whole-line-invisible ()
(cl-flet ((test (kill-whole-line-arg &rest expected-lines)
(ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ")
(ert-with-test-buffer-selected nil
(simple-test--set-buffer-text-point-mark
(string-join
'("* -2" "hidden"
"* -1" "hidden"
"* A<POINT>B" "hidden"
"* 1" "hidden"
"* 2" "hidden"
"")
"\n"))
(org-mode)
(org-fold-hide-sublevels 1)
(kill-whole-line kill-whole-line-arg)
(should
(equal (string-join expected-lines "\n")
(simple-test--get-buffer-text-point-mark)))))))
(test 0
"* -2" "hidden"
"* -1" "hidden"
"<POINT>"
"* 1" "hidden"
"* 2" "hidden"
"")
(test 1
"* -2" "hidden"
"* -1" "hidden"
"<POINT>* 1" "hidden"
"* 2" "hidden"
"")
(test 2
"* -2" "hidden"
"* -1" "hidden"
"<POINT>* 2" "hidden"
"")
(test 3
"* -2" "hidden"
"* -1" "hidden"
"<POINT>")
(test 9
"* -2" "hidden"
"* -1" "hidden"
"<POINT>")
(test -1
"* -2" "hidden"
"* -1" "hidden<POINT>"
"* 1" "hidden"
"* 2" "hidden"
"")
(test -2
"* -2" "hidden<POINT>"
"* 1" "hidden"
"* 2" "hidden"
"")
(test -3
"<POINT>"
"* 1" "hidden"
"* 2" "hidden"
"")
(test -9
"<POINT>"
"* 1" "hidden"
"* 2" "hidden"
"")))
(ert-deftest kill-whole-line-read-only ()
(cl-flet
((test (kill-whole-line-arg expected-kill-lines expected-buffer-lines)
(ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ")
(ert-with-test-buffer-selected nil
(simple-test--set-buffer-text-point-mark
(string-join '("-2" "-1" "A<POINT>B" "1" "2" "") "\n"))
(read-only-mode 1)
(setq last-command #'ignore)
(should-error (kill-whole-line kill-whole-line-arg)
:type 'buffer-read-only)
(should (equal (string-join expected-kill-lines "\n")
(car kill-ring)))
(should (equal (string-join expected-buffer-lines "\n")
(simple-test--get-buffer-text-point-mark)))))))
(test 0 '("AB") '("-2" "-1" "AB<POINT>" "1" "2" ""))
(test 1 '("AB" "") '("-2" "-1" "AB" "<POINT>1" "2" ""))
(test 2 '("AB" "1" "") '("-2" "-1" "AB" "1" "<POINT>2" ""))
(test 3 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>"))
(test 9 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>"))
(test -1 '("" "AB") '("-2" "-1<POINT>" "AB" "1" "2" ""))
(test -2 '("" "-1" "AB") '("-2<POINT>" "-1" "AB" "1" "2" ""))
(test -3 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" ""))
(test -9 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" ""))))
(ert-deftest kill-whole-line-after-other-kill ()
(ert-with-test-buffer-selected nil
(simple-test--set-buffer-text-point-mark "A<POINT>X<MARK>B")
(setq last-command #'ignore)
(kill-region (point) (mark))
(deactivate-mark 'force)
(setq last-command #'kill-region)
(kill-whole-line)
(should (equal "AXB" (car kill-ring)))
(should (equal "<POINT>"
(simple-test--get-buffer-text-point-mark)))))
(ert-deftest kill-whole-line-buffer-boundaries ()
(ert-with-test-buffer-selected nil
(ert-info ("0" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "<POINT>")
(should-error (kill-whole-line -1)
:type 'beginning-of-buffer)
(should-error (kill-whole-line 1)
:type 'end-of-buffer))
(ert-info ("1a" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\n<POINT>")
(should-error (kill-whole-line 1)
:type 'end-of-buffer))
(ert-info ("1b" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\nA<POINT>")
(setq last-command #'ignore)
(kill-whole-line 1)
(should (equal "-1\n<POINT>"
(simple-test--get-buffer-text-point-mark)))
(should (equal "A" (car kill-ring))))
(ert-info ("2" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "<POINT>\n1")
(should-error (kill-whole-line -1)
:type 'beginning-of-buffer))
(ert-info ("2b" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "<POINT>A\n1")
(setq last-command #'ignore)
(kill-whole-line 1)
(should (equal "<POINT>1"
(simple-test--get-buffer-text-point-mark)))
(should (equal "A\n" (car kill-ring))))))
(ert-deftest kill-whole-line-line-boundaries ()
(ert-with-test-buffer-selected nil
(ert-info ("1a" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n")
(setq last-command #'ignore)
(kill-whole-line 1)
(should (equal "-1\n<POINT>1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "\n" (car kill-ring))))
(ert-info ("1b" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n")
(setq last-command #'ignore)
(kill-whole-line -1)
(should (equal "-1<POINT>\n1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "\n" (car kill-ring))))
(ert-info ("2a" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n")
(setq last-command #'ignore)
(kill-whole-line 1)
(should (equal "-1\n<POINT>1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "A\n" (car kill-ring))))
(ert-info ("2b" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n")
(setq last-command #'ignore)
(kill-whole-line -1)
(should (equal "-1<POINT>\n1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "\nA" (car kill-ring))))
(ert-info ("3a" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n")
(setq last-command #'ignore)
(kill-whole-line 1)
(should (equal "-1\n<POINT>1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "A\n" (car kill-ring))))
(ert-info ("3b" :prefix "Subtest: ")
(simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n")
(setq last-command #'ignore)
(kill-whole-line -1)
(should (equal "-1<POINT>\n1\n"
(simple-test--get-buffer-text-point-mark)))
(should (equal "\nA" (car kill-ring))))))
(provide 'simple-test)
;;; simple-tests.el ends here
Reference in New Issue View Git Blame Copy Permalink