test/automated/ert-x-tests.el

   1 ;;; ert-x-tests.el --- Tests for ert-x.el
   2
   3 ;; Copyright (C) 2008, 2010-2012 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))
  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          (ert-debug-on-error nil)
 115          (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
 116          (messages nil)
 117          (mock-message-fn
 118           (lambda (format-string &rest args)
 119             (push (apply #'format format-string args) messages))))
 120     (cl-flet ((expected-string (with-font-lock-p)
 121                 (ert-propertized-string
 122                  "Selector: (member <passing-test> <failing-test>)\n"
 123                  "Passed: 1\n"
 124                  "Failed: 1 (1 unexpected)\n"
 125                  "Total:  2/2\n\n"
 126                  "Started at:\n"
 127                  "Finished.\n"
 128                  "Finished at:\n\n"
 129                  `(category ,(button-category-symbol
 130                               'ert--results-progress-bar-button)
 131                             button (t)
 132                             face ,(if with-font-lock-p
 133                                       'ert-test-result-unexpected
 134                                     'button))
 135                  ".F" nil "\n\n"
 136                  `(category ,(button-category-symbol
 137                               'ert--results-expand-collapse-button)
 138                             button (t)
 139                             face ,(if with-font-lock-p
 140                                       'ert-test-result-unexpected
 141                                     'button))
 142                  "F" nil " "
 143                  `(category ,(button-category-symbol
 144                               'ert--test-name-button)
 145                             button (t)
 146                             ert-test-name failing-test)
 147                  "failing-test"
 148                  nil "\n    Info: " '(a b) "foo\n"
 149                  nil "          " '(a b) "bar"
 150                  nil "\n    (ert-test-failed \"failure message\")\n\n\n"
 151                  )))
 152       (save-window-excursion
 153         (unwind-protect
 154             (let ((case-fold-search nil))
 155               (ert-run-tests-interactively
 156                `(member ,passing-test ,failing-test) buffer-name
 157                mock-message-fn)
 158               (should (equal messages `(,(concat
 159                                           "Ran 2 tests, 1 results were "
 160                                           "as expected, 1 unexpected"))))
 161               (with-current-buffer buffer-name
 162                 (font-lock-mode 0)
 163                 (should (ert-equal-including-properties
 164                          (ert-filter-string (buffer-string)
 165                                             '("Started at:\\(.*\\)$" 1)
 166                                             '("Finished at:\\(.*\\)$" 1))
 167                          (expected-string nil)))
 168                 ;; `font-lock-mode' only works if interactive, so
 169                 ;; pretend we are.
 170                 (let ((noninteractive nil))
 171                   (font-lock-mode 1))
 172                 (should (ert-equal-including-properties
 173                          (ert-filter-string (buffer-string)
 174                                             '("Started at:\\(.*\\)$" 1)
 175                                             '("Finished at:\\(.*\\)$" 1))
 176                          (expected-string t)))))
 177           (when (get-buffer buffer-name)
 178             (kill-buffer buffer-name)))))))
 179
 180 (ert-deftest ert-test-describe-test ()
 181   "Tests `ert-describe-test'."
 182   (save-window-excursion
 183     (ert-with-buffer-renamed ("*Help*")
 184       (if (< emacs-major-version 24)
 185           (should (equal (should-error (ert-describe-test 'ert-describe-test))
 186                          '(error "Requires Emacs 24")))
 187         (ert-describe-test 'ert-test-describe-test)
 188         (with-current-buffer "*Help*"
 189           (let ((case-fold-search nil))
 190             (should (string-match (concat
 191                                    "\\`ert-test-describe-test is a test"
 192                                    " defined in `ert-x-tests.elc?'\\.\n\n"
 193                                    "Tests `ert-describe-test'\\.\n\\'")
 194                                   (buffer-string)))))))))
 195
 196 (ert-deftest ert-test-message-log-truncation ()
 197   :tags '(:causes-redisplay)
 198   (let ((test (make-ert-test
 199                :body (lambda ()
 200                        ;; Emacs would combine messages if we
 201                        ;; generate the same message multiple
 202                        ;; times.
 203                        (message "a")
 204                        (message "b")
 205                        (message "c")
 206                        (message "d")))))
 207     (let (result)
 208       (ert-with-buffer-renamed ("*Messages*")
 209         (let ((message-log-max 2))
 210           (setq result (ert-run-test test)))
 211         (should (equal (with-current-buffer "*Messages*"
 212                          (buffer-string))
 213                        "c\nd\n")))
 214       (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
 215
 216 (ert-deftest ert-test-builtin-message-log-flushing ()
 217   "This test attempts to demonstrate that there is no way to
 218 force immediate truncation of the *Messages* buffer from Lisp
 219 \(and hence justifies the existence of
 220 `ert--force-message-log-buffer-truncation'\): The only way that
 221 came to my mind was \(message \"\"\), which doesn't have the
 222 desired effect."
 223   :tags '(:causes-redisplay)
 224   (ert-with-buffer-renamed ("*Messages*")
 225     (with-current-buffer "*Messages*"
 226       (should (equal (buffer-string) ""))
 227       ;; We used to get sporadic failures in this test that involved
 228       ;; a spurious newline at the beginning of the buffer, before
 229       ;; the first message.  Below, we print a message and erase the
 230       ;; buffer since this seems to eliminate the sporadic failures.
 231       (message "foo")
 232       (erase-buffer)
 233       (should (equal (buffer-string) ""))
 234       (let ((message-log-max 2))
 235         (let ((message-log-max t))
 236           (loop for i below 4 do
 237                 (message "%s" i))
 238           (should (equal (buffer-string) "0\n1\n2\n3\n")))
 239         (should (equal (buffer-string) "0\n1\n2\n3\n"))
 240         (message "")
 241         (should (equal (buffer-string) "0\n1\n2\n3\n"))
 242         (message "Test message")
 243         (should (equal (buffer-string) "3\nTest message\n"))))))
 244
 245 (ert-deftest ert-test-force-message-log-buffer-truncation ()
 246   :tags '(:causes-redisplay)
 247   (labels ((body ()
 248              (loop for i below 3 do
 249                    (message "%s" i)))
 250            ;; Uses the implicit messages buffer truncation implemented
 251            ;; in Emacs' C core.
 252            (c (x)
 253              (ert-with-buffer-renamed ("*Messages*")
 254                (let ((message-log-max x))
 255                  (body))
 256                (with-current-buffer "*Messages*"
 257                  (buffer-string))))
 258            ;; Uses our lisp reimplementation.
 259            (lisp (x)
 260              (ert-with-buffer-renamed ("*Messages*")
 261                (let ((message-log-max t))
 262                  (body))
 263                (let ((message-log-max x))
 264                  (ert--force-message-log-buffer-truncation))
 265                (with-current-buffer "*Messages*"
 266                  (buffer-string)))))
 267     (loop for x in '(0 1 2 3 4 t) do
 268           (should (equal (c x) (lisp x))))))
 269
 270
 271 (provide 'ert-x-tests)
 272
 273 ;;; ert-x-tests.el ends here