code.delx.au - gnu-emacs/blob - test/lisp/simple-tests.el

   1 ;;; simple-test.el --- Tests for simple.el           -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Code:
  21
  22 (require 'ert)
  23
  24 (defmacro simple-test--dummy-buffer (&rest body)
  25   (declare (indent 0)
  26            (debug t))
  27   `(with-temp-buffer
  28      (emacs-lisp-mode)
  29      (setq indent-tabs-mode nil)
  30      (insert "(a b")
  31      (save-excursion (insert " c d)"))
  32      ,@body
  33      (cons (buffer-substring (point-min) (point))
  34            (buffer-substring (point) (point-max)))))
  35
  36
  37 (defmacro simple-test--transpositions (&rest body)
  38   (declare (indent 0)
  39            (debug t))
  40   `(with-temp-buffer
  41      (emacs-lisp-mode)
  42      (insert "(s1) (s2) (s3) (s4) (s5)")
  43      (backward-sexp 1)
  44      ,@body
  45      (cons (buffer-substring (point-min) (point))
  46            (buffer-substring (point) (point-max)))))
  47
  48 \f
  49 ;;; `newline'
  50 (ert-deftest newline ()
  51   (should-error (newline -1))
  52   (should (equal (simple-test--dummy-buffer (newline 1))
  53                  '("(a b\n" . " c d)")))
  54   (should (equal (simple-test--dummy-buffer
  55                    (electric-indent-mode -1)
  56                    (call-interactively #'newline))
  57                  '("(a b\n" . " c d)")))
  58   (should (equal (simple-test--dummy-buffer
  59                    (let ((current-prefix-arg 5))
  60                      (call-interactively #'newline)))
  61                  '("(a b\n\n\n\n\n" . " c d)")))
  62   (should (equal (simple-test--dummy-buffer (newline 5))
  63                  '("(a b\n\n\n\n\n" . " c d)")))
  64   (should (equal (simple-test--dummy-buffer
  65                    (forward-char 1)
  66                    (newline 1))
  67                  '("(a b \n" . "c d)"))))
  68
  69 (ert-deftest newline-indent ()
  70   (should (equal (simple-test--dummy-buffer
  71                    (electric-indent-local-mode 1)
  72                    (newline 1))
  73                  '("(a b\n" . " c d)")))
  74   (should (equal (simple-test--dummy-buffer
  75                    (electric-indent-local-mode 1)
  76                    (newline 1 'interactive))
  77                  '("(a b\n   " . "c d)")))
  78   (should (equal (simple-test--dummy-buffer
  79                    (electric-indent-local-mode 1)
  80                    (let ((current-prefix-arg nil))
  81                      (call-interactively #'newline)
  82                      (call-interactively #'newline)))
  83                  '("(a b\n\n   " . "c d)")))
  84   (should (equal (simple-test--dummy-buffer
  85                    (electric-indent-local-mode 1)
  86                    (newline 5 'interactive))
  87                  '("(a b\n\n\n\n\n   " . "c d)")))
  88   (should (equal (simple-test--dummy-buffer
  89                    (electric-indent-local-mode 1)
  90                    (let ((current-prefix-arg 5))
  91                      (call-interactively #'newline)))
  92                  '("(a b\n\n\n\n\n   " . "c d)")))
  93   (should (equal (simple-test--dummy-buffer
  94                    (forward-char 1)
  95                    (electric-indent-local-mode 1)
  96                    (newline 1 'interactive))
  97                  '("(a b\n   " . "c d)"))))
  98
  99 \f
 100 ;;; `open-line'
 101 (ert-deftest open-line ()
 102   (should-error (open-line -1))
 103   (should-error (open-line))
 104   (should (equal (simple-test--dummy-buffer (open-line 1))
 105                  '("(a b" . "\n c d)")))
 106   (should (equal (simple-test--dummy-buffer
 107                    (electric-indent-mode -1)
 108                    (call-interactively #'open-line))
 109                  '("(a b" . "\n c d)")))
 110   (should (equal (simple-test--dummy-buffer
 111                    (let ((current-prefix-arg 5))
 112                      (call-interactively #'open-line)))
 113                  '("(a b" . "\n\n\n\n\n c d)")))
 114   (should (equal (simple-test--dummy-buffer (open-line 5))
 115                  '("(a b" . "\n\n\n\n\n c d)")))
 116   (should (equal (simple-test--dummy-buffer
 117                    (forward-char 1)
 118                    (open-line 1))
 119                  '("(a b " . "\nc d)"))))
 120
 121 (ert-deftest open-line-margin-and-prefix ()
 122   (should (equal (simple-test--dummy-buffer
 123                    (let ((left-margin 10))
 124                      (open-line 3)))
 125                  '("(a b" . "\n\n\n          c d)")))
 126   (should (equal (simple-test--dummy-buffer
 127                    (forward-line 0)
 128                    (let ((left-margin 2))
 129                      (open-line 1)))
 130                  '("  " . "\n  (a b c d)")))
 131   (should (equal (simple-test--dummy-buffer
 132                    (let ((fill-prefix "- - "))
 133                      (open-line 1)))
 134                  '("(a b" . "\n c d)")))
 135   (should (equal (simple-test--dummy-buffer
 136                    (forward-line 0)
 137                    (let ((fill-prefix "- - "))
 138                      (open-line 1)))
 139                  '("- - " . "\n(a b c d)"))))
 140
 141 ;; For a while, from 24 Oct - 21 Nov 2015, `open-line' in the Emacs
 142 ;; development tree became sensitive to `electric-indent-mode', which
 143 ;; it had not been before.  This sensitivity was reverted for the
 144 ;; Emacs 25 release, so it could be discussed further (see thread
 145 ;; "Questioning the new behavior of `open-line'." on the Emacs Devel
 146 ;; mailing list, and bug #21884).
 147 (ert-deftest open-line-indent ()
 148   (should (equal (simple-test--dummy-buffer
 149                    (electric-indent-local-mode 1)
 150                    (open-line 1))
 151                  '("(a b" . "\n c d)")))
 152   (should (equal (simple-test--dummy-buffer
 153                    (electric-indent-local-mode 1)
 154                    (open-line 1))
 155                  '("(a b" . "\n c d)")))
 156   (should (equal (simple-test--dummy-buffer
 157                    (electric-indent-local-mode 1)
 158                    (let ((current-prefix-arg nil))
 159                      (call-interactively #'open-line)
 160                      (call-interactively #'open-line)))
 161                  '("(a b" . "\n\n c d)")))
 162   (should (equal (simple-test--dummy-buffer
 163                    (electric-indent-local-mode 1)
 164                    (open-line 5))
 165                  '("(a b" . "\n\n\n\n\n c d)")))
 166   (should (equal (simple-test--dummy-buffer
 167                    (electric-indent-local-mode 1)
 168                    (let ((current-prefix-arg 5))
 169                      (call-interactively #'open-line)))
 170                  '("(a b" . "\n\n\n\n\n c d)")))
 171   (should (equal (simple-test--dummy-buffer
 172                    (forward-char 1)
 173                    (electric-indent-local-mode 1)
 174                    (open-line 1))
 175                  '("(a b " . "\nc d)"))))
 176
 177 ;; From 24 Oct - 21 Nov 2015, `open-line' took a second argument
 178 ;; INTERACTIVE and ran `post-self-insert-hook' if the argument was
 179 ;; true.  This test tested that.  Currently, however, `open-line'
 180 ;; does not run run `post-self-insert-hook' at all, so for now
 181 ;; this test just makes sure that it doesn't.
 182 (ert-deftest open-line-hook ()
 183   (let* ((x 0)
 184          (inc (lambda () (setq x (1+ x)))))
 185     (simple-test--dummy-buffer
 186       (add-hook 'post-self-insert-hook inc nil 'local)
 187       (open-line 1))
 188     (should (= x 0))
 189     (simple-test--dummy-buffer
 190       (add-hook 'post-self-insert-hook inc nil 'local)
 191       (open-line 1))
 192     (should (= x 0))
 193
 194     (unwind-protect
 195         (progn
 196           (add-hook 'post-self-insert-hook inc)
 197           (simple-test--dummy-buffer
 198             (open-line 1))
 199           (should (= x 0))
 200           (simple-test--dummy-buffer
 201             (open-line 10))
 202           (should (= x 0)))
 203       (remove-hook 'post-self-insert-hook inc))))
 204
 205 \f
 206 ;;; `delete-trailing-whitespace'
 207 (ert-deftest simple-delete-trailing-whitespace--bug-21766 ()
 208   "Test bug#21766: delete-whitespace sometimes deletes non-whitespace."
 209   (defvar python-indent-guess-indent-offset)  ; to avoid a warning
 210   (let ((python (featurep 'python))
 211         (python-indent-guess-indent-offset nil)
 212         (delete-trailing-lines t))
 213     (unwind-protect
 214         (with-temp-buffer
 215           (python-mode)
 216           (insert (concat "query = \"\"\"WITH filtered AS \n"
 217                           "WHERE      \n"
 218                           "\"\"\".format(fv_)\n"
 219                           "\n"
 220                           "\n"))
 221           (delete-trailing-whitespace)
 222           (should (string-equal (buffer-string)
 223                                 (concat "query = \"\"\"WITH filtered AS\n"
 224                                         "WHERE\n"
 225                                         "\"\"\".format(fv_)\n"))))
 226       ;; Let's clean up if running interactive
 227       (unless (or noninteractive python)
 228         (unload-feature 'python)))))
 229
 230 (ert-deftest simple-delete-trailing-whitespace--formfeeds ()
 231   "Test formfeeds are not deleted but whitespace past them is."
 232   (with-temp-buffer
 233     (with-syntax-table (make-syntax-table)
 234       (modify-syntax-entry ?\f " ")     ; Make sure \f is whitespace
 235       (insert " \f \n \f \f \n\nlast\n")
 236       (delete-trailing-whitespace)
 237       (should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n"))
 238       (should (equal ?\s (char-syntax ?\f)))
 239       (should (equal ?\s (char-syntax ?\n))))))
 240
 241
 242 ;;; auto-boundary tests
 243 (ert-deftest undo-auto-boundary-timer ()
 244   (should
 245    undo-auto-current-boundary-timer))
 246
 247 (ert-deftest undo-auto--boundaries-added ()
 248   ;; The change in the buffer should have caused addition
 249   ;; to undo-auto--undoably-changed-buffers.
 250   (should
 251    (with-temp-buffer
 252      (setq buffer-undo-list nil)
 253      (insert "hello")
 254      (member (current-buffer) undo-auto--undoably-changed-buffers)))
 255   ;; The head of buffer-undo-list should be the insertion event, and
 256   ;; therefore not nil
 257   (should
 258    (with-temp-buffer
 259      (setq buffer-undo-list nil)
 260      (insert "hello")
 261      (car buffer-undo-list)))
 262   ;; Now the head of the buffer-undo-list should be a boundary and so
 263   ;; nil. We have to call auto-boundary explicitly because we are out
 264   ;; of the command loop
 265   (should-not
 266    (with-temp-buffer
 267      (setq buffer-undo-list nil)
 268      (insert "hello")
 269      (car buffer-undo-list)
 270      (undo-auto--boundaries 'test))))
 271
 272 ;;; Transposition with negative args (bug#20698, bug#21885)
 273 (ert-deftest simple-transpose-subr ()
 274   (should (equal (simple-test--transpositions (transpose-sexps -1))
 275                  '("(s1) (s2) (s4)" . " (s3) (s5)")))
 276   (should (equal (simple-test--transpositions (transpose-sexps -2))
 277                  '("(s1) (s4)" . " (s2) (s3) (s5)"))))
 278
 279
 280 ;; Test for a regression introduced by undo-auto--boundaries changes.
 281 ;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01652.html
 282 (defun undo-test-kill-c-a-then-undo ()
 283   (with-temp-buffer
 284     (switch-to-buffer (current-buffer))
 285     (setq buffer-undo-list nil)
 286     (insert "a\nb\n\c\n")
 287     (goto-char (point-max))
 288     ;; We use a keyboard macro because it adds undo events in the same
 289     ;; way as if a user were involved.
 290     (kmacro-call-macro nil nil nil
 291                        [left
 292                         ;; Delete "c"
 293                         backspace
 294                         left left left
 295                         ;; Delete "a"
 296                         backspace
 297                         ;; C-/ or undo
 298                         67108911
 299                         ])
 300     (point)))
 301
 302 (defun undo-test-point-after-forward-kill ()
 303   (with-temp-buffer
 304     (switch-to-buffer (current-buffer))
 305     (setq buffer-undo-list nil)
 306     (insert "kill word forward")
 307     ;; Move to word "word".
 308     (goto-char 6)
 309     (kmacro-call-macro nil nil nil
 310                        [
 311                         ;; kill-word
 312                         C-delete
 313                         ;; undo
 314                         67108911
 315                         ])
 316     (point)))
 317
 318 (ert-deftest undo-point-in-wrong-place ()
 319   (should
 320    ;; returns 5 with the bug
 321    (= 2
 322       (undo-test-kill-c-a-then-undo)))
 323   (should
 324    (= 6
 325       (undo-test-point-after-forward-kill))))
 326
 327 (defmacro simple-test-undo-with-switched-buffer (buffer &rest body)
 328   (let ((before-buffer (make-symbol "before-buffer")))
 329     `(let ((,before-buffer (current-buffer)))
 330        (unwind-protect
 331            (progn
 332              (switch-to-buffer ,buffer)
 333              ,@body)
 334          (switch-to-buffer ,before-buffer)))))
 335
 336 ;; This tests for a regression in emacs 25.0 see bug #23632
 337 (ert-deftest simple-test-undo-extra-boundary-in-tex ()
 338   (should
 339    (string=
 340     ""
 341     (simple-test-undo-with-switched-buffer
 342         "temp.tex"
 343       (latex-mode)
 344       ;; This macro calls `latex-insert-block'
 345       (execute-kbd-macro
 346        (read-kbd-macro
 347         "
 348 C-c C-o                 ;; latex-insert-block
 349 RET                     ;; newline
 350 C-/                     ;; undo
 351 "
 352         ))
 353       (buffer-substring-no-properties
 354        (point-min)
 355        (point-max))))))
 356
 357
 358
 359
 360 (provide 'simple-test)
 361 ;;; simple-test.el ends here