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

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