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 ;; Package-Requires: ((cl-lib "0"))
  10 ;; Version: 1.1
  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 ;; * Accomodates 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) test-gcd.el and run M-x eval-current-buffer
  68 ;;
  69 ;; You should see in buffer *test-simple*:
  70 ;;
  71 ;;    test-gcd.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 test-gcd.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 (defvar test-simple-debug-on-error nil
  95   "If non-nil raise an error on the first failure.")
  96
  97 (defvar test-simple-verbosity 0
  98   "The greater the number the more verbose output.")
  99
 100 (cl-defstruct test-info
 101   description                 ;; description of last group of tests
 102   (assert-count 0)            ;; total number of assertions run
 103   (failure-count 0)           ;; total number of failures seen
 104   (start-time (current-time)) ;; Time run started
 105   )
 106
 107 (defvar test-simple-info (make-test-info)
 108   "Variable to store testing information for a buffer.")
 109
 110 (defun note (description &optional test-info)
 111   "Add a name to a group of tests."
 112   (if (getenv "USE_TAP")
 113     (test-simple-msg (format "# %s" description) 't)
 114     (if (> test-simple-verbosity 0)
 115         (test-simple-msg (concat "\n" description) 't))
 116     (unless test-info
 117       (setq test-info test-simple-info))
 118     (setf (test-info-description test-info) description)
 119     ))
 120
 121 ;;;###autoload
 122 (defmacro test-simple-start (&optional test-start-msg)
 123   `(test-simple-clear nil
 124                       (or ,test-start-msg
 125                           (if (and (functionp '__FILE__) (__FILE__))
 126                               (file-name-nondirectory (__FILE__))
 127                             (buffer-name)))
 128                       ))
 129
 130 ;;;###autoload
 131 (defun test-simple-clear (&optional test-info test-start-msg)
 132   "Initialize and reset everything to run tests.
 133 You should run this before running any assertions.  Running more than once
 134 clears out information from the previous run."
 135
 136   (interactive)
 137
 138   (unless test-info
 139     (setq test-info test-simple-info))
 140
 141   (setf (test-info-description test-info) "none set")
 142   (setf (test-info-start-time test-info) (current-time))
 143   (setf (test-info-assert-count test-info) 0)
 144   (setf (test-info-failure-count test-info) 0)
 145
 146   (with-current-buffer (get-buffer-create "*test-simple*")
 147     (let ((old-read-only inhibit-read-only))
 148       (setq inhibit-read-only 't)
 149       (delete-region (point-min) (point-max))
 150       (if test-start-msg (insert (format "%s\n" test-start-msg)))
 151       (setq inhibit-read-only old-read-only)))
 152   (unless noninteractive
 153     (message "Test-Simple: test information cleared")))
 154
 155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 156 ;; Assertion tests
 157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 158
 159 (defmacro assert-raises (error-condition body &optional fail-message test-info)
 160   (let ((fail-message (or fail-message
 161                           (format "assert-raises did not get expected %s"
 162                                   error-condition))))
 163     (list 'condition-case nil
 164           (list 'progn body
 165                 (list 'assert-t nil fail-message test-info))
 166           (list error-condition '(assert-t t)))))
 167
 168 (defun assert-op (op expected actual &optional fail-message test-info)
 169   "Expectation is that ACTUAL should be equal to EXPECTED."
 170   (unless test-info (setq test-info test-simple-info))
 171   (cl-incf (test-info-assert-count test-info))
 172   (if (not (funcall op actual expected))
 173       (let* ((fail-message
 174               (if fail-message
 175                   (format "Message: %s" fail-message)
 176                 ""))
 177              (expect-message
 178               (format "\n  Expected: %s\n  Got: %s" expected actual))
 179              (test-info-mess
 180               (if (boundp 'test-info)
 181                   (test-info-description test-info)
 182                 "unset")))
 183         (test-simple--add-failure (format "assert-%s" op) test-info-mess
 184                                   (concat fail-message expect-message)))
 185     (test-simple--ok-msg fail-message)))
 186
 187 (defun assert-equal (expected actual &optional fail-message test-info)
 188   "Expectation is that ACTUAL should be equal to EXPECTED."
 189   (assert-op 'equal expected actual fail-message test-info))
 190
 191 (defun assert-eq (expected actual &optional fail-message test-info)
 192   "Expectation is that ACTUAL should be EQ to EXPECTED."
 193   (assert-op 'eql expected actual fail-message test-info))
 194
 195 (defun assert-eql (expected actual &optional fail-message test-info)
 196   "Expectation is that ACTUAL should be EQL to EXPECTED."
 197   (assert-op 'eql expected actual fail-message test-info))
 198
 199 (defun assert-matches (expected-regexp actual &optional fail-message test-info)
 200   "Expectation is that ACTUAL should match EXPECTED-REGEXP."
 201   (unless test-info (setq test-info test-simple-info))
 202   (cl-incf (test-info-assert-count test-info))
 203   (if (not (string-match expected-regexp actual))
 204       (let* ((fail-message
 205               (if fail-message
 206                   (format "\n\tMessage: %s" fail-message)
 207                 ""))
 208              (expect-message
 209               (format "\tExpected Regexp: %s\n\tGot:      %s"
 210                       expected-regexp actual))
 211              (test-info-mess
 212               (if (boundp 'test-info)
 213                   (test-info-description test-info)
 214                 "unset")))
 215         (test-simple--add-failure "assert-equal" test-info-mess
 216                                   (concat expect-message fail-message)))
 217     (progn (test-simple-msg ".") t)))
 218
 219 (defun assert-t (actual &optional fail-message test-info)
 220   "Expectation is that ACTUAL is not nil."
 221   (assert-nil (not actual) fail-message test-info "assert-t"))
 222
 223 (defun assert-nil (actual &optional fail-message test-info _assert-type)
 224   "Expectation is that ACTUAL is nil.
 225 FAIL-MESSAGE is an optional additional message to be displayed.
 226 Since several assertions funnel down to this one, ASSERT-TYPE is an
 227 optional type."
 228   (unless test-info (setq test-info test-simple-info))
 229   (cl-incf (test-info-assert-count test-info))
 230   (if actual
 231       (let* ((fail-message
 232               (if fail-message
 233                   (format "\n\tMessage: %s" fail-message)
 234                 ""))
 235              (test-info-mess
 236               (if (boundp 'test-simple-info)
 237                   (test-info-description test-simple-info)
 238                 "unset")))
 239         (test-simple--add-failure "assert-nil" test-info-mess
 240                                   fail-message test-info))
 241     (test-simple--ok-msg fail-message)))
 242
 243 (defun test-simple--add-failure (type test-info-msg fail-msg
 244                                       &optional test-info)
 245   (unless test-info (setq test-info test-simple-info))
 246   (cl-incf (test-info-failure-count test-info))
 247   (let ((failure-msg
 248          (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
 249         )
 250     (save-excursion
 251       (test-simple--not-ok-msg fail-msg)
 252       (test-simple-msg failure-msg 't)
 253       (unless noninteractive
 254         (if test-simple-debug-on-error
 255             (signal 'test-simple-assert-failed failure-msg)
 256           ;;(message failure-msg)
 257           )))))
 258
 259 (defun end-tests (&optional test-info)
 260   "Give a tally of the tests run."
 261   (interactive)
 262   (unless test-info (setq test-info test-simple-info))
 263   (test-simple-describe-failures test-info)
 264   (if noninteractive
 265       (progn
 266         (switch-to-buffer "*test-simple*")
 267         (message "%s" (buffer-substring (point-min) (point-max)))
 268         )
 269     (switch-to-buffer-other-window "*test-simple*")
 270     ))
 271
 272 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 273 ;; Reporting
 274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 275
 276 (defun test-simple-msg(msg &optional newline)
 277   (switch-to-buffer "*test-simple*")
 278   (let ((inhibit-read-only t))
 279     (insert msg)
 280     (if newline (insert "\n")))
 281   (switch-to-buffer nil))
 282
 283 (defun test-simple--ok-msg (fail-message &optional test-info)
 284   (unless test-info (setq test-info test-simple-info))
 285   (let ((msg (if (getenv "USE_TAP")
 286                  (if (equal fail-message "")
 287                      (format "ok %d\n" (test-info-assert-count test-info))
 288                    (format "ok %d - %s\n"
 289                            (test-info-assert-count test-info)
 290                            fail-message))
 291                ".")))
 292       (test-simple-msg msg))
 293   't)
 294
 295 (defun test-simple--not-ok-msg (_fail-message &optional test-info)
 296   (unless test-info (setq test-info test-simple-info))
 297   (let ((msg (if (getenv "USE_TAP")
 298                  (format "not ok %d\n" (test-info-assert-count test-info))
 299                "F")))
 300       (test-simple-msg msg))
 301   nil)
 302
 303 (defun test-simple-summary-line(info)
 304   (let*
 305       ((failures (test-info-failure-count info))
 306        (asserts (test-info-assert-count info))
 307        (problems (concat (number-to-string failures) " failure"
 308                          (unless (= 1 failures) "s")))
 309        (tests (concat (number-to-string asserts) " assertion"
 310                       (unless (= 1 asserts) "s")))
 311        (elapsed-time (time-since (test-info-start-time info)))
 312        )
 313     (if (getenv "USE_TAP")
 314         (format "1..%d" asserts)
 315       (format "\n%s in %s (%g seconds)" problems tests
 316               (float-time elapsed-time))
 317   )))
 318
 319 (defun test-simple-describe-failures(&optional test-info)
 320   (unless test-info (setq test-info test-simple-info))
 321   (goto-char (point-max))
 322   (test-simple-msg (test-simple-summary-line test-info)))
 323
 324 (provide 'test-simple)
 325 ;;; test-simple.el ends here