You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
479 lines
16 KiB
479 lines
16 KiB
;;; 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, 2016, 2017 Free Software Foundation, Inc
|
|
|
|
;; Author: Rocky Bernstein <rocky@gnu.org>
|
|
;; URL: http://github.com/rocky/emacs-test-simple
|
|
;; Keywords: unit-test
|
|
;; Package-Requires: ((cl-lib "0"))
|
|
;; Version: 1.3.0
|
|
|
|
;; 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.
|
|
;;
|
|
;; * 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.
|
|
;; - 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) gcd-tests.el and run M-x eval-current-buffer
|
|
;;
|
|
;; You should see in buffer *test-simple*:
|
|
;;
|
|
;; 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 gcd-tests.el
|
|
;; Loading /src/external-vcs/emacs-test-simple/example/gcd.el (source)...
|
|
;; *scratch*
|
|
;; ......
|
|
;; 0 failures in 6 assertions (0.000723 seconds)
|
|
|
|
;;; To do:
|
|
|
|
;; FIXME: Namespace is all messed up!
|
|
;; Main issues: more expect predicates
|
|
|
|
(require 'time-date)
|
|
|
|
;;; Code:
|
|
|
|
;; Press C-x C-e at the end of the next line configure the program in GNU emacs
|
|
;; for building via "make" to get set up.
|
|
;; (compile (format "EMACSLOADPATH=:%s ./autogen.sh" "."))
|
|
;; After that you can run:
|
|
;; (compile "make check")
|
|
|
|
(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.")
|
|
|
|
(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
|
|
(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)
|
|
"Add 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)
|
|
"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
|
|
(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)
|
|
(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))
|
|
(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))
|
|
(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))
|
|
(test-info-mess
|
|
(if (boundp 'test-info)
|
|
(test-info-description test-info)
|
|
"unset")))
|
|
(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."
|
|
(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))
|
|
(cl-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")))
|
|
(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))
|
|
|
|
(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."
|
|
(unless test-info (setq test-info test-simple-info))
|
|
(cl-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")))
|
|
(test-simple--add-failure "assert-nil" test-info-mess
|
|
fail-message test-info))
|
|
(test-simple--ok-msg fail-message)))
|
|
|
|
(defun test-simple--add-failure (type test-info-msg fail-msg
|
|
&optional test-info)
|
|
(unless test-info (setq test-info test-simple-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))
|
|
)
|
|
(save-excursion
|
|
(test-simple--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)
|
|
(cond (noninteractive
|
|
(set-buffer "*test-simple*")
|
|
(cond ((getenv "USE_TAP")
|
|
(princ (format "%s\n" (buffer-string)))
|
|
)
|
|
(t ;; non-TAP goes to stderr (backwards compatibility)
|
|
(message "%s" (buffer-substring (point-min) (point-max)))
|
|
)))
|
|
(t ;; interactive
|
|
(switch-to-buffer-other-window "*test-simple*")
|
|
)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Reporting
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun test-simple-msg(msg &optional newline)
|
|
(switch-to-buffer "*test-simple*")
|
|
(let ((inhibit-read-only t))
|
|
(insert msg)
|
|
(if newline (insert "\n"))
|
|
(switch-to-buffer nil)
|
|
))
|
|
|
|
(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 "")
|
|
(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 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))
|
|
"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)))
|
|
|
|
;;;###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))
|
|
|
|
;;;; ChangeLog:
|
|
|
|
;; 2017-05-25 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge commit '604942d36021a8b14877a0a640234a09c79e0927'
|
|
;;
|
|
;; 2016-03-03 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Version 1.2.0 Sync with github
|
|
;;
|
|
;; github syohex:
|
|
;; * Switch from Carton to Cask
|
|
;;
|
|
;; rubikitch@ruby-lang.org:
|
|
;; * test-simple.el: test-simple-run: make it a command.
|
|
;; * README.md: Mention test-simple-run
|
|
;; * example/gcd-tests.el: gcd-tests.el: Add test-simple-run comment line
|
|
;; * test-simple.el: Emacs exits abnormally when noninteractive test fails.
|
|
;; * test-simple.el: New function `test-simple-run': register test You can
|
|
;; run tests easily by pressing C-x C-z.
|
|
;; * test-basic.el: fix botched joke
|
|
;;
|
|
;; 2016-03-03 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs/elpa
|
|
;;
|
|
;; 2015-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
|
|
;;
|
|
;; * packages/test-simple/test-simple.el: Use cl-lib
|
|
;;
|
|
;; (test-simple-msg): Let-bind inhibit-read-only directly.
|
|
;; (test-simple--ok-msg, test-simple--not-ok-msg): Rename from ok-msg and
|
|
;; not-ok-msg.
|
|
;; * packages/test-simple/ChangeLog: Remove empty file.
|
|
;;
|
|
;; 2015-03-31 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge commit 'bb13df55aa357538f95c3a8a28cac18533f5d164'
|
|
;;
|
|
;; 2015-02-16 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge commit '3fd5ea161e41d94902ef499b41f7032ef07f6430'
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge commit 'ec7ba4f2dbae0901724483de5868127a1cbc38e9'
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Merge commit '7fe5510edce15f5733552bb4d9de4f5ab1e0de76'
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Add 'packages/test-simple/' from commit
|
|
;; '75eea25bae04d8e5e3e835a2770f02f0ff4602c4'
|
|
;;
|
|
;; git-subtree-dir: packages/test-simple git-subtree-mainline:
|
|
;; bfb36f072e1d8b382639bd5cc6087fb0c963894b git-subtree-split:
|
|
;; 75eea25bae04d8e5e3e835a2770f02f0ff4602c4
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Oops - should have added in branch externals/<pkg>
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Add 'packages/test-simple/' from commit
|
|
;; '75eea25bae04d8e5e3e835a2770f02f0ff4602c4'
|
|
;;
|
|
;; git-subtree-dir: packages/test-simple git-subtree-mainline:
|
|
;; b3736acc55750eb13c8d21579ce022bc5a077568 git-subtree-split:
|
|
;; 75eea25bae04d8e5e3e835a2770f02f0ff4602c4
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; Remove realgud and dependents as a git submodule
|
|
;;
|
|
;; 2015-02-15 rocky <rocky@gnu.org>
|
|
;;
|
|
;; New gud replacement package: realgud (a front end interface to
|
|
;; debuggers).
|
|
;;
|
|
;; This package requires:
|
|
;;
|
|
;; * loc-changes - location marks in buffers
|
|
;; * load-relative - load emacs lisp relative to emacs source
|
|
;; * test-simple - simple test framework.
|
|
;;
|
|
;; Using .gitmodules in this way is a bit of an experiment. Currently these
|
|
;; four projects are separate github repositories.
|
|
;;
|
|
|
|
|
|
|
|
(provide 'test-simple)
|
|
;;; test-simple.el ends here
|