test/lisp/simple-tests.el

   1 ;;; simple-test.el --- Tests for simple.el           -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015-2018 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 <https://www.gnu.org/licenses/>.
  19
  20 ;;; Code:
  21
  22 (require 'ert)
  23 (eval-when-compile (require 'cl-lib))
  24
  25 (defmacro simple-test--dummy-buffer (&rest body)
  26   (declare (indent 0)
  27            (debug t))
  28   `(with-temp-buffer
  29      (emacs-lisp-mode)
  30      (setq indent-tabs-mode nil)
  31      (insert "(a b")
  32      (save-excursion (insert " c d)"))
  33      ,@body
  34      (with-no-warnings
  35        (cons (buffer-substring (point-min) (point))
  36              (buffer-substring (point) (point-max))))))
  37
  38
  39 \f
  40 ;;; `transpose-sexps'
  41 (defmacro simple-test--transpositions (&rest body)
  42   (declare (indent 0)
  43            (debug t))
  44   `(with-temp-buffer
  45      (emacs-lisp-mode)
  46      (insert "(s1) (s2) (s3) (s4) (s5)")
  47      (backward-sexp 1)
  48      ,@body
  49      (cons (buffer-substring (point-min) (point))
  50            (buffer-substring (point) (point-max)))))
  51
  52 ;;; Transposition with negative args (bug#20698, bug#21885)
  53 (ert-deftest simple-transpose-subr ()
  54   (should (equal (simple-test--transpositions (transpose-sexps -1))
  55                  '("(s1) (s2) (s4)" . " (s3) (s5)")))
  56   (should (equal (simple-test--transpositions (transpose-sexps -2))
  57                  '("(s1) (s4)" . " (s2) (s3) (s5)"))))
  58
  59 \f
  60 ;;; `newline'
  61 (ert-deftest newline ()
  62   (should-error (newline -1))
  63   (should (equal (simple-test--dummy-buffer (newline 1))
  64                  '("(a b\n" . " c d)")))
  65   (should (equal (simple-test--dummy-buffer
  66                    (electric-indent-mode -1)
  67                    (call-interactively #'newline))
  68                  '("(a b\n" . " c d)")))
  69   (should (equal (simple-test--dummy-buffer
  70                    (let ((current-prefix-arg 5))
  71                      (call-interactively #'newline)))
  72                  '("(a b\n\n\n\n\n" . " c d)")))
  73   (should (equal (simple-test--dummy-buffer (newline 5))
  74                  '("(a b\n\n\n\n\n" . " c d)")))
  75   (should (equal (simple-test--dummy-buffer
  76                    (forward-char 1)
  77                    (newline 1))
  78                  '("(a b \n" . "c d)"))))
  79
  80 (ert-deftest newline-indent ()
  81   (should (equal (simple-test--dummy-buffer
  82                    (electric-indent-local-mode 1)
  83                    (newline 1))
  84                  '("(a b\n" . " c d)")))
  85   (should (equal (simple-test--dummy-buffer
  86                    (electric-indent-local-mode 1)
  87                    (newline 1 'interactive))
  88                  '("(a b\n   " . "c d)")))
  89   (should (equal (simple-test--dummy-buffer
  90                    (electric-indent-local-mode 1)
  91                    (let ((current-prefix-arg nil))
  92                      (call-interactively #'newline)
  93                      (call-interactively #'newline)))
  94                  '("(a b\n\n   " . "c d)")))
  95   (should (equal (simple-test--dummy-buffer
  96                    (electric-indent-local-mode 1)
  97                    (newline 5 'interactive))
  98                  '("(a b\n\n\n\n\n   " . "c d)")))
  99   (should (equal (simple-test--dummy-buffer
 100                    (electric-indent-local-mode 1)
 101                    (let ((current-prefix-arg 5))
 102                      (call-interactively #'newline)))
 103                  '("(a b\n\n\n\n\n   " . "c d)")))
 104   (should (equal (simple-test--dummy-buffer
 105                    (forward-char 1)
 106                    (electric-indent-local-mode 1)
 107                    (newline 1 'interactive))
 108                  '("(a b\n   " . "c d)"))))
 109
 110 \f
 111 ;;; `open-line'
 112 (ert-deftest open-line ()
 113   (should-error (open-line -1))
 114   (should-error (open-line))
 115   (should (equal (simple-test--dummy-buffer (open-line 1))
 116                  '("(a b" . "\n c d)")))
 117   (should (equal (simple-test--dummy-buffer
 118                    (electric-indent-mode -1)
 119                    (call-interactively #'open-line))
 120                  '("(a b" . "\n c d)")))
 121   (should (equal (simple-test--dummy-buffer
 122                    (let ((current-prefix-arg 5))
 123                      (call-interactively #'open-line)))
 124                  '("(a b" . "\n\n\n\n\n c d)")))
 125   (should (equal (simple-test--dummy-buffer (open-line 5))
 126                  '("(a b" . "\n\n\n\n\n c d)")))
 127   (should (equal (simple-test--dummy-buffer
 128                    (forward-char 1)
 129                    (open-line 1))
 130                  '("(a b " . "\nc d)"))))
 131
 132 (ert-deftest open-line-margin-and-prefix ()
 133   (should (equal (simple-test--dummy-buffer
 134                    (let ((left-margin 10))
 135                      (open-line 3)))
 136                  '("(a b" . "\n\n\n          c d)")))
 137   (should (equal (simple-test--dummy-buffer
 138                    (forward-line 0)
 139                    (let ((left-margin 2))
 140                      (open-line 1)))
 141                  '("  " . "\n  (a b c d)")))
 142   (should (equal (simple-test--dummy-buffer
 143                    (let ((fill-prefix "- - "))
 144                      (open-line 1)))
 145                  '("(a b" . "\n c d)")))
 146   (should (equal (simple-test--dummy-buffer
 147                    (forward-line 0)
 148                    (let ((fill-prefix "- - "))
 149                      (open-line 1)))
 150                  '("- - " . "\n(a b c d)"))))
 151
 152 ;; For a while, from 24 Oct - 21 Nov 2015, `open-line' in the Emacs
 153 ;; development tree became sensitive to `electric-indent-mode', which
 154 ;; it had not been before.  This sensitivity was reverted for the
 155 ;; Emacs 25 release, so it could be discussed further (see thread
 156 ;; "Questioning the new behavior of `open-line'." on the Emacs Devel
 157 ;; mailing list, and bug #21884).
 158 (ert-deftest open-line-indent ()
 159   (should (equal (simple-test--dummy-buffer
 160                    (electric-indent-local-mode 1)
 161                    (open-line 1))
 162                  '("(a b" . "\n c d)")))
 163   (should (equal (simple-test--dummy-buffer
 164                    (electric-indent-local-mode 1)
 165                    (open-line 1))
 166                  '("(a b" . "\n c d)")))
 167   (should (equal (simple-test--dummy-buffer
 168                    (electric-indent-local-mode 1)
 169                    (let ((current-prefix-arg nil))
 170                      (call-interactively #'open-line)
 171                      (call-interactively #'open-line)))
 172                  '("(a b" . "\n\n c d)")))
 173   (should (equal (simple-test--dummy-buffer
 174                    (electric-indent-local-mode 1)
 175                    (open-line 5))
 176                  '("(a b" . "\n\n\n\n\n c d)")))
 177   (should (equal (simple-test--dummy-buffer
 178                    (electric-indent-local-mode 1)
 179                    (let ((current-prefix-arg 5))
 180                      (call-interactively #'open-line)))
 181                  '("(a b" . "\n\n\n\n\n c d)")))
 182   (should (equal (simple-test--dummy-buffer
 183                    (forward-char 1)
 184                    (electric-indent-local-mode 1)
 185                    (open-line 1))
 186                  '("(a b " . "\nc d)"))))
 187
 188 ;; From 24 Oct - 21 Nov 2015, `open-line' took a second argument
 189 ;; INTERACTIVE and ran `post-self-insert-hook' if the argument was
 190 ;; true.  This test tested that.  Currently, however, `open-line'
 191 ;; does not run `post-self-insert-hook' at all, so for now
 192 ;; this test just makes sure that it doesn't.
 193 (ert-deftest open-line-hook ()
 194   (let* ((x 0)
 195          (inc (lambda () (setq x (1+ x)))))
 196     (simple-test--dummy-buffer
 197       (add-hook 'post-self-insert-hook inc nil 'local)
 198       (open-line 1))
 199     (should (= x 0))
 200     (simple-test--dummy-buffer
 201       (add-hook 'post-self-insert-hook inc nil 'local)
 202       (open-line 1))
 203     (should (= x 0))
 204
 205     (unwind-protect
 206         (progn
 207           (add-hook 'post-self-insert-hook inc)
 208           (simple-test--dummy-buffer
 209             (open-line 1))
 210           (should (= x 0))
 211           (simple-test--dummy-buffer
 212             (open-line 10))
 213           (should (= x 0)))
 214       (remove-hook 'post-self-insert-hook inc))))
 215
 216 \f
 217 ;;; `delete-trailing-whitespace'
 218 (ert-deftest simple-delete-trailing-whitespace--bug-21766 ()
 219   "Test bug#21766: delete-whitespace sometimes deletes non-whitespace."
 220   (defvar python-indent-guess-indent-offset)  ; to avoid a warning
 221   (let ((python (featurep 'python))
 222         (python-indent-guess-indent-offset nil)
 223         (delete-trailing-lines t))
 224     (unwind-protect
 225         (with-temp-buffer
 226           (python-mode)
 227           (insert (concat "query = \"\"\"WITH filtered AS \n"
 228                           "WHERE      \n"
 229                           "\"\"\".format(fv_)\n"
 230                           "\n"
 231                           "\n"))
 232           (delete-trailing-whitespace)
 233           (should (string-equal (buffer-string)
 234                                 (concat "query = \"\"\"WITH filtered AS\n"
 235                                         "WHERE\n"
 236                                         "\"\"\".format(fv_)\n"))))
 237       ;; Let's clean up if running interactive
 238       (unless (or noninteractive python)
 239         (unload-feature 'python)))))
 240
 241 (ert-deftest simple-delete-trailing-whitespace--formfeeds ()
 242   "Test formfeeds are not deleted but whitespace past them is."
 243   (with-temp-buffer
 244     (with-syntax-table (make-syntax-table)
 245       (modify-syntax-entry ?\f " ")     ; Make sure \f is whitespace
 246       (insert " \f \n \f \f \n\nlast\n")
 247       (delete-trailing-whitespace)
 248       (should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n"))
 249       (should (equal ?\s (char-syntax ?\f)))
 250       (should (equal ?\s (char-syntax ?\n))))))
 251
 252 \f
 253 ;;; undo auto-boundary tests
 254 (ert-deftest undo-auto-boundary-timer ()
 255   (should
 256    undo-auto-current-boundary-timer))
 257
 258 (ert-deftest undo-auto--boundaries-added ()
 259   ;; The change in the buffer should have caused addition
 260   ;; to undo-auto--undoably-changed-buffers.
 261   (should
 262    (with-temp-buffer
 263      (setq buffer-undo-list nil)
 264      (insert "hello")
 265      (member (current-buffer) undo-auto--undoably-changed-buffers)))
 266   ;; The head of buffer-undo-list should be the insertion event, and
 267   ;; therefore not nil
 268   (should
 269    (with-temp-buffer
 270      (setq buffer-undo-list nil)
 271      (insert "hello")
 272      (car buffer-undo-list)))
 273   ;; Now the head of the buffer-undo-list should be a boundary and so
 274   ;; nil. We have to call auto-boundary explicitly because we are out
 275   ;; of the command loop
 276   (should-not
 277    (with-temp-buffer
 278      (setq buffer-undo-list nil)
 279      (insert "hello")
 280      (undo-auto--boundaries 'test))))
 281
 282 ;; Test for a regression introduced by undo-auto--boundaries changes.
 283 ;; https://lists.gnu.org/r/emacs-devel/2015-11/msg01652.html
 284 (defun undo-test-kill-c-a-then-undo ()
 285   (with-temp-buffer
 286     (switch-to-buffer (current-buffer))
 287     (setq buffer-undo-list nil)
 288     (insert "a\nb\n\c\n")
 289     (goto-char (point-max))
 290     ;; We use a keyboard macro because it adds undo events in the same
 291     ;; way as if a user were involved.
 292     (kmacro-call-macro nil nil nil
 293                        [left
 294                         ;; Delete "c"
 295                         backspace
 296                         left left left
 297                         ;; Delete "a"
 298                         backspace
 299                         ;; C-/ or undo
 300                         67108911
 301                         ])
 302     (point)))
 303
 304 (defun undo-test-point-after-forward-kill ()
 305   (with-temp-buffer
 306     (switch-to-buffer (current-buffer))
 307     (setq buffer-undo-list nil)
 308     (insert "kill word forward")
 309     ;; Move to word "word".
 310     (goto-char 6)
 311     (kmacro-call-macro nil nil nil
 312                        [
 313                         ;; kill-word
 314                         C-delete
 315                         ;; undo
 316                         67108911
 317                         ])
 318     (point)))
 319
 320 (ert-deftest undo-point-in-wrong-place ()
 321   (should
 322    ;; returns 5 with the bug
 323    (= 2
 324       (undo-test-kill-c-a-then-undo)))
 325   (should
 326    (= 6
 327       (undo-test-point-after-forward-kill))))
 328
 329 (defmacro simple-test-undo-with-switched-buffer (buffer &rest body)
 330   (declare (indent 1) (debug t))
 331   (let ((before-buffer (make-symbol "before-buffer")))
 332     `(let ((,before-buffer (current-buffer)))
 333        (unwind-protect
 334            (progn
 335              (switch-to-buffer ,buffer)
 336              ,@body)
 337          (switch-to-buffer ,before-buffer)))))
 338
 339 ;; This tests for a regression in emacs 25.0 see bug #23632
 340 (ert-deftest simple-test-undo-extra-boundary-in-tex ()
 341   (should
 342    (string=
 343     ""
 344     (simple-test-undo-with-switched-buffer
 345         "temp.tex"
 346       (latex-mode)
 347       ;; This macro calls `latex-insert-block'
 348       (execute-kbd-macro
 349        (read-kbd-macro
 350         "
 351 C-c C-o                 ;; latex-insert-block
 352 RET                     ;; newline
 353 C-/                     ;; undo
 354 "
 355         ))
 356       (buffer-substring-no-properties
 357        (point-min)
 358        (point-max))))))
 359
 360 (ert-deftest missing-record-point-in-undo ()
 361   "Check point is being restored correctly.
 362
 363 See Bug#21722."
 364   (should
 365    (= 5
 366       (with-temp-buffer
 367        (generate-new-buffer " *temp*")
 368        (emacs-lisp-mode)
 369        (setq buffer-undo-list nil)
 370        (insert "(progn (end-of-line) (insert \"hello\"))")
 371        (beginning-of-line)
 372        (forward-char 4)
 373        (undo-boundary)
 374        (eval-defun nil)
 375        (undo-boundary)
 376        (undo)
 377        (point)))))
 378
 379 \f
 380 ;;; `eval-expression'
 381
 382 (ert-deftest eval-expression-print-format-sym ()
 383   (with-temp-buffer
 384     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
 385       (let ((current-prefix-arg '(4)))
 386         (call-interactively #'eval-expression)
 387         (should (equal (buffer-string) "t"))))))
 388
 389 (ert-deftest eval-expression-print-format-sym-echo ()
 390   ;; We can only check the echo area when running interactive.
 391   (skip-unless (not noninteractive))
 392   (with-temp-buffer
 393     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
 394       (let ((current-prefix-arg nil))
 395         (message nil)
 396         (call-interactively #'eval-expression)
 397         (should (equal (current-message) "t"))))))
 398
 399 (ert-deftest eval-expression-print-format-small-int ()
 400   (with-temp-buffer
 401     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?A)))
 402       (let ((current-prefix-arg '(4)))
 403         (erase-buffer)
 404         (call-interactively #'eval-expression)
 405         (should (equal (buffer-string) "65")))
 406       (let ((current-prefix-arg 0))
 407         (erase-buffer)
 408         (call-interactively #'eval-expression)
 409         (should (equal (buffer-string) "65 (#o101, #x41, ?A)"))))))
 410
 411 (ert-deftest eval-expression-print-format-small-int-echo ()
 412   (skip-unless (not noninteractive))
 413   (with-temp-buffer
 414     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?A)))
 415       (let ((current-prefix-arg nil))
 416         (message nil)
 417         (call-interactively #'eval-expression)
 418         (should (equal (current-message) "65 (#o101, #x41, ?A)"))))))
 419
 420 (ert-deftest eval-expression-print-format-large-int ()
 421   (with-temp-buffer
 422     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?B))
 423               (eval-expression-print-maximum-character ?A))
 424       (let ((current-prefix-arg '(4)))
 425         (erase-buffer)
 426         (call-interactively #'eval-expression)
 427         (should (equal (buffer-string) "66")))
 428       (let ((current-prefix-arg 0))
 429         (erase-buffer)
 430         (call-interactively #'eval-expression)
 431         (should (equal (buffer-string) "66 (#o102, #x42)")))
 432       (let ((current-prefix-arg -1))
 433         (erase-buffer)
 434         (call-interactively #'eval-expression)
 435         (should (equal (buffer-string) "66 (#o102, #x42, ?B)"))))))
 436
 437 (ert-deftest eval-expression-print-format-large-int-echo ()
 438   (skip-unless (not noninteractive))
 439   (with-temp-buffer
 440     (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?B))
 441               (eval-expression-print-maximum-character ?A))
 442       (let ((current-prefix-arg nil))
 443         (message nil)
 444         (call-interactively #'eval-expression)
 445         (should (equal (current-message) "66 (#o102, #x42)")))
 446       (let ((current-prefix-arg '-))
 447         (message nil)
 448         (call-interactively #'eval-expression)
 449         (should (equal (current-message) "66 (#o102, #x42, ?B)"))))))
 450
 451 (ert-deftest command-execute-prune-command-history ()
 452   "Check that Bug#31211 is fixed."
 453   (let ((history-length 1)
 454         (command-history ()))
 455     (dotimes (_ (1+ history-length))
 456       (command-execute "" t))
 457     (should (= (length command-history) history-length))))
 458
 459 \f
 460 ;;; `line-number-at-pos'
 461
 462 (ert-deftest line-number-at-pos-in-widen-buffer ()
 463   (let ((target-line 3))
 464     (with-temp-buffer
 465       (insert "a\nb\nc\nd\n")
 466       (goto-char (point-min))
 467       (forward-line (1- target-line))
 468       (should (equal (line-number-at-pos) target-line))
 469       (should (equal (line-number-at-pos nil t) target-line)))))
 470
 471 (ert-deftest line-number-at-pos-in-narrow-buffer ()
 472   (let ((target-line 3))
 473     (with-temp-buffer
 474       (insert "a\nb\nc\nd\n")
 475       (goto-char (point-min))
 476       (forward-line (1- target-line))
 477       (narrow-to-region (line-beginning-position) (line-end-position))
 478       (should (equal (line-number-at-pos) 1))
 479       (should (equal (line-number-at-pos nil t) target-line)))))
 480
 481 (ert-deftest line-number-at-pos-keeps-restriction ()
 482   (with-temp-buffer
 483     (insert "a\nb\nc\nd\n")
 484     (goto-char (point-min))
 485     (forward-line 2)
 486     (narrow-to-region (line-beginning-position) (line-end-position))
 487     (should (equal (line-number-at-pos) 1))
 488     (line-number-at-pos nil t)
 489     (should (equal (line-number-at-pos) 1))))
 490
 491 (ert-deftest line-number-at-pos-keeps-point ()
 492   (let (pos)
 493     (with-temp-buffer
 494       (insert "a\nb\nc\nd\n")
 495       (goto-char (point-min))
 496       (forward-line 2)
 497       (setq pos (point))
 498       (line-number-at-pos)
 499       (line-number-at-pos nil t)
 500       (should (equal pos (point))))))
 501
 502 (ert-deftest line-number-at-pos-when-passing-point ()
 503   (with-temp-buffer
 504     (insert "a\nb\nc\nd\n")
 505     (should (equal (line-number-at-pos 1) 1))
 506     (should (equal (line-number-at-pos 3) 2))
 507     (should (equal (line-number-at-pos 5) 3))
 508     (should (equal (line-number-at-pos 7) 4))))
 509
 510 \f
 511 ;;; Auto fill.
 512
 513 (ert-deftest auto-fill-mode-no-break-before-length-of-fill-prefix ()
 514   (with-temp-buffer
 515     (setq-local fill-prefix "   ")
 516     (set-fill-column 5)
 517     ;; Shouldn't break after 'foo' (3 characters) when the next
 518     ;; line is indented >= to that, that wouldn't result in shorter
 519     ;; lines.
 520     (insert "foo bar")
 521     (do-auto-fill)
 522     (should (string-equal (buffer-string) "foo bar"))))
 523
 524 \f
 525 ;;; Shell command.
 526
 527 (ert-deftest simple-tests-async-shell-command-30280 ()
 528   "Test for https://debbugs.gnu.org/30280 ."
 529   (let* ((async-shell-command-buffer 'new-buffer)
 530          (async-shell-command-display-buffer nil)
 531          (base "name")
 532          (first (buffer-name (generate-new-buffer base)))
 533          (second (generate-new-buffer-name base))
 534          ;; `save-window-excursion' doesn't restore frame configurations.
 535          (pop-up-frames nil)
 536          (inhibit-message t)
 537          (emacs (expand-file-name invocation-name invocation-directory)))
 538     (skip-unless (file-executable-p emacs))
 539     ;; Let `shell-command' create the buffer as needed.
 540     (kill-buffer first)
 541     (unwind-protect
 542         (save-window-excursion
 543           ;; One command has no output, the other does.
 544           ;; Removing the -eval argument also yields no output, but
 545           ;; then both commands exit simultaneously when
 546           ;; `accept-process-output' is called on the second command.
 547           (dolist (form '("(sleep-for 8)" "(message \"\")"))
 548             (async-shell-command (format "%s -Q -batch -eval '%s'"
 549                                          emacs form)
 550                                  first))
 551           ;; First command should neither have nor display output.
 552           (let* ((buffer (get-buffer first))
 553                  (process (get-buffer-process buffer)))
 554             (should (buffer-live-p buffer))
 555             (should process)
 556             (should (zerop (buffer-size buffer)))
 557             (should (not (get-buffer-window buffer))))
 558           ;; Second command should both have and display output.
 559           (let* ((buffer (get-buffer second))
 560                  (process (get-buffer-process buffer)))
 561             (should (buffer-live-p buffer))
 562             (should process)
 563             (should (accept-process-output process 4 nil t))
 564             (should (> (buffer-size buffer) 0))
 565             (should (get-buffer-window buffer))))
 566       (dolist (name (list first second))
 567         (let* ((buffer (get-buffer name))
 568                (process (and buffer (get-buffer-process buffer))))
 569           (when process (delete-process process))
 570           (when buffer (kill-buffer buffer)))))))
 571
 572 (provide 'simple-test)
 573 ;;; simple-test.el ends here