-;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp
+;;; test-simple.el --- Simple Unit Test Framework for Emacs Lisp -*- lexical-binding: t -*-
;; Rewritten from Phil Hagelberg's behave.el by rocky
-;; Copyright (C) 2015 Free Software Foundation, Inc
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc
;; Author: Rocky Bernstein <rocky@gnu.org>
;; URL: http://github.com/rocky/emacs-test-simple
;; Keywords: unit-test
-;; Version: 1.1
+;; Package-Requires: ((cl-lib "0"))
+;; Version: 1.2.0
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; test-simple.el is:
;;
-;; * Simple. No need for
+;; * Simple. No need for
;; - context macros,
;; - enclosing specifications,
;; - required test tags.
;; add customized assert failure messages, or add summary messages
;; before a group of tests.
;;
-;; * Accomodates both interactive and non-interactive use.
+;; * Accommodates 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.
+;; 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>
;;
;; (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
+;; Edit (with Emacs of course) gcd-tests.el and run M-x eval-current-buffer
;;
;; You should see in buffer *test-simple*:
;;
-;; test-gcd.el
+;; gcd-tests.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
+;; $ emacs --batch --no-site-file --no-splash --load gcd-tests.el
;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
;; *scratch*
;; ......
;;; To do:
+;; FIXME: Namespace is all messed up!
;; 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)
+(eval-when-compile (require 'cl-lib))
+
+(defgroup test-simple nil
+ "Simple Unit Test Framework for Emacs Lisp"
+ :group 'lisp)
+
+(defcustom test-simple-runner-interface (if (fboundp 'bpr-spawn)
+ 'bpr-spawn
+ 'compile)
+ "Function with one string argument when running tests non-interactively.
+Command line started with `emacs --batch' is passed as the argument.
+
+`bpr-spawn', which is in bpr package, is preferable because of no window popup.
+If bpr is not installed, fall back to `compile'."
+ :type 'function
+ :group 'test-simple)
+
+(defcustom test-simple-runner-key "C-x C-z"
+ "Key to run non-interactive test after defining command line by `test-simple-run'."
+ :type 'string
+ :group 'test-simple)
(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
+(cl-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
"Variable to store testing information for a buffer.")
(defun note (description &optional test-info)
- "Adds a name to a group of tests."
+ "Add a name to a group of tests."
(if (getenv "USE_TAP")
(test-simple-msg (format "# %s" description) 't)
(if (> test-simple-verbosity 0)
;;;###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."
+ "Initialize and reset 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")
;; Assertion tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defmacro assert-raises (error-condition body &optional fail-message test-info)
+(defmacro assert-raises (error-condition body &optional fail-message)
(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 'assert-t nil fail-message))
(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."
+ "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))
+ (cl-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))
+ (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)))
+ (test-simple--add-failure (format "assert-%s" op) test-info-mess
+ (concat fail-message expect-message)))
+ (test-simple--ok-msg fail-message)))
(defun assert-equal (expected actual &optional fail-message test-info)
- "expectation is that ACTUAL should be equal to EXPECTED."
+ "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."
+ "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."
+ "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."
+ "Expectation is that ACTUAL should match EXPECTED-REGEXP."
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-assert-count test-info))
+ (cl-incf (test-info-assert-count test-info))
(if (not (string-match expected-regexp actual))
(let* ((fail-message
(if fail-message
(if (boundp 'test-info)
(test-info-description test-info)
"unset")))
- (add-failure "assert-equal" test-info-mess
- (concat expect-message fail-message)))
+ (test-simple--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"))
+ (assert-nil (not actual) fail-message test-info))
-(defun assert-nil (actual &optional fail-message test-info assert-type)
+(defun assert-nil (actual &optional fail-message test-info)
"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."
+additional message to be displayed."
(unless test-info (setq test-info test-simple-info))
- (incf (test-info-assert-count test-info))
+ (cl-incf (test-info-assert-count test-info))
(if actual
(let* ((fail-message
(if fail-message
(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)))
+ (test-simple--add-failure "assert-nil" test-info-mess
+ fail-message test-info))
+ (test-simple--ok-msg fail-message)))
-(defun add-failure(type test-info-msg fail-msg &optional test-info)
+(defun test-simple--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))
+ (cl-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--not-ok-msg fail-msg)
(test-simple-msg failure-msg 't)
(unless noninteractive
(if test-simple-debug-on-error
)))))
(defun end-tests (&optional test-info)
- "Give a tally of the tests run"
+ "Give a tally of the tests run."
(interactive)
(unless test-info (setq test-info test-simple-info))
(test-simple-describe-failures test-info)
(defun test-simple-msg(msg &optional newline)
(switch-to-buffer "*test-simple*")
- (let ((old-read-only inhibit-read-only))
- (setq inhibit-read-only 't)
+ (let ((inhibit-read-only t))
(insert msg)
- (if newline (insert "\n"))
- (setq inhibit-read-only old-read-only)
- (switch-to-buffer nil)
- ))
+ (if newline (insert "\n")))
+ (switch-to-buffer nil))
-(defun ok-msg(fail-message &optional test-info)
+(defun test-simple--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 "")
(test-simple-msg msg))
't)
-(defun not-ok-msg(fail-message &optional test-info)
+(defun test-simple--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))
(goto-char (point-max))
(test-simple-msg (test-simple-summary-line test-info)))
+;;;###autoload
+(defun test-simple-run (&rest command-line-formats)
+ "Register command line to run tests non-interactively and bind key to run test.
+After calling this function, you can run test by key specified by `test-simple-runner-key'.
+
+It is preferable to write at the first line of test files as a comment, e.g,
+;;;; (test-simple-run \"emacs -batch -L %s -l %s\" (file-name-directory (locate-library \"test-simple.elc\")) buffer-file-name)
+
+Calling this function interactively, COMMAND-LINE-FORMATS is set above."
+ (interactive)
+ (setq command-line-formats
+ (or command-line-formats
+ (list "emacs -batch -L %s -l %s"
+ (file-name-directory (locate-library "test-simple.elc"))
+ buffer-file-name)))
+ (let ((func (lambda ()
+ (interactive)
+ (funcall test-simple-runner-interface
+ (apply 'format command-line-formats)))))
+ (global-set-key (kbd test-simple-runner-key) func)
+ (funcall func)))
+
+(defun test-simple-noninteractive-kill-emacs-hook ()
+ "Emacs exits abnormally when noninteractive test fails."
+ (when (and noninteractive test-simple-info
+ (<= 1 (test-info-failure-count test-simple-info)))
+ (let (kill-emacs-hook)
+ (kill-emacs 1))))
+(when noninteractive
+ (add-hook 'kill-emacs-hook 'test-simple-noninteractive-kill-emacs-hook))
+
+
(provide 'test-simple)
;;; test-simple.el ends here