--- /dev/null
+;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
+;; Rewritten from Phil Hagelberg's behave.el by rocky
+
+;; Copyright (C) 2010, 2012-2013, 2014 Rocky Bernstein
+
+;; Author: Rocky Bernstein
+;; URL: http://github.com/rocky/emacs-test-simple
+;; Keywords: unit-test
+;; Version: 1.0
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; test-simple.el is:
+;;
+;; * Simple. No need for
+;; - context macros,
+;; - enclosing specifications,
+;; - required test tags.
+;;
+;; But if you want, you still can enclose tests in a local scope,
+;; add customized assert failure messages, or add summary messages
+;; before a group of tests.
+;;
+;; * Accomodates both interactive and non-interactive use.
+;; - For interactive use, one can use `eval-last-sexp', `eval-region',
+;; and `eval-buffer'. One can `edebug' the code.
+;; - For non-interactive use, run:
+;; emacs --batch --no-site-file --no-splash --load <test-lisp-code.el>
+;;
+;; Here is an example using gcd.el found in the examples directory.
+;;
+;; (require 'test-simple)
+;; (test-simple-start) ;; Zero counters and start the stop watch.
+;;
+;; ;; Use (load-file) below because we want to always to read the source.
+;; ;; Also, we don't want no stinking compiled source.
+;; (assert-t (load-file "./gcd.el")
+;; "Can't load gcd.el - are you in the right directory?" )
+;;
+;; (note "degenerate cases")
+;;
+;; (assert-nil (gcd 5 -1) "using positive numbers")
+;; (assert-nil (gcd -4 1) "using positive numbers, switched order")
+;; (assert-raises error (gcd "a" 32)
+;; "Passing a string value should raise an error")
+;;
+;; (note "GCD computations")
+;; (assert-equal 1 (gcd 3 5) "gcd(3,5)")
+;; (assert-equal 8 (gcd 8 32) "gcd(8,32)")
+;; (end-tests) ;; Stop the clock and print a summary
+;;
+;; Edit (with Emacs of course) test-gcd.el and run M-x eval-current-buffer
+;;
+;; You should see in buffer *test-simple*:
+;;
+;; test-gcd.el
+;; ......
+;; 0 failures in 6 assertions (0.002646 seconds)
+;;
+;; Now let us try from a command line:
+;;
+;; $ emacs --batch --no-site-file --no-splash --load test-gcd.el
+;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
+;; *scratch*
+;; ......
+;; 0 failures in 6 assertions (0.000723 seconds)
+
+;;; To do:
+
+;; Main issues: more expect predicates
+
+(require 'time-date)
+
+;;; Code:
+
+(eval-when-compile
+ (byte-compile-disable-warning 'cl-functions)
+ ;; Somehow disabling cl-functions causes the erroneous message:
+ ;; Warning: the function `reduce' might not be defined at runtime.
+ ;; FIXME: isolate, fix and/or report back to Emacs developers a bug
+ ;; (byte-compile-disable-warning 'unresolved)
+ (require 'cl)
+ )
+(require 'cl)
+
+(defvar test-simple-debug-on-error nil
+ "If non-nil raise an error on the first failure.")
+
+(defvar test-simple-verbosity 0
+ "The greater the number the more verbose output.")
+
+(defstruct test-info
+ description ;; description of last group of tests
+ (assert-count 0) ;; total number of assertions run
+ (failure-count 0) ;; total number of failures seen
+ (start-time (current-time)) ;; Time run started
+ )
+
+(defvar test-simple-info (make-test-info)
+ "Variable to store testing information for a buffer.")
+
+(defun note (description &optional test-info)
+ "Adds a name to a group of tests."
+ (if (getenv "USE_TAP")
+ (test-simple-msg (format "# %s" description) 't)
+ (if (> test-simple-verbosity 0)
+ (test-simple-msg (concat "\n" description) 't))
+ (unless test-info
+ (setq test-info test-simple-info))
+ (setf (test-info-description test-info) description)
+ ))
+
+;;;###autoload
+(defmacro test-simple-start (&optional test-start-msg)
+ `(test-simple-clear nil
+ (or ,test-start-msg
+ (if (and (functionp '__FILE__) (__FILE__))
+ (file-name-nondirectory (__FILE__))
+ (buffer-name)))
+ ))
+
+;;;###autoload
+(defun test-simple-clear (&optional test-info test-start-msg)
+ "Initializes and resets everything to run tests. You should run
+this before running any assertions. Running more than once clears
+out information from the previous run."
+
+ (interactive)
+
+ (unless test-info
+ (unless test-simple-info
+ (make-variable-buffer-local (defvar test-simple-info (make-test-info))))
+ (setq test-info test-simple-info))
+
+ (setf (test-info-description test-info) "none set")
+ (setf (test-info-start-time test-info) (current-time))
+ (setf (test-info-assert-count test-info) 0)
+ (setf (test-info-failure-count test-info) 0)
+
+ (with-current-buffer (get-buffer-create "*test-simple*")
+ (let ((old-read-only inhibit-read-only))
+ (setq inhibit-read-only 't)
+ (delete-region (point-min) (point-max))
+ (if test-start-msg (insert (format "%s\n" test-start-msg)))
+ (setq inhibit-read-only old-read-only)))
+ (unless noninteractive
+ (message "Test-Simple: test information cleared")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Assertion tests
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro assert-raises (error-condition body &optional fail-message test-info)
+ (let ((fail-message (or fail-message
+ (format "assert-raises did not get expected %s"
+ error-condition))))
+ (list 'condition-case nil
+ (list 'progn body
+ (list 'assert-t nil fail-message test-info))
+ (list error-condition '(assert-t t)))))
+
+(defun assert-op (op expected actual &optional fail-message test-info)
+ "expectation is that ACTUAL should be equal to EXPECTED."
+ (unless test-info (setq test-info test-simple-info))
+ (incf (test-info-assert-count test-info))
+ (if (not (funcall op actual expected))
+ (let* ((fail-message
+ (if fail-message
+ (format "Message: %s" fail-message)
+ ""))
+ (expect-message
+ (format "\n Expected: %s\n Got: %s" expected actual))
+ (test-info-mess
+ (if (boundp 'test-info)
+ (test-info-description test-info)
+ "unset")))
+ (add-failure (format "assert-%s" op) test-info-mess
+ (concat fail-message expect-message)))
+ (ok-msg fail-message)))
+
+(defun assert-equal (expected actual &optional fail-message test-info)
+ "expectation is that ACTUAL should be equal to EXPECTED."
+ (assert-op 'equal expected actual fail-message test-info))
+
+(defun assert-eq (expected actual &optional fail-message test-info)
+ "expectation is that ACTUAL should be EQ to EXPECTED."
+ (assert-op 'eql expected actual fail-message test-info))
+
+(defun assert-eql (expected actual &optional fail-message test-info)
+ "expectation is that ACTUAL should be EQL to EXPECTED."
+ (assert-op 'eql expected actual fail-message test-info))
+
+(defun assert-matches (expected-regexp actual &optional fail-message test-info)
+ "expectation is that ACTUAL should match EXPECTED-REGEXP."
+ (unless test-info (setq test-info test-simple-info))
+ (incf (test-info-assert-count test-info))
+ (if (not (string-match expected-regexp actual))
+ (let* ((fail-message
+ (if fail-message
+ (format "\n\tMessage: %s" fail-message)
+ ""))
+ (expect-message
+ (format "\tExpected Regexp: %s\n\tGot: %s"
+ expected-regexp actual))
+ (test-info-mess
+ (if (boundp 'test-info)
+ (test-info-description test-info)
+ "unset")))
+ (add-failure "assert-equal" test-info-mess
+ (concat expect-message fail-message)))
+ (progn (test-simple-msg ".") t)))
+
+(defun assert-t (actual &optional fail-message test-info)
+ "expectation is that ACTUAL is not nil."
+ (assert-nil (not actual) fail-message test-info "assert-t"))
+
+(defun assert-nil (actual &optional fail-message test-info assert-type)
+ "expectation is that ACTUAL is nil. FAIL-MESSAGE is an optional
+additional message to be displayed. Since several assertions
+funnel down to this one, ASSERT-TYPE is an optional type."
+ (unless test-info (setq test-info test-simple-info))
+ (incf (test-info-assert-count test-info))
+ (if actual
+ (let* ((fail-message
+ (if fail-message
+ (format "\n\tMessage: %s" fail-message)
+ ""))
+ (test-info-mess
+ (if (boundp 'test-simple-info)
+ (test-info-description test-simple-info)
+ "unset")))
+ (add-failure "assert-nil" test-info-mess fail-message test-info))
+ (ok-msg fail-message)))
+
+(defun add-failure(type test-info-msg fail-msg &optional test-info)
+ (unless test-info (setq test-info test-simple-info))
+ (incf (test-info-failure-count test-info))
+ (let ((failure-msg
+ (format "\nDescription: %s, type %s\n%s" test-info-msg type fail-msg))
+ (old-read-only inhibit-read-only)
+ )
+ (save-excursion
+ (not-ok-msg fail-msg)
+ (test-simple-msg failure-msg 't)
+ (unless noninteractive
+ (if test-simple-debug-on-error
+ (signal 'test-simple-assert-failed failure-msg)
+ ;;(message failure-msg)
+ )))))
+
+(defun end-tests (&optional test-info)
+ "Give a tally of the tests run"
+ (interactive)
+ (unless test-info (setq test-info test-simple-info))
+ (test-simple-describe-failures test-info)
+ (if noninteractive
+ (progn
+ (switch-to-buffer "*test-simple*")
+ (message "%s" (buffer-substring (point-min) (point-max)))
+ )
+ (switch-to-buffer-other-window "*test-simple*")
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Reporting
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun test-simple-msg(msg &optional newline)
+ (switch-to-buffer "*test-simple*")
+ (let ((old-read-only inhibit-read-only))
+ (setq inhibit-read-only 't)
+ (insert msg)
+ (if newline (insert "\n"))
+ (setq inhibit-read-only old-read-only)
+ (switch-to-buffer nil)
+ ))
+
+(defun ok-msg(fail-message &optional test-info)
+ (unless test-info (setq test-info test-simple-info))
+ (let ((msg (if (getenv "USE_TAP")
+ (if (equal fail-message "")
+ (format "ok %d\n" (test-info-assert-count test-info))
+ (format "ok %d - %s\n"
+ (test-info-assert-count test-info)
+ fail-message))
+ ".")))
+ (test-simple-msg msg))
+ 't)
+
+(defun not-ok-msg(fail-message &optional test-info)
+ (unless test-info (setq test-info test-simple-info))
+ (let ((msg (if (getenv "USE_TAP")
+ (format "not ok %d\n" (test-info-assert-count test-info))
+ "F")))
+ (test-simple-msg msg))
+ nil)
+
+(defun test-simple-summary-line(info)
+ (let*
+ ((failures (test-info-failure-count info))
+ (asserts (test-info-assert-count info))
+ (problems (concat (number-to-string failures) " failure"
+ (unless (= 1 failures) "s")))
+ (tests (concat (number-to-string asserts) " assertion"
+ (unless (= 1 asserts) "s")))
+ (elapsed-time (time-since (test-info-start-time info)))
+ )
+ (if (getenv "USE_TAP")
+ (format "1..%d" asserts)
+ (format "\n%s in %s (%g seconds)" problems tests
+ (float-time elapsed-time))
+ )))
+
+(defun test-simple-describe-failures(&optional test-info)
+ (unless test-info (setq test-info test-simple-info))
+ (goto-char (point-max))
+ (test-simple-msg (test-simple-summary-line test-info)))
+
+(provide 'test-simple)
+;;; test-simple.el ends here