;;; elk-test.el --- Emacs Lisp testing suite ;; Copyright (C) 2006 Nikolaj Schumacher ;;; License ;; 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 ;; 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, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; Usage ;; Use `deftest' to define a test and `run-elk-test' to run it. ;; Create test bundles with `defsuite' or `build-suite'. ;; Verify your code with `assert-equal', `assert-eq', `assert-eql', ;; `assert-nonnil', `assert-t', `assert-nil' and `assert-error' ;; to verify your code. ;;; Examples ;; (deftest "test1" ;; (assert-equal t t) ;; (assert-eq t 'foo)) ;; (defsuite "suite1" ;; (deftest "test1" (assert-equal t t))) ;; (deftest "test2" ;; (assert-equal t t)) ;; (build-suite "combined-suite" "test1" "test2") ;; (run-elk-test "combined-suite") ;; (run-elk-test) (require 'cl) (defvar elk-test-run-on-define nil "If non-nil, run elk-test tests/suites immediately when defining them.") (defvar elk-test-map (make-hash-table :test 'equal) "A map of elk-test test/suite names to their implementation.") (defvar elk-test-list nil "A list of all defined elk-test tests/suites.") (defun elk-test-clear () "Remove all tests from memory." (setq elk-test-map (make-hash-table :test 'equal) elk-test-list nil)) (defun run-elk-test (name &optional string-result) "Run the test case defined as NAME. The result is a list of errors strings, unless STRING-RESULT is set, in which case a message describing the errors or success is displayed and returned." (interactive (list (completing-read "Test name: " elk-test-list nil t))) (let ((name name)) (let ((elk-test-errors nil) (test-or-suite (gethash name elk-test-map))) (if (not test-or-suite) (error "Undefined test <%s>" name) (if (equal (car test-or-suite) 'suite) ;; is test suite (let ((map (cadr test-or-suite))) (dolist (test (caddr test-or-suite)) (setq elk-test-errors (append elk-test-errors (run-elk-test-internal (gethash test map)))))) ;; is simple test (setq elk-test-errors (run-elk-test-internal test-or-suite))) (if (or string-result (interactive-p)) (message (if elk-test-errors (mapconcat 'identity elk-test-errors "\n") "Test run was successful.")) elk-test-errors))))) (defun run-elk-tests-buffer (&optional buffer) "Execute BUFFER as lisp code and run all tests therein." (interactive) (let* ((elk-test-list) (elk-test-map (make-hash-table :test 'equal)) (elk-test-run-on-define nil) (inhibit-read-only t) (buffer-name (buffer-name buffer)) (success t) (parse-res (condition-case err (eval-buffer buffer) (error err)))) (if parse-res (message "Parsing buffer <%s> failed:\n%s" buffer-name parse-res) (let ((out-buffer (get-buffer-create (concat "*elk-test run " buffer-name "*"))) failure) (with-current-buffer out-buffer (erase-buffer) (dolist (test elk-test-list) (message "running <%s>" test) (let ((results (run-elk-test test))) (when results (setq failure t) (insert "test <" test "> failed:\n") (dolist (result results) (insert "* " result "\n")))))) (if failure (display-buffer out-buffer) (kill-buffer out-buffer) (message "Test run was successful.")))))) (defun run-elk-test-internal (test) (let ((elk-test-errors nil)) (dolist (sexpr test) (let ((problem (condition-case err (progn (eval sexpr) nil) (error err)))) (when problem (push (message "%s" problem) elk-test-errors)))) elk-test-errors)) (defmacro elk-test-error (format-string &rest args) "Create an error string as the result of a failed elk-test assertion. The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details. The result will be displayed, returned and if called inside of `run-elk-test' added to the internal error list." `(let ((string (message ,format-string ,@args))) (when (boundp 'elk-test-errors) (push string elk-test-errors)) string)) (defmacro assert-equal (expected actual) "Assert that ACTUAL equals EXPECTED, or signal a warning." `(unless (equal ,expected ,actual) (elk-test-error "assert-equal for <%s> failed: expected <%s>, was <%s>" ',actual ,expected ,actual))) (defmacro assert-eq (expected actual) "Assert that ACTUAL equals EXPECTED, or signal a warning." `(unless (eq ,expected ,actual) (elk-test-error "assert-eq for <%s> failed: expected <%s>, was <%s>" ',actual ,expected ,actual))) (defmacro assert-eql (expected actual) "Assert that ACTUAL equals EXPECTED, or signal a warning." `(unless (eql ,expected ,actual) (elk-test-error "assert-eql for <%s> failed: expected <%s>, was <%s>" ',actual ,expected ,actual))) (defmacro assert-nonnil (value) "Assert that VALUE is not nil, or signal a warning." `(unless ,value (elk-test-error "assert-nonnil for <%s> failed: was <%s>" ',value ,value))) (defmacro assert-t (value) "Assert that VALUE is t, or signal a warning." `(unless (eq ,value t) (elk-test-error "assert-t for <%s> failed: was <%s>" ',value ,value))) (defmacro assert-nil (value) "Assert that VALUE is nil, or signal a warning." `(when ,value (elk-test-error "assert-nil for <%s> failed: was <%s>" ',value ,value))) (defmacro assert-error (error-message &rest body) "Assert that BODY raises an `error', or signal a warning. ERROR-MESSAGE is the expected error string, use nil to accept any error. Use nil with caution, as errors like 'wrong-number-of-arguments' (likely caused by typos) will also be caught!" `(let ((elk-test-error (condition-case elk-test-error (progn ,@body) (error (cons 'elk-test-error (cadr elk-test-error)))))) (if (not (eq (car elk-test-error) 'elk-test-error)) ;; no error (elk-test-error "assert-error for <%s> failed: did not raise an error" (append '(progn) ',body)) (when (and ,error-message (not (equal ,error-message (cdr elk-test-error)))) (elk-test-error (concat "assert-error for <%s> failed: expected <%s>, " "raised <%s>") (append '(progn) ',body) ,error-message (cdr elk-test-error)))))) (defmacro deftest (name &rest body) "Define a test case. Use `assert-equal', `assert-eq', `assert-eql', `assert-nonnil', `assert-t', `assert-nil' and `assert-error' to verify the code." `(progn (unless (gethash ,name elk-test-map) (push ,name elk-test-list)) (puthash ,name ',body elk-test-map) ,(if elk-test-run-on-define `(run-elk-test ',name ,t) name))) (defmacro defsuite (name &rest body) "Define a test suite using a collection of `deftest' forms. The resulting suite can be called with `run-elk-test' and parameter NAME." `(let ((suite (let ((elk-test-map (make-hash-table :test 'equal)) (elk-test-list nil)) ,@body (list 'suite elk-test-map (reverse elk-test-list))))) (unless (gethash ,name elk-test-map) (push ,name elk-test-list)) (puthash ,name suite elk-test-map) ,(if elk-test-run-on-define `(run-elk-test ,name t) name))) (defun build-suite (name &rest tests) "Define a test suite using a collection of test names. The resulting suite can be run by calling `run-elk-test' with parameter NAME." (unless (gethash name elk-test-map) (push name elk-test-list)) (puthash name (let ((map (make-hash-table :test 'equal)) (list nil)) (dolist (test-name tests) (push test-name list) (when (gethash test-name map) (error "Test used twice")) (let ((test (gethash test-name elk-test-map))) (unless test (error "Undefined test <%s>" test-name)) (puthash test-name test map))) (list 'suite map (reverse list))) elk-test-map) (if elk-test-run-on-define (run-elk-test "sample suite" t) name)) (provide 'elk-test)