;;; simple-tests.el --- Tests for simple.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Artur Malabarba ;; 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 . ;;; 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 "") (defconst simple-test-mark-tag "") (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' (\"\") 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' (\"\"), 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" "* AB" "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" "" "* 1" "hidden" "* 2" "hidden" "") (test 1 "* -2" "hidden" "* -1" "hidden" "* 1" "hidden" "* 2" "hidden" "") (test 2 "* -2" "hidden" "* -1" "hidden" "* 2" "hidden" "") (test 3 "* -2" "hidden" "* -1" "hidden" "") (test 9 "* -2" "hidden" "* -1" "hidden" "") (test -1 "* -2" "hidden" "* -1" "hidden" "* 1" "hidden" "* 2" "hidden" "") (test -2 "* -2" "hidden" "* 1" "hidden" "* 2" "hidden" "") (test -3 "" "* 1" "hidden" "* 2" "hidden" "") (test -9 "" "* 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" "AB" "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" "1" "2" "")) (test 1 '("AB" "") '("-2" "-1" "AB" "1" "2" "")) (test 2 '("AB" "1" "") '("-2" "-1" "AB" "1" "2" "")) (test 3 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "")) (test 9 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "")) (test -1 '("" "AB") '("-2" "-1" "AB" "1" "2" "")) (test -2 '("" "-1" "AB") '("-2" "-1" "AB" "1" "2" "")) (test -3 '("-2" "-1" "AB") '("-2" "-1" "AB" "1" "2" "")) (test -9 '("-2" "-1" "AB") '("-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 "AXB") (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 "" (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 "") (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") (should-error (kill-whole-line 1) :type 'end-of-buffer)) (ert-info ("1b" :prefix "Subtest: ") (simple-test--set-buffer-text-point-mark "-1\nA") (setq last-command #'ignore) (kill-whole-line 1) (should (equal "-1\n" (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 "\n1") (should-error (kill-whole-line -1) :type 'beginning-of-buffer)) (ert-info ("2b" :prefix "Subtest: ") (simple-test--set-buffer-text-point-mark "A\n1") (setq last-command #'ignore) (kill-whole-line 1) (should (equal "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\n1\n") (setq last-command #'ignore) (kill-whole-line 1) (should (equal "-1\n1\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\n1\n") (setq last-command #'ignore) (kill-whole-line -1) (should (equal "-1\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\n1\n") (setq last-command #'ignore) (kill-whole-line 1) (should (equal "-1\n1\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\n1\n") (setq last-command #'ignore) (kill-whole-line -1) (should (equal "-1\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\nA\n1\n") (setq last-command #'ignore) (kill-whole-line 1) (should (equal "-1\n1\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\nA\n1\n") (setq last-command #'ignore) (kill-whole-line -1) (should (equal "-1\n1\n" (simple-test--get-buffer-text-point-mark))) (should (equal "\nA" (car kill-ring)))))) (provide 'simple-test) ;;; simple-tests.el ends here