code.delx.au - gnu-emacs-elpa/blob - packages/test-simple/test-simple.el

   1 ;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
   2 ;; Rewritten from Phil Hagelberg's behave.el by rocky
   3
   4 ;; Copyright (C) 2010, 2012-2013, 2014 Rocky Bernstein
   5
   6 ;; Author: Rocky Bernstein
   7 ;; URL: http://github.com/rocky/emacs-test-simple
   8 ;; Keywords: unit-test
   9 ;; Version: 1.0
  10
  11 ;; This file is NOT part of GNU Emacs.
  12
  13 ;; This program is free software: you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation, either version 3 of the
  16 ;; License, or (at your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see
  25 ;; <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; test-simple.el is:
  30 ;;
  31 ;; * Simple. No need for
  32 ;;   - context macros,
  33 ;;   - enclosing specifications,
  34 ;;   - required test tags.
  35 ;;
  36 ;;   But if you want, you still can enclose tests in a local scope,
  37 ;;   add customized assert failure messages, or add summary messages
  38 ;;   before a group of tests.
  39 ;;
  40 ;; * Accomodates both interactive and non-interactive use.
  41 ;;    - For interactive use, one can use `eval-last-sexp', `eval-region',
  42 ;;      and `eval-buffer'. One can `edebug' the code.
  43 ;;    -  For non-interactive use, run:
  44 ;;        emacs --batch --no-site-file --no-splash --load <test-lisp-code.el>
  45 ;;
  46 ;; Here is an example using gcd.el found in the examples directory.
  47 ;;
  48 ;;   (require 'test-simple)
  49 ;;   (test-simple-start) ;; Zero counters and start the stop watch.
  50 ;;
  51 ;;   ;; Use (load-file) below because we want to always to read the source.
  52 ;;   ;; Also, we don't want no stinking compiled source.
  53 ;;   (assert-t (load-file "./gcd.el")
  54 ;;            "Can't load gcd.el - are you in the right directory?" )
  55 ;;
  56 ;;   (note "degenerate cases")
  57 ;;
  58 ;;   (assert-nil (gcd 5 -1) "using positive numbers")
  59 ;;   (assert-nil (gcd -4 1) "using positive numbers, switched order")
  60 ;;   (assert-raises error (gcd "a" 32)
  61 ;;                  "Passing a string value should raise an error")
  62 ;;
  63 ;;   (note "GCD computations")
  64 ;;   (assert-equal 1 (gcd 3 5) "gcd(3,5)")
  65 ;;   (assert-equal 8 (gcd 8 32) "gcd(8,32)")
  66 ;;   (end-tests) ;; Stop the clock and print a summary
  67 ;;
  68 ;; Edit (with Emacs of course) test-gcd.el and run M-x eval-current-buffer
  69 ;;
  70 ;; You should see in buffer *test-simple*:
  71 ;;
  72 ;;    test-gcd.el
  73 ;;    ......
  74 ;;    0 failures in 6 assertions (0.002646 seconds)
  75 ;;
  76 ;; Now let us try from a command line:
  77 ;;
  78 ;;    $ emacs --batch --no-site-file --no-splash --load test-gcd.el
  79 ;;    Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
  80 ;;    *scratch*
  81 ;;    ......
  82 ;;    0 failures in 6 assertions (0.000723 seconds)
  83
  84 ;;; To do:
  85
  86 ;; Main issues: more expect predicates
  87
  88 (require 'time-date)
  89
  90 ;;; Code:
  91
  92 (eval-when-compile
  93   (byte-compile-disable-warning 'cl-functions)
  94   ;; Somehow disabling cl-functions causes the erroneous message:
  95   ;;   Warning: the function `reduce' might not be defined at runtime.
  96   ;; FIXME: isolate, fix and/or report back to Emacs developers a bug
  97   ;; (byte-compile-disable-warning 'unresolved)
  98   (require 'cl)
  99   )
 100 (require 'cl)
 101
 102 (defvar test-simple-debug-on-error nil
 103   "If non-nil raise an error on the first failure.")
 104
 105 (defvar test-simple-verbosity 0
 106   "The greater the number the more verbose output.")
 107
 108 (defstruct test-info
 109   description                 ;; description of last group of tests
 110   (assert-count 0)            ;; total number of assertions run
 111   (failure-count 0)           ;; total number of failures seen
 112   (start-time (current-time)) ;; Time run started
 113   )
 114
 115 (defvar test-simple-info (make-test-info)
 116   "Variable to store testing information for a buffer.")
 117
 118 (defun note (description &optional test-info)
 119   "Adds a name to a group of tests."
 120   (if (getenv "USE_TAP")
 121     (test-simple-msg (format "# %s" description) 't)
 122     (if (> test-simple-verbosity 0)
 123         (test-simple-msg (concat "\n" description) 't))
 124     (unless test-info
 125       (setq test-info test-simple-info))
 126     (setf (test-info-description test-info) description)
 127     ))
 128
 129 ;;;###autoload
 130 (defmacro test-simple-start (&optional test-start-msg)
 131   `(test-simple-clear nil
 132                       (or ,test-start-msg
 133                           (if (and (functionp '__FILE__) (__FILE__))
 134                               (file-name-nondirectory (__FILE__))
 135                             (buffer-name)))
 136                       ))
 137
 138 ;;;###autoload
 139 (defun test-simple-clear (&optional test-info test-start-msg)
 140   "Initializes and resets everything to run tests. You should run
 141 this before running any assertions. Running more than once clears
 142 out information from the previous run."
 143
 144   (interactive)
 145
 146   (unless test-info
 147     (unless test-simple-info
 148       (make-variable-buffer-local (defvar test-simple-info (make-test-info))))
 149     (setq test-info test-simple-info))
 150
 151   (setf (test-info-description test-info) "none set")
 152   (setf (test-info-start-time test-info) (current-time))
 153   (setf (test-info-assert-count test-info) 0)
 154   (setf (test-info-failure-count test-info) 0)
 155
 156   (with-current-buffer (get-buffer-create "*test-simple*")
 157     (let ((old-read-only inhibit-read-only))
 158       (setq inhibit-read-only 't)
 159       (delete-region (point-min) (point-max))
 160       (if test-start-msg (insert (format "%s\n" test-start-msg)))
 161       (setq inhibit-read-only old-read-only)))
 162   (unless noninteractive
 163     (message "Test-Simple: test information cleared")))
 164
 165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 166 ;; Assertion tests
 167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 168
 169 (defmacro assert-raises (error-condition body &optional fail-message test-info)
 170   (let ((fail-message (or fail-message
 171                           (format "assert-raises did not get expected %s"
 172                                   error-condition))))
 173     (list 'condition-case nil
 174           (list 'progn body
 175                 (list 'assert-t nil fail-message test-info))
 176           (list error-condition '(assert-t t)))))
 177
 178 (defun assert-op (op expected actual &optional fail-message test-info)
 179   "expectation is that ACTUAL should be equal to EXPECTED."
 180   (unless test-info (setq test-info test-simple-info))
 181   (incf (test-info-assert-count test-info))
 182   (if (not (funcall op actual expected))
 183       (let* ((fail-message
 184               (if fail-message
 185                   (format "Message: %s" fail-message)
 186                 ""))
 187              (expect-message
 188               (format "\n  Expected: %s\n  Got: %s" expected actual))
 189              (test-info-mess
 190               (if (boundp 'test-info)
 191                   (test-info-description test-info)
 192                 "unset")))
 193         (add-failure (format "assert-%s" op) test-info-mess
 194                      (concat fail-message expect-message)))
 195     (ok-msg fail-message)))
 196
 197 (defun assert-equal (expected actual &optional fail-message test-info)
 198   "expectation is that ACTUAL should be equal to EXPECTED."
 199   (assert-op 'equal expected actual fail-message test-info))
 200
 201 (defun assert-eq (expected actual &optional fail-message test-info)
 202   "expectation is that ACTUAL should be EQ to EXPECTED."
 203   (assert-op 'eql expected actual fail-message test-info))
 204
 205 (defun assert-eql (expected actual &optional fail-message test-info)
 206   "expectation is that ACTUAL should be EQL to EXPECTED."
 207   (assert-op 'eql expected actual fail-message test-info))
 208
 209 (defun assert-matches (expected-regexp actual &optional fail-message test-info)
 210   "expectation is that ACTUAL should match EXPECTED-REGEXP."
 211   (unless test-info (setq test-info test-simple-info))
 212   (incf (test-info-assert-count test-info))
 213   (if (not (string-match expected-regexp actual))
 214       (let* ((fail-message
 215               (if fail-message
 216                   (format "\n\tMessage: %s" fail-message)
 217                 ""))
 218              (expect-message
 219               (format "\tExpected Regexp: %s\n\tGot:      %s"
 220                       expected-regexp actual))
 221              (test-info-mess
 222               (if (boundp 'test-info)
 223                   (test-info-description test-info)
 224                 "unset")))
 225         (add-failure "assert-equal" test-info-mess
 226                      (concat expect-message fail-message)))
 227     (progn (test-simple-msg ".") t)))
 228
 229 (defun assert-t (actual &optional fail-message test-info)
 230   "expectation is that ACTUAL is not nil."
 231   (assert-nil (not actual) fail-message test-info "assert-t"))
 232
 233 (defun assert-nil (actual &optional fail-message test-info assert-type)
 234   "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
 235 additional message to be displayed. Since several assertions
 236 funnel down to this one, ASSERT-TYPE is an optional type."
 237   (unless test-info (setq test-info test-simple-info))
 238   (incf (test-info-assert-count test-info))
 239   (if actual
 240       (let* ((fail-message
 241               (if fail-message
 242                   (format "\n\tMessage: %s" fail-message)
 243                 ""))
 244              (test-info-mess
 245               (if (boundp 'test-simple-info)
 246                   (test-info-description test-simple-info)
 247                 "unset")))
 248         (add-failure "assert-nil" test-info-mess fail-message test-info))
 249     (ok-msg fail-message)))
 250
 251 (defun add-failure(type test-info-msg fail-msg &optional test-info)
 252   (unless test-info (setq test-info test-simple-info))
 253   (incf (test-info-failure-count test-info))
 254   (let ((failure-msg
 255          (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
 256         (old-read-only inhibit-read-only)
 257         )
 258     (save-excursion
 259       (not-ok-msg fail-msg)
 260       (test-simple-msg failure-msg 't)
 261       (unless noninteractive
 262         (if test-simple-debug-on-error
 263             (signal 'test-simple-assert-failed failure-msg)
 264           ;;(message failure-msg)
 265           )))))
 266
 267 (defun end-tests (&optional test-info)
 268   "Give a tally of the tests run"
 269   (interactive)
 270   (unless test-info (setq test-info test-simple-info))
 271   (test-simple-describe-failures test-info)
 272   (if noninteractive
 273       (progn
 274         (switch-to-buffer "*test-simple*")
 275         (message "%s" (buffer-substring (point-min) (point-max)))
 276         )
 277     (switch-to-buffer-other-window "*test-simple*")
 278     ))
 279
 280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 281 ;; Reporting
 282 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 283
 284 (defun test-simple-msg(msg &optional newline)
 285   (switch-to-buffer "*test-simple*")
 286   (let ((old-read-only inhibit-read-only))
 287     (setq inhibit-read-only 't)
 288     (insert msg)
 289     (if newline (insert "\n"))
 290     (setq inhibit-read-only old-read-only)
 291     (switch-to-buffer nil)
 292   ))
 293
 294 (defun ok-msg(fail-message &optional test-info)
 295   (unless test-info (setq test-info test-simple-info))
 296   (let ((msg (if (getenv "USE_TAP")
 297                  (if (equal fail-message "")
 298                      (format "ok %d\n" (test-info-assert-count test-info))
 299                    (format "ok %d - %s\n"
 300                            (test-info-assert-count test-info)
 301                            fail-message))
 302                ".")))
 303       (test-simple-msg msg))
 304   't)
 305
 306 (defun not-ok-msg(fail-message &optional test-info)
 307   (unless test-info (setq test-info test-simple-info))
 308   (let ((msg (if (getenv "USE_TAP")
 309                  (format "not ok %d\n" (test-info-assert-count test-info))
 310                "F")))
 311       (test-simple-msg msg))
 312   nil)
 313
 314 (defun test-simple-summary-line(info)
 315   (let*
 316       ((failures (test-info-failure-count info))
 317        (asserts (test-info-assert-count info))
 318        (problems (concat (number-to-string failures) " failure"
 319                          (unless (= 1 failures) "s")))
 320        (tests (concat (number-to-string asserts) " assertion"
 321                       (unless (= 1 asserts) "s")))
 322        (elapsed-time (time-since (test-info-start-time info)))
 323        )
 324     (if (getenv "USE_TAP")
 325         (format "1..%d" asserts)
 326       (format "\n%s in %s (%g seconds)" problems tests
 327               (float-time elapsed-time))
 328   )))
 329
 330 (defun test-simple-describe-failures(&optional test-info)
 331   (unless test-info (setq test-info test-simple-info))
 332   (goto-char (point-max))
 333   (test-simple-msg (test-simple-summary-line test-info)))
 334
 335 (provide 'test-simple)
 336 ;;; test-simple.el ends here