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