168 lines
6.1 KiB
EmacsLisp
168 lines
6.1 KiB
EmacsLisp
;;; elunit.el --- Emacs Lisp Unit Testing framework
|
|
|
|
;; Copyright (C) 2006 Phil Hagelberg
|
|
|
|
;; Adapted-By: Christian M. Ohler
|
|
|
|
;; Inspired by regress.el by Wayne Mesard and Tom Breton, Test::Unit
|
|
;; by Nathaniel Talbott, and xUnit by Kent Beck
|
|
|
|
;; 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 2, 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.
|
|
;;
|
|
;; A copy of the GNU General Public License can be obtained from the
|
|
;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
;; See http://dev.technomancy.us/phil/wiki/ElUnit for usage details.
|
|
|
|
(require 'cl)
|
|
(require 'compile)
|
|
|
|
(defvar *elunit-suites*
|
|
'()
|
|
"A list of unit test suites")
|
|
|
|
(defvar *elunit-default-suite* nil
|
|
"Choice to use for default suite to run (gets updated to last suite run)")
|
|
|
|
(defun elunit-suite (name)
|
|
(cdr (assoc name *elunit-suites*)))
|
|
|
|
(defun elunit-get-test (name suite)
|
|
(when (symbolp suite) (setq suite (elunit-suite suite)))
|
|
(assoc name suite))
|
|
|
|
|
|
;;; Defining tests
|
|
|
|
(defmacro defsuite (suite-name &rest tests)
|
|
"This is what you use to set things up."
|
|
(dolist (test tests)
|
|
(elunit-add-to-suite (make-test test) suite-name)))
|
|
|
|
(defun make-test (body)
|
|
(let ((name (pop body)))
|
|
(list name body buffer-file-name
|
|
(save-excursion
|
|
(condition-case var
|
|
(progn (search-backward (symbol-name name))
|
|
(if (fboundp 'line-number-at-pos)
|
|
(line-number-at-pos)
|
|
'unknown)) ; not a foolproof heuristic to get line number, but good enough.
|
|
(error 'unknown))))))
|
|
|
|
(defun elunit-add-to-suite (test suite)
|
|
(unless (elunit-suite suite) (elunit-make-suite suite))
|
|
(elunit-delete-test (car test) suite)
|
|
(push test (cdr (assoc suite *elunit-suites*))))
|
|
|
|
(defun elunit-make-suite (suite)
|
|
(push (list suite) *elunit-suites*))
|
|
|
|
(defun elunit-delete-test (name suite)
|
|
(when (elunit-get-test name suite)
|
|
(setf (cdr (assoc suite *elunit-suites*)) (assq-delete-all name (elunit-suite suite)))))
|
|
|
|
(defun elunit-clear-suites ()
|
|
(setq *elunit-suites* '((default-suite ()))))
|
|
|
|
|
|
;;; Running the unit tests
|
|
|
|
(defun elunit (suite &optional force-prompt)
|
|
"Run all tests in SUITE (a string), and display the results.
|
|
|
|
Prompt for a suite if FORCE-PROMPT is non-nil, or if both SUITE
|
|
and `*elunit-default-suite*' are nil."
|
|
(interactive "i\nP")
|
|
(unless suite (setq suite *elunit-default-suite*))
|
|
(cond ((null suite)
|
|
(setq suite
|
|
(completing-read
|
|
"Run test suite: "
|
|
(mapcar (lambda (suite) (cons (symbol-name (car suite))
|
|
(symbol-name (car suite))))
|
|
*elunit-suites*)
|
|
nil t)))
|
|
(force-prompt
|
|
(setq suite
|
|
(completing-read
|
|
(format "Run test suite (default %s): " suite)
|
|
(mapcar (lambda (suite) (cons (symbol-name (car suite))
|
|
(symbol-name (car suite))))
|
|
*elunit-suites*)
|
|
nil t nil nil suite)))
|
|
(t (progn)))
|
|
(setq *elunit-default-suite* suite)
|
|
(setq *elunit-fail-count* 0)
|
|
(run-hooks (intern (concat suite "-setup-hook")))
|
|
(with-output-to-temp-buffer "*elunit*"
|
|
(princ (concat "Loaded suite: " suite "\n\n"))
|
|
(let* ((tests (elunit-suite (intern suite)))
|
|
(start-time (cadr (current-time)))
|
|
(total (length tests)))
|
|
(let ((results (loop for test-id from 1
|
|
for test in (reverse tests)
|
|
;; This used to be `with-temp-message', but
|
|
;; writing the boundaries between test cases
|
|
;; into the *Messages* buffer can be
|
|
;; helpful.
|
|
do (message "Running test \"%s\" (%s of %s)..."
|
|
(first test) test-id total)
|
|
collect (apply #'elunit-run-test test))))
|
|
(message "Ran %s tests; %s failed" total *elunit-fail-count*)
|
|
(elunit-report-results results))
|
|
(princ (format " in %d seconds." (- (cadr (current-time)) start-time)))))
|
|
(run-hooks (intern (concat suite "-teardown-hook"))))
|
|
|
|
(defun elunit-run-test (name body file-name line-number)
|
|
(let* ((passed nil)
|
|
(docstring (if (stringp (car body)) (pop body) ""))
|
|
(result (condition-case err
|
|
(save-excursion (eval (cons 'progn body)) (setq passed t))
|
|
(error err))))
|
|
(elunit-status passed)
|
|
(if passed t
|
|
(list name docstring result body file-name line-number *elunit-fail-count*))))
|
|
|
|
|
|
;;; Showing the results
|
|
|
|
(defun elunit-status (pass)
|
|
"Output status while the tests are running"
|
|
(princ (if pass "." "F"))
|
|
(unless pass (incf *elunit-fail-count*)
|
|
(switch-to-buffer "*elunit*")
|
|
;; This doesn't work in XEmacs.
|
|
;; (overlay-put (make-overlay (point) (- (point) 1)) 'face '(foreground-color . "red"))
|
|
(switch-to-buffer nil)))
|
|
|
|
(defun elunit-report-results (tests)
|
|
"For when the tests are finished and we want details"
|
|
(dolist (test tests)
|
|
(unless (eq t test)
|
|
(apply 'elunit-report-result test)))
|
|
(princ (format "\n\n\n%d tests total, %d failures" (length tests) *elunit-fail-count*)))
|
|
|
|
(defun elunit-report-result (name docstring result body file-name line-number index)
|
|
"Report a single test failure"
|
|
(princ (format "\n\n%d) Failure: %s [%s:%s]
|
|
%s
|
|
Result: %s
|
|
Form: %s" index name file-name line-number docstring result (car body))))
|
|
|
|
;(add-hook 'temp-buffer-show-hook 'compilation-minor-mode)
|
|
;(add-to-list 'compilation-error-regexp-alist '("\\[\\([^:]*\\):\\([0-9]+\\)" 1 2))
|
|
;;(add-to-list 'compilation-error-regexp-alist '("\\[\\([^\]]*\\):\\([0-9]+\\)\\]" 1 2))
|
|
|
|
(provide 'elunit)
|
|
|
|
;; end of file
|