test/automated/ert-x-tests.el

   1 ;;; ert-x-tests.el --- Tests for ert-x.el
   2
   3 ;; Copyright (C) 2008, 2010-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Phil Hagelberg
   6 ;;         Christian Ohler <ohler@gnu.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; This program is free software: you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation, either version 3 of the
  13 ;; License, or (at your option) any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  22
  23 ;;; Commentary:
  24
  25 ;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
  26 ;; See ert.el or the texinfo manual for more details.
  27
  28 ;;; Code:
  29
  30 (eval-when-compile
  31   (require 'cl-lib))
  32 (require 'ert)
  33 (require 'ert-x)
  34
  35 ;;; Utilities
  36
  37 (ert-deftest ert-test-buffer-string-reindented ()
  38   (ert-with-test-buffer (:name "well-indented")
  39     (insert (concat "(hello (world\n"
  40                     "        'elisp)\n"))
  41     (emacs-lisp-mode)
  42     (should (equal (ert-buffer-string-reindented) (buffer-string))))
  43   (ert-with-test-buffer (:name "badly-indented")
  44     (insert (concat "(hello\n"
  45                     "       world)"))
  46     (emacs-lisp-mode)
  47     (should-not (equal (ert-buffer-string-reindented) (buffer-string)))))
  48
  49 (defun ert--hash-table-to-alist (table)
  50   (let ((accu nil))
  51     (maphash (lambda (key value)
  52                (push (cons key value) accu))
  53              table)
  54     (nreverse accu)))
  55
  56 (ert-deftest ert-test-test-buffers ()
  57   (let (buffer-1
  58         buffer-2)
  59     (let ((test-1
  60            (make-ert-test
  61             :name 'test-1
  62             :body (lambda ()
  63                     (ert-with-test-buffer (:name "foo")
  64                       (should (string-match
  65                                "[*]Test buffer (ert-test-test-buffers): foo[*]"
  66                                (buffer-name)))
  67                       (setq buffer-1 (current-buffer))))))
  68           (test-2
  69            (make-ert-test
  70             :name 'test-2
  71             :body (lambda ()
  72                     (ert-with-test-buffer (:name "bar")
  73                       (should (string-match
  74                                "[*]Test buffer (ert-test-test-buffers): bar[*]"
  75                                (buffer-name)))
  76                       (setq buffer-2 (current-buffer))
  77                       (ert-fail "fail for test"))))))
  78       (let ((ert--test-buffers (make-hash-table :weakness t)))
  79         (ert-run-tests `(member ,test-1 ,test-2) #'ignore)
  80         (should (equal (ert--hash-table-to-alist ert--test-buffers)
  81                        `((,buffer-2 . t))))
  82         (should-not (buffer-live-p buffer-1))
  83         (should (buffer-live-p buffer-2))))))
  84
  85
  86 (ert-deftest ert-filter-string ()
  87   (should (equal (ert-filter-string "foo bar baz" "quux")
  88                  "foo bar baz"))
  89   (should (equal (ert-filter-string "foo bar baz" "bar")
  90                  "foo  baz")))
  91
  92 (ert-deftest ert-propertized-string ()
  93   (should (ert-equal-including-properties
  94            (ert-propertized-string "a" '(a b) "b" '(c t) "cd")
  95            #("abcd" 1 2 (a b) 2 4 (c t))))
  96   (should (ert-equal-including-properties
  97            (ert-propertized-string "foo " '(face italic) "bar" " baz" nil
  98                                    " quux")
  99            #("foo bar baz quux" 4 11 (face italic)))))
 100
 101
 102 ;;; Tests for ERT itself that require test features from ert-x.el.
 103
 104 (ert-deftest ert-test-run-tests-interactively-2 ()
 105   :tags '(:causes-redisplay)
 106   (let* ((passing-test (make-ert-test :name 'passing-test
 107                                       :body (lambda () (ert-pass))))
 108          (failing-test (make-ert-test :name 'failing-test
 109                                       :body (lambda ()
 110                                               (ert-info ((propertize "foo\nbar"
 111                                                                      'a 'b))
 112                                                 (ert-fail
 113                                                  "failure message")))))
 114          (skipped-test (make-ert-test :name 'skipped-test
 115                                       :body (lambda () (ert-skip
 116                                                         "skip message"))))
 117          (ert-debug-on-error nil)
 118          (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
 119          (messages nil)
 120          (mock-message-fn
 121           (lambda (format-string &rest args)
 122             (push (apply #'format format-string args) messages))))
 123     (cl-flet ((expected-string (with-font-lock-p)
 124                 (ert-propertized-string
 125                  "Selector: (member <passing-test> <failing-test> "
 126                  "<skipped-test>)\n"
 127                  "Passed:  1\n"
 128                  "Failed:  1 (1 unexpected)\n"
 129                  "Skipped: 1\n"
 130                  "Total:   3/3\n\n"
 131                  "Started at:\n"
 132                  "Finished.\n"
 133                  "Finished at:\n\n"
 134                  `(category ,(button-category-symbol
 135                               'ert--results-progress-bar-button)
 136                             button (t)
 137                             face ,(if with-font-lock-p
 138                                       'ert-test-result-unexpected
 139                                     'button))
 140                  ".Fs" nil "\n\n"
 141                  `(category ,(button-category-symbol
 142                               'ert--results-expand-collapse-button)
 143                             button (t)
 144                             face ,(if with-font-lock-p
 145                                       'ert-test-result-unexpected
 146                                     'button))
 147                  "F" nil " "
 148                  `(category ,(button-category-symbol
 149                               'ert--test-name-button)
 150                             button (t)
 151                             ert-test-name failing-test)
 152                  "failing-test"
 153                  nil "\n    Info: " '(a b) "foo\n"
 154                  nil "          " '(a b) "bar"
 155                  nil "\n    (ert-test-failed \"failure message\")\n\n\n"
 156                  )))
 157       (save-window-excursion
 158         (unwind-protect
 159             (let ((case-fold-search nil))
 160               (ert-run-tests-interactively
 161                `(member ,passing-test ,failing-test ,skipped-test) buffer-name
 162                mock-message-fn)
 163               (should (equal messages `(,(concat
 164                                           "Ran 3 tests, 1 results were "
 165                                           "as expected, 1 unexpected, "
 166                                           "1 skipped"))))
 167               (with-current-buffer buffer-name
 168                 (font-lock-mode 0)
 169                 (should (ert-equal-including-properties
 170                          (ert-filter-string (buffer-string)
 171                                             '("Started at:\\(.*\\)$" 1)
 172                                             '("Finished at:\\(.*\\)$" 1))
 173                          (expected-string nil)))
 174                 ;; `font-lock-mode' only works if interactive, so
 175                 ;; pretend we are.
 176                 (let ((noninteractive nil))
 177                   (font-lock-mode 1))
 178                 (should (ert-equal-including-properties
 179                          (ert-filter-string (buffer-string)
 180                                             '("Started at:\\(.*\\)$" 1)
 181                                             '("Finished at:\\(.*\\)$" 1))
 182                          (expected-string t)))))
 183           (when (get-buffer buffer-name)
 184             (kill-buffer buffer-name)))))))
 185
 186 (ert-deftest ert-test-describe-test ()
 187   "Tests `ert-describe-test'."
 188   (save-window-excursion
 189     (ert-with-buffer-renamed ("*Help*")
 190       (if (< emacs-major-version 24)
 191           (should (equal (should-error (ert-describe-test 'ert-describe-test))
 192                          '(error "Requires Emacs 24")))
 193         (ert-describe-test 'ert-test-describe-test)
 194         (with-current-buffer "*Help*"
 195           (let ((case-fold-search nil))
 196             (should (string-match (concat
 197                                    "\\`ert-test-describe-test is a test"
 198                                    " defined in `ert-x-tests.elc?'\\.\n\n"
 199                                    "Tests `ert-describe-test'\\.\n\\'")
 200                                   (buffer-string)))))))))
 201
 202 (ert-deftest ert-test-message-log-truncation ()
 203   :tags '(:causes-redisplay)
 204   (let ((test (make-ert-test
 205                :body (lambda ()
 206                        ;; Emacs would combine messages if we
 207                        ;; generate the same message multiple
 208                        ;; times.
 209                        (message "a")
 210                        (message "b")
 211                        (message "c")
 212                        (message "d")))))
 213     (let (result)
 214       (ert-with-buffer-renamed ("*Messages*")
 215         (let ((message-log-max 2))
 216           (setq result (ert-run-test test)))
 217         (should (equal (with-current-buffer "*Messages*"
 218                          (buffer-string))
 219                        "c\nd\n")))
 220       (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
 221
 222 (ert-deftest ert-test-builtin-message-log-flushing ()
 223   "This test attempts to demonstrate that there is no way to
 224 force immediate truncation of the *Messages* buffer from Lisp
 225 \(and hence justifies the existence of
 226 `ert--force-message-log-buffer-truncation'\): The only way that
 227 came to my mind was \(message \"\"\), which doesn't have the
 228 desired effect."
 229   :tags '(:causes-redisplay)
 230   (ert-with-buffer-renamed ("*Messages*")
 231     (with-current-buffer "*Messages*"
 232       (should (equal (buffer-string) ""))
 233       ;; We used to get sporadic failures in this test that involved
 234       ;; a spurious newline at the beginning of the buffer, before
 235       ;; the first message.  Below, we print a message and erase the
 236       ;; buffer since this seems to eliminate the sporadic failures.
 237       (message "foo")
 238       (erase-buffer)
 239       (should (equal (buffer-string) ""))
 240       (let ((message-log-max 2))
 241         (let ((message-log-max t))
 242           (cl-loop for i below 4 do
 243                    (message "%s" i))
 244           (should (equal (buffer-string) "0\n1\n2\n3\n")))
 245         (should (equal (buffer-string) "0\n1\n2\n3\n"))
 246         (message "")
 247         (should (equal (buffer-string) "0\n1\n2\n3\n"))
 248         (message "Test message")
 249         (should (equal (buffer-string) "3\nTest message\n"))))))
 250
 251 (ert-deftest ert-test-force-message-log-buffer-truncation ()
 252   :tags '(:causes-redisplay)
 253   (cl-labels ((body ()
 254                 (cl-loop for i below 3 do
 255                          (message "%s" i)))
 256               ;; Uses the implicit messages buffer truncation implemented
 257               ;; in Emacs' C core.
 258               (c (x)
 259                 (ert-with-buffer-renamed ("*Messages*")
 260                   (let ((message-log-max x))
 261                     (body))
 262                   (with-current-buffer "*Messages*"
 263                     (buffer-string))))
 264               ;; Uses our lisp reimplementation.
 265               (lisp (x)
 266                 (ert-with-buffer-renamed ("*Messages*")
 267                   (let ((message-log-max t))
 268                     (body))
 269                   (let ((message-log-max x))
 270                     (ert--force-message-log-buffer-truncation))
 271                   (with-current-buffer "*Messages*"
 272                     (buffer-string)))))
 273     (cl-loop for x in '(0 1 2 3 4 t) do
 274              (should (equal (c x) (lisp x))))))
 275
 276
 277 (provide 'ert-x-tests)
 278
 279 ;;; ert-x-tests.el ends here