Hi, I released Emacs Lisp Expectations (el-expectations.el) and Emacs Lisp Mock (el-mock.el), unit testing framework. Utilizing them will facilitate Test Driven Development in Emacs Lisp.
http://www.emacswiki.org/cgi-bin/emacs/EmacsLispExpectation http://www.emacswiki.org/cgi-bin/emacs/EmacsLispMock Emacs Lisp Expectations is the simplest unit testing framework. It is very easy to use/read. Emacs Lisp Expectations is modeled after Ruby's expectations by Jay Fields (http://expectations.rubyforge.org/). It inherits testing policy; designed to encourage unit testing best practices such as * discourage setting more than one expectation at a time * promote maintainability by not providing a setup or teardown method * provide one syntax for setting up state based or behavior based expectation * focus on readability by providing no mechanism for describing an expectation other than the code in the expectation. Emacs Lisp Mock is a DSL based mock/stub framework. It is easy to use. Emacs Lisp Mock is a library for mocking and stubbing using readable syntax. Most commonly Emacs Lisp Mock is used in conjunction with Emacs Lisp Expectations, but it can be used in other contexts. Example1: (expectations ;; State based expectation where a value equals another value (expect 2 (+ 1 1)) ;; State based expectation where an error is expected ;; Simply expect error symbol of the intended exception (expect (error void-function '(no-function)) (no-function)) ;; Behavior based test using a traditional mock ;; TODO implement times. (expect (mock (dial * "2125551212") => nil) (dial 'phone "2125551212") (dial 'phone "2125551212")) ;; Behavior based test on a concrete mock (expect (mock (deal *)) (deal 'object)) ;; State based test utilizing a stub (expect 2 (stub two => 2) (two)) ;; State based test utilizing a concrete mock (expect 2 (mock (bar *) => 2) (bar 'object)) ;; Behavior based test utilizing a stub and a concrete mock (expect 1 (mock (give-me-three 3) => 1) (stub three => 3) (give-me-three (three))) ;; State based test matching a Regexp (expect (regexp "string") "a string") ;; State based test to determine if the object is an instance of sequence (expect (type sequence) ()) ;; State based test to determine if the object is an instance of the class (expect (type string) "a string")) Example2: (expectations (desc "unit test for find-file") ;; Assume that find-file calls (find-file-noselect "foo.el" nil nil nil). (expect (mock (find-file-noselect "foo.el" nil nil nil)) ;; Avoid side-effect of `switch-to-buffer' (stub switch-to-buffer) (find-file "foo.el")) ;; Assume that find-file calls `switch-to-buffer' with return value of `find-file-noselect'. (expect (mock (switch-to-buffer 'buf)) ;; Avoid side-effect of `find-file-noselect' (stub find-file-noselect => 'buf) (find-file "foo.el"))) -- rubikitch Blog: http://d.hatena.ne.jp/rubikitch/ Site: http://www.rubyist.net/~rubikitch/
;;; el-mock.el --- Tiny Mock and Stub framework in Emacs Lisp ;; $Id: el-mock.el,v 1.15 2008/04/18 18:02:24 rubikitch Exp $ ;; Copyright (C) 2008 rubikitch ;; Author: rubikitch <[EMAIL PROTECTED]> ;; Keywords: lisp, testing, unittest ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el ;; This file 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 file 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Emacs Lisp Mock is a library for mocking and stubbing using ;; readable syntax. Most commonly Emacs Lisp Mock is used in ;; conjunction with Emacs Lisp Expectations, but it can be used in ;; other contexts. ;; Emacs Lisp Mock provides two scope interface of mock and stub: ;; `with-mock' and `mocklet'. `with-mock' only defines a ;; scope. `mocklet' is more sophisticated interface than `with-mock': ;; `mocklet' defines local mock and stub like `let', `flet', and ;; `macrolet'. ;; Within `with-mock' body (or argument function specified in ;; `mock-protect'), you can create a mock and a stub. To create a ;; stub, use `stub' macro. To create a mock, use `mock' macro. ;; For further information: see docstrings. ;; [EVAL IT] (describe-function 'with-mock) ;; [EVAL IT] (describe-function 'mocklet) ;; [EVAL IT] (describe-function 'stub) ;; [EVAL IT] (describe-function 'mock) ;;; History: ;; $Log: el-mock.el,v $ ;; Revision 1.15 2008/04/18 18:02:24 rubikitch ;; bug fix about symbol ;; ;; Revision 1.14 2008/04/13 18:23:43 rubikitch ;; removed `message' advice. ;; mock-suppress-redefinition-message: suppress by empty message ;; ;; Revision 1.13 2008/04/12 17:36:11 rubikitch ;; raise mock-syntax-error when invalid `mock' and `stub' spec. ;; ;; Revision 1.12 2008/04/12 17:30:33 rubikitch ;; inhibit using `mock' and `stub' outside `mock-protect' function. ;; ;; Revision 1.11 2008/04/12 17:10:42 rubikitch ;; * added docstrings. ;; * `stublet' is an alias of `mocklet'. ;; ;; Revision 1.10 2008/04/12 16:14:16 rubikitch ;; * allow omission of return value ;; * (mock foo 2) and (stub foo 2) cause error now ;; * arranged test ;; ;; Revision 1.9 2008/04/12 15:10:32 rubikitch ;; changed mocklet syntax ;; ;; Revision 1.8 2008/04/12 14:54:16 rubikitch ;; added Commentary ;; ;; Revision 1.7 2008/04/10 16:14:02 rubikitch ;; fixed advice-related bug ;; ;; Revision 1.6 2008/04/10 14:08:32 rubikitch ;; *** empty log message *** ;; ;; Revision 1.5 2008/04/10 14:01:48 rubikitch ;; arranged code/test ;; ;; Revision 1.4 2008/04/10 12:57:00 rubikitch ;; mock verify ;; ;; Revision 1.3 2008/04/10 07:50:10 rubikitch ;; *** empty log message *** ;; ;; Revision 1.2 2008/04/10 07:48:04 rubikitch ;; New functions: ;; stub/setup ;; stub/teardown ;; stub/parse-spec ;; ;; refactored with-stub-function ;; ;; Revision 1.1 2008/04/10 07:37:54 rubikitch ;; Initial revision ;; ;;; Code: (eval-when-compile (require 'cl)) (require 'advice) ;;;; stub setup/teardown (defun stub/setup (funcsym value) (mock-suppress-redefinition-message (lambda () (when (fboundp funcsym) (put 'mock-original-func funcsym (symbol-function funcsym))) (ad-safe-fset funcsym `(lambda (&rest x) ,value))))) (defun stub/teardown (funcsym) (mock-suppress-redefinition-message (lambda () (let ((func (get 'mock-original-func funcsym))) (if (not func) (fmakunbound funcsym) (ad-safe-fset funcsym func) ;; may be unadviced ))))) ;;;; mock setup/teardown (defun mock/setup (func-spec value) (mock-suppress-redefinition-message (lambda () (let ((funcsym (car func-spec))) (when (fboundp funcsym) (put 'mock-original-func funcsym (symbol-function funcsym))) (put 'mock-not-yet-called funcsym t) (ad-safe-fset funcsym `(lambda (&rest actual-args) (put 'mock-not-yet-called ',funcsym nil) (add-to-list 'mock-verify-list (list ',funcsym ',(cdr func-spec) actual-args)) ,value)))))) (defalias 'mock/teardown 'stub/teardown) ;;;; mock verify (put 'mock-error 'error-conditions '(mock-error error)) (put 'mock-error 'error-message "Mock error") (defun mock-verify () (when (loop for f in -mocked-functions thereis (get 'mock-not-yet-called f)) (signal 'mock-error '(not-called))) (loop for (funcsym expected-args actual-args) in mock-verify-list do (mock-verify-args funcsym expected-args actual-args))) (defun mock-verify-args (funcsym expected-args actual-args) (loop for e in expected-args for a in actual-args do (unless (eq e '*) ; `*' is wildcard argument (unless (equal (eval e) a) (signal 'mock-error (list (cons funcsym expected-args) (cons funcsym actual-args))))))) ;;;; stub/mock provider (defvar -stubbed-functions nil) (defvar -mocked-functions nil) (defvar mock-verify-list nil) (defvar in-mocking nil) (defun mock-protect (body-fn) "The substance of `with-mock' macro. Prepare for mock/stub, call BODY-FN, and teardown mock/stub. For developer: When you adapt Emacs Lisp Mock to a testing framework, wrap test method around this function." (let (mock-verify-list -stubbed-functions -mocked-functions (in-mocking t)) (setplist 'mock-original-func nil) (setplist 'mock-not-yet-called nil) (unwind-protect (funcall body-fn) (mapcar #'stub/teardown -stubbed-functions) (unwind-protect (mock-verify) (mapcar #'mock/teardown -mocked-functions))))) ;;;; message hack (defun mock-suppress-redefinition-message (func) "Erase \"ad-handle-definition: `%s' got redefined\" message." (prog1 (funcall func) (message ""))) (put 'mock-syntax-error 'error-conditions '(mock-syntax-error error)) (put 'mock-syntax-error 'error-message "Mock syntax error") ;;;; User interface (defmacro with-mock (&rest body) "Execute the forms in BODY. You can use `mock' and `stub' in BODY. The value returned is the value of the last form in BODY. After executing BODY, mocks and stubs are guaranteed to be released. Example: (with-mock (stub fooz => 2) (fooz 9999)) ; => 2 " `(mock-protect (lambda () ,@body))) (defalias 'with-stub 'with-mock) (defmacro stub (function &rest rest) "Create a stub for FUNCTION. Stubs are temporary functions which accept any arguments and return constant value. Stubs are removed outside `with-mock' (`with-stub' is an alias) and `mocklet'. Synopsis: * (stub FUNCTION) Create a FUNCTION stub which returns nil. * (stub FUNCTION => RETURN-VALUE) Create a FUNCTION stub which returns RETURN-VALUE. Example: (with-mock (stub foo) (stub bar => 1) (and (null (foo)) (= (bar 7) 1))) ; => t " (let ((value (cond ((eq '=> (car rest)) (cadr rest)) ((null rest) nil) (t (signal 'mock-syntax-error '("Use `(stub FUNC)' or `(stub FUNC => RETURN-VALUE)'")))))) `(if (not in-mocking) (error "Do not use `stub' outside") (stub/setup ',function ',value) (push ',function -stubbed-functions)))) (defmacro mock (func-spec &rest rest) "Create a mock for function described by FUNC-SPEC. Mocks are temporary functions which accept specified arguments and return constant value. If mocked functions are not called or called by different arguments, an `mock-error' occurs. Mocks are removed outside `with-mock' and `mocklet'. Synopsis: * (mock (FUNCTION ARGS...)) Create a FUNCTION mock which returns nil. * (mock (FUNCTION ARGS...) => RETURN-VALUE) Create a FUNCTION mock which returns RETURN-VALUE. Wildcard: The `*' is a special symbol: it accepts any value for that argument position. Example: (with-mock (mock (f * 2) => 3) (mock (g 3)) (and (= (f 9 2) 3) (null (g 3)))) ; => t (with-mock (mock (g 3)) (g 7)) ; (mock-error (g 3) (g 7)) " (let ((value (cond ((eq '=> (car rest)) (cadr rest)) ((null rest) nil) (t (signal 'mock-syntax-error '("Use `(mock FUNC-SPEC)' or `(mock FUNC-SPEC => RETURN-VALUE)'")))))) `(if (not in-mocking) (error "Do not use `mock' outside") (mock/setup ',func-spec ',value) (push ',(car func-spec) -mocked-functions)))) (defun mock-parse-spec (spec) (cons 'progn (mapcar (lambda (args) (cons (if (consp (car args)) 'mock 'stub) args)) spec))) (defun mocklet-function (spec body-func) (with-mock (eval (mock-parse-spec spec)) (funcall body-func))) (defmacro mocklet (speclist &rest body) "`let'-like interface of `with-mock', `mock' and `stub'. Create mocks and stubs described by SPECLIST then execute the forms in BODY. SPECLIST is a list of mock/stub spec. The value returned is the value of the last form in BODY. After executing BODY, mocks and stubs are guaranteed to be released. Synopsis of spec: Spec is arguments of `mock' or `stub'. * ((FUNCTION ARGS...)) : mock which returns nil * ((FUNCTION ARGS...) => RETURN-VALUE) ; mock which returns RETURN-VALUE * (FUNCTION) : stub which returns nil * (FUNCTION => RETURN-VALUE) ; stub which returns RETURN-VALUE Example: (mocklet (((mock-nil 1)) ((mock-1 *) => 1) (stub-nil) (stub-2 => 2)) (and (null (mock-nil 1)) (= (mock-1 4) 1) (null (stub-nil 'any)) (= (stub-2) 2))) ; => t " `(mocklet-function ',speclist (lambda () ,@body))) (defalias 'stublet 'mocklet) (put 'with-mock 'lisp-indent-function 0) (put 'with-stub 'lisp-indent-function 0) (put 'mocklet 'lisp-indent-function 1) (put 'stublet 'lisp-indent-function 1) ;;;; unit test (when (fboundp 'expectations) (expectations (desc "stub setup/teardown") (expect 2 (stub/setup 'foo 2) (prog1 (foo 1 2 3) (stub/teardown 'foo))) (expect nil (stub/setup 'foox 2) (foox 1 2 3) (stub/teardown 'foox) (fboundp 'foox)) (desc "with-mock interface") (expect 9801 (with-mock 9801)) (desc "stub macro") (expect nil (with-mock (stub hogehoges) (hogehoges 75))) (expect 2 (with-mock (stub fooz => 2) (fooz 9999))) (expect nil (with-mock (stub fooz => 2) (fooz 3)) (fboundp 'fooz)) (expect nil (with-mock (stub hoge) ;omission of return value (hoge))) (expect 'hoge (with-mock (stub me => 'hoge) (me 1))) (expect 34 (with-mock (stub me => (+ 3 31)) (me 1))) ;; TODO defie mock-syntax-error / detect mock-syntax-error in expectations (desc "abused stub macro") (expect (error mock-syntax-error '("Use `(stub FUNC)' or `(stub FUNC => RETURN-VALUE)'")) (with-mock (stub fooz 7))) (expect (error-message "Do not use `stub' outside") (let (in-mocking) ; while executing `expect', `in-mocking' is t. (stub hahahaha))) (desc "mock macro") (expect 2 (with-mock (mock (foom 5) => 2) (foom 5))) (expect 3 (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (+ (foo 5) (bar 7)))) (expect 3 (flet ((plus () (+ (foo 5) (bar 7)))) (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (plus)))) (expect 1 (with-mock (mock (f * 2) => 1) (f 1 2))) (expect 1 (with-mock (mock (f * (1+ 1)) => (+ 0 1)) ;evaluated (f 1 2))) (expect nil (with-mock (mock (f 2)) ;omission of return value (f 2))) (expect 'hoge (with-mock (mock (me 1) => 'hoge) (me 1))) (expect 34 (with-mock (mock (me 1) => (+ 3 31)) (me 1))) (desc "unfulfilled mock") (expect (error mock-error '((foom 5) (foom 6))) (with-mock (mock (foom 5) => 2) (foom 6))) (expect (error mock-error '((bar 7) (bar 8))) (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (+ (foo 5) (bar 8)))) (expect (error mock-error '(not-called)) (with-mock (mock (foo 5) => 2))) (expect (error mock-error '(not-called)) (with-mock (mock (vi 5) => 2) (mock (foo 5) => 2) (vi 5))) (expect (error mock-error '((f 2) (f 4))) (with-mock (mock (f 2)) ;omission of return value (f 4))) (desc "abused mock macro") (expect (error mock-syntax-error '("Use `(mock FUNC-SPEC)' or `(mock FUNC-SPEC => RETURN-VALUE)'")) (with-mock (mock (fooz) 7))) (expect (error-message "Do not use `mock' outside") (let (in-mocking) ; while executing `expect', `in-mocking' is t. (mock (hahahaha)))) (desc "mock with stub") (expect 8 (with-mock (mock (f 1 2) => 3) (stub hoge => 5) (+ (f 1 2) (hoge 'a)))) (expect (error mock-error '((f 1 2) (f 3 4))) (with-mock (mock (f 1 2) => 3) (stub hoge => 5) (+ (f 3 4) (hoge 'a)))) (desc "with-stub is an alias of with-mock") (expect 'with-mock (symbol-function 'with-stub)) (desc "stublet is an alias of mocklet") (expect 'mocklet (symbol-function 'stublet)) (desc "mock-parse-spec") (expect '(progn (mock (f 1 2) => 3) (stub hoge => 5)) (mock-parse-spec '(((f 1 2) => 3) (hoge => 5)))) (desc "mocklet") (expect 8 (mocklet (((f 1 2) => 3) (hoge => 5)) (+ (f 1 2) (hoge 'a)))) (expect 2 (mocklet ((foo => 2)) (foo 1 2 3))) (expect 3 (defun defined-func (x) 3) (prog1 (mocklet ((defined-func => 3)) (defined-func 3)) (fmakunbound 'defined-func))) (expect nil (mocklet ((f)) ;omission of return value (f 91))) (expect nil (mocklet (((f 76))) ;omission of return value (f 76))) (expect 5 (mocklet ((a => 3) (b => 2)) 1 ;multiple exprs (+ (a 999) (b 7)))) (desc "stub for defined function") (expect "xxx" (defun blah (x) (* x 2)) (prog1 (let ((orig (symbol-function 'blah))) (mocklet ((blah => "xxx")) (blah "xx"))) (fmakunbound 'blah))) (expect t (defun blah (x) (* x 2)) (prog1 (let ((orig (symbol-function 'blah))) (mocklet ((blah => "xx")) (blah "xx")) (equal orig (symbol-function 'blah))) (fmakunbound 'blah))) (desc "stub for adviced function") (expect "xxx" (mock-suppress-redefinition-message ;silence redefinition warning (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga => "xxx")) (fugaga "aaaaa"))) (fmakunbound 'fugaga))))) (expect t (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga => "xx")) (fugaga "aaaaa")) (equal orig (symbol-function 'fugaga))) (fmakunbound 'fugaga))))) (desc "mock for adviced function") (expect "xx" (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet (((fugaga "aaaaa") => "xx")) (fugaga "aaaaa"))) (fmakunbound 'fugaga))))) (expect t (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet (((fugaga "aaaaa") => "xx")) (fugaga "aaaaa")) (equal orig (symbol-function 'fugaga))) (fmakunbound 'fugaga))))) )) (provide 'el-mock) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "el-mock.el") ;;; el-mock.el ends here
;;; el-expectations.el --- minimalist unit testing framework ;; $Id: el-expectations.el,v 1.42 2008/04/14 07:54:27 rubikitch Exp $ ;; Copyright (C) 2008 rubikitch ;; Author: rubikitch <[EMAIL PROTECTED]> ;; Keywords: lisp, testing, unittest ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el ;; This file 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 file 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 GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Emacs Lisp Expectations framework is a minimalist unit testing ;; framework in Emacs Lisp. ;; I love Jay Fields' expectations unit testing framework in Ruby. It ;; provides one syntax and can define various assertions. So I created ;; Emacs Lisp Expectations modeled after expectations in Ruby. ;; Testing policy is same as the original expectations in Ruby. Visit ;; expectations site in rubyforge. ;; http://expectations.rubyforge.org/ ;; With Emacs Lisp Mock (el-mock.el), Emacs Lisp Expectations supports ;; mock and stub, ie. behavior based testing. ;; You can get it from EmacsWiki ;; http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el ;;; Usage: ;; 1. Evaluate an expectations sexp. ;; 2. `M-x expectations-execute' to execute a test. ;; 3. If there are any errors, use M-x next-error (C-x `) and M-x previous-error ;; to go to expect sexp in error. ;; If you evaluated expectations by C-M-x, it is automatically executed. ;; If you type C-u C-u C-M-x, execute expectations with batch-mode. ;; For further information: see docstring of `expectations'. ;; [EVAL IT] (describe-function 'expectations) ;;; Batch Mode: ;; Batch mode can be used with this shell script (el-expectations). ;; Of course, EMACS/OPTIONS/OUTPUT can be customized. ;; ATTENTION! This script is slightly changed since v1.32. ;; #!/bin/sh ;; EMACS=emacs ;; OPTIONS="-L . -L $HOME/emacs/lisp" ;; OUTPUT=/tmp/.el-expectations ;; $EMACS -q --no-site-file --batch $OPTIONS -l el-expectations -f batch-expectations $OUTPUT "$@" ;; ret=$? ;; cat $OUTPUT ;; rm $OUTPUT ;; exit $ret ;; $ el-expectations el-expectations-failure-sample.el ;;; Embedded test: ;; You can embed test using fboundp. ;; (when (fboundp 'expectations) ;; (expectations ;; (expect ...) ;; ... ;; )) ;;; Limitation: ;; * `expectations-execute' can execute one test (sexp). ;;; Examples: ;; Example code is in the EmacsWiki. ;; Success example http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations-success-sample.el ;; Failure example http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations-failure-sample.el ;;; History: ;; $Log: el-expectations.el,v $ ;; Revision 1.42 2008/04/14 07:54:27 rubikitch ;; *** empty log message *** ;; ;; Revision 1.41 2008/04/14 06:58:20 rubikitch ;; *** empty log message *** ;; ;; Revision 1.40 2008/04/14 06:52:39 rubikitch ;; better font-lock ;; ;; Revision 1.39 2008/04/13 11:49:08 rubikitch ;; C-u M-x expectations-execute -> batch-expectations-in-emacs ;; ;; Revision 1.38 2008/04/13 11:39:51 rubikitch ;; better result display. ;; ;; Revision 1.37 2008/04/13 11:30:17 rubikitch ;; expectations-eval-defun ;; batch-expectations-in-emacs ;; ;; Revision 1.36 2008/04/12 18:44:24 rubikitch ;; extend `type' assertion to use predicates. ;; ;; Revision 1.35 2008/04/12 14:10:00 rubikitch ;; updated el-mock info. ;; ;; Revision 1.34 2008/04/12 14:08:28 rubikitch ;; * (require 'el-mock nil t) ;; * updated `expectations' docstring ;; ;; Revision 1.33 2008/04/12 09:49:27 rubikitch ;; *** empty log message *** ;; ;; Revision 1.32 2008/04/12 09:44:23 rubikitch ;; batch-mode: handle multiple lisp files. ;; ;; Revision 1.31 2008/04/12 09:34:32 rubikitch ;; colorize result summary ;; ;; Revision 1.30 2008/04/12 09:19:42 rubikitch ;; show result summary at the top. ;; ;; Revision 1.29 2008/04/12 03:19:06 rubikitch ;; Execute all expectations in batch mode. ;; ;; Revision 1.28 2008/04/12 03:07:43 rubikitch ;; update doc. ;; ;; Revision 1.27 2008/04/10 17:02:40 rubikitch ;; *** empty log message *** ;; ;; Revision 1.26 2008/04/10 14:27:47 rubikitch ;; arranged code ;; font-lock support ;; ;; Revision 1.25 2008/04/10 12:45:57 rubikitch ;; mock assertion ;; ;; Revision 1.24 2008/04/10 08:46:19 rubikitch ;; integration of `stub' in el-mock.el ;; ;; Revision 1.23 2008/04/10 07:11:40 rubikitch ;; error data is evaluated. ;; ;; Revision 1.22 2008/04/10 06:14:12 rubikitch ;; added finish message with current time. ;; ;; Revision 1.21 2008/04/09 20:45:41 rubikitch ;; error assertion: with error data ;; ;; Revision 1.20 2008/04/09 20:02:46 rubikitch ;; error-message assertion ;; ;; Revision 1.19 2008/04/09 15:07:29 rubikitch ;; expectations-execute-at-once, eval-defun advice ;; ;; Revision 1.18 2008/04/09 08:57:37 rubikitch ;; Batch Mode documentation ;; ;; Revision 1.17 2008/04/09 08:52:34 rubikitch ;; * (eval-when-compile (require 'cl)) ;; * avoid a warning ;; * count expectations/failures/errors ;; * exitstatus = failures + errors (batch mode) ;; ;; Revision 1.16 2008/04/09 04:03:11 rubikitch ;; batch-expectations: use command-line-args-left ;; ;; Revision 1.15 2008/04/09 03:54:00 rubikitch ;; refactored ;; batch-expectations ;; ;; Revision 1.14 2008/04/08 17:54:02 rubikitch ;; fixed typo ;; ;; Revision 1.13 2008/04/08 17:45:08 rubikitch ;; documentation. ;; renamed: expectations.el -> el-expectations.el ;; ;; Revision 1.12 2008/04/08 16:54:50 rubikitch ;; changed output format slightly ;; ;; Revision 1.11 2008/04/08 16:37:53 rubikitch ;; error assertion ;; ;; Revision 1.10 2008/04/08 15:52:14 rubikitch ;; refactored ;; ;; Revision 1.9 2008/04/08 15:39:06 rubikitch ;; *** empty log message *** ;; ;; Revision 1.8 2008/04/08 15:38:03 rubikitch ;; reimplementation of exps-assert-* ;; ;; Revision 1.7 2008/04/08 15:06:42 rubikitch ;; better failure handling ;; ;; Revision 1.6 2008/04/08 14:45:58 rubikitch ;; buffer assertion ;; regexp assertion ;; type assertion ;; ;; Revision 1.5 2008/04/08 13:16:16 rubikitch ;; removed elk-test dependency ;; ;; Revision 1.4 2008/04/08 12:55:15 rubikitch ;; next-error/occur-like interface ;; ;; Revision 1.3 2008/04/08 09:08:54 rubikitch ;; prettier `desc' display ;; ;; Revision 1.2 2008/04/08 08:45:46 rubikitch ;; exps-last-filename ;; ;; Revision 1.1 2008/04/08 07:52:30 rubikitch ;; Initial revision ;; ;;; Code: (eval-when-compile (require 'cl)) (require 'el-mock nil t) (defgroup el-expectations nil "Emacs Lisp Expectations - minimalist unit testing framework." :group 'lisp) (defvar exps-last-testcase nil) (defvar exps-last-filename nil) (defvar expectations-result-buffer "*expectations result*") (defcustom expectations-execute-at-once t "If non-nil, execute selected expectation when pressing C-M-x" :group 'el-expectations) (defmacro expectations (&rest body) "Define a expectations test case. Use `expect' and `desc' to verify the code. Note that these are neither functions nor macros. These are keywords in expectations Domain Specific Language(DSL). Synopsis: * (expect EXPECTED-VALUE BODY ...) Assert that the evaluation result of BODY is `equal' to EXPECTED-VALUE. * (desc DESCRIPTION) Description of a test. It is treated only as a delimiter comment. Synopsis of EXPECTED-VALUE: * (buffer BUFFER-NAME) Body should eq buffer object of BUFFER-NAME. Example: (expect (buffer \"*scratch*\") (with-current-buffer \"*scratch*\" (current-buffer))) * (regexp REGEXP) Body should match REGEXP. Example: (expect (regexp \"o\") \"hoge\") * (type TYPE-SYMBOL) Body should be a TYPE-SYMBOL. TYPE-SYMBOL may be one of symbols returned by `type-of' function. `symbol', `integer', `float', `string', `cons', `vector', `char-table', `bool-vector', `subr', `compiled-function', `marker', `overlay', `window', `buffer', `frame', `process', `window-configuration' Otherwise using predicate naming TYPE-SYMBOL and \"p\". For example, `(type sequence)' uses `sequencep' predicate. `(type char-or-string)' uses `char-or-string-p' predicate. Example: (expect (type buffer) (current-buffer)) (expect (type sequence) nil) (expect (type char-or-string) \"a\") * (error) Body should raise any error. Example: (expect (error) (/ 1 0)) * (error ERROR-SYMBOL) Body should raise ERROR-SYMBOL error. Example: (expect (error arith-error) (/ 1 0)) * (error ERROR-SYMBOL ERROR-DATA) Body should raise ERROR-SYMBOL error with ERROR-DATA. ERROR-DATA is 2nd argument of `signal' function. Example: (expect (error wrong-number-of-arguments '(= 3)) (= 1 2 3 )) * (error-message ERROR-MESSAGE) Body should raise any error with ERROR-MESSAGE. Example: (expect (error-message \"ERROR!!\") (error \"ERROR!!\")) * (mock MOCK-FUNCTION-SPEC => MOCK-RETURN-VALUE) Body should call MOCK-FUNCTION-SPEC and returns MOCK-RETURN-VALUE. Mock assertion depends on `el-mock' library. If available, you do not have to require it: el-expectations detects it. Synopsis of MOCK-FUNCTION-SPEC: (FUNCTION ARGUMENT ...) MOCK-FUNCTION-SPEC is almost same as normal function call. If you should specify `*' as ARGUMENT, any value is accepted. Otherwise, body should call FUNCTION with specified ARGUMENTs. Example: (expect (mock (foo * 3) => nil) (foo 9 3)) * any other SEXP Body should equal (eval SEXP). Example: (expect '(1 2) (list 1 2)) Extending EXPECTED-VALUE is easy. See el-expectations.el source code. Example: (expectations (desc \"simple expectation\") (expect 3 (+ 1 2)) (expect \"hoge\" (concat \"ho\" \"ge\")) (expect \"fuga\" (set-buffer (get-buffer-create \"tmp\")) (erase-buffer) (insert \"fuga\") (buffer-string)) (desc \"extended expectation\") (expect (buffer \"*scratch*\") (with-current-buffer \"*scratch*\" (current-buffer))) (expect (regexp \"o\") \"hoge\") (expect (type integer) 3) (desc \"error expectation\") (expect (error arith-error) (/ 1 0)) (expect (error) (/ 1 0)) (desc \"mock with stub\") (expect (mock (foo 5 * 7) => nil) ;; Stub function `hoge', which accepts any arguments and returns 3. (stub hoge => 3) (foo (+ 2 (hoge 10)) 6 7)) ) " (if noninteractive `(setq exps-last-testcase ',(append exps-last-testcase '((new-expectations 1)) body) exps-last-filename nil) `(setq exps-last-testcase ',body exps-last-filename ,(or load-file-name buffer-file-name)))) (defun exps-execute-test (test) (destructuring-bind (expect expected . actual) test (case expect (expect (condition-case e (exps-assert expected actual) (error (cons 'error e)))) (desc (cons 'desc expected)) (new-expectations (cons 'desc (concat "+++++ New expectations +++++")))))) (defun expectations-execute (&optional testcase) "Execute last-defined `expectations' test. With prefix argument, do `batch-expectations-in-emacs'." (interactive) (if current-prefix-arg (batch-expectations-in-emacs) (exps-display (loop for test in (or testcase exps-last-testcase) collecting (exps-execute-test test))))) ;;;; assertions (defvar exps-assert-functions '(exps-assert-buffer exps-assert-regexp exps-assert-type exps-assert-error exps-assert-error-message exps-assert-mock exps-assert-equal-eval)) (defun exps-do-assertion (expected actual symbol evalp test-func msg-func &optional expected-get-func) (and (consp expected) (eq symbol (car expected)) (exps-do-assertion-1 (funcall (or expected-get-func #'cadr) expected) actual evalp test-func msg-func))) (defun exps-do-assertion-1 (expected actual evalp test-func msg-func) (if evalp (setq actual (exps-eval-sexps actual))) (if (funcall test-func expected actual) '(pass) (cons 'fail (funcall msg-func expected actual)))) (defun exps-eval-sexps (sexps) (let ((fn (lambda () (eval `(progn ,@sexps))))) (if (fboundp 'mock-protect) (mock-protect fn) (funcall fn)))) (defun exps-assert-buffer (expected actual) (exps-do-assertion expected actual 'buffer t (lambda (e a) (eq (get-buffer e) a)) (lambda (e a) (format "FAIL: Expected <#<buffer %s>> but was <%S>" e a)))) (defun exps-assert-regexp (expected actual) (exps-do-assertion expected actual 'regexp t (lambda (e a) (string-match e a)) (lambda (e a) (format "FAIL: %S should match /%s/" a e)))) (defun exps-assert-type (expected actual) (exps-do-assertion expected actual 'type t (lambda (e a) (or (eq (type-of a) e) (let* ((name (symbol-name e)) (pred (intern (concat name (if (string-match "-" name) "-p" "p"))))) (when (fboundp pred) (funcall pred a))))) (lambda (e a) (format "FAIL: %S is not a %s" a e)))) (defun exps-assert-error (expected actual) (let (actual-error actual-errdata) (exps-do-assertion expected actual 'error nil (lambda (e a) (condition-case err (progn (exps-eval-sexps a) nil) (error (setq actual-error err) (cond ((consp (cadr e)) (and (eq (car e) (car err)) (equal (setq actual-errdata (eval (cadr e))) (cdr err)))) (e (equal e err)) (t t))))) (lambda (e a) (let ((error-type (car e)) (actual-err-string (if actual-error (format ", but raised <%S>" actual-error) ", but no error was raised"))) (cond ((and error-type (eq error-type (car actual-error))) (format "FAIL: Expected errdata <%S>, but was <%S>" actual-errdata (cdr actual-error))) (error-type (format "FAIL: should raise <%s>%s" error-type actual-err-string)) (t (format "FAIL: should raise any error%s" actual-err-string))))) #'cdr))) (defun exps-assert-error-message (expected actual) (let (actual-error-string) (exps-do-assertion expected actual 'error-message nil (lambda (e a) (condition-case err (progn (exps-eval-sexps a) nil) (error (setq actual-error-string (error-message-string err)) (equal e actual-error-string)))) (lambda (e a) (if actual-error-string (format "FAIL: Expected errmsg <%s>, but was <%s>" e actual-error-string) (format "FAIL: Expected errmsg <%s>, but no error was raised" e)))))) (defun exps-assert-mock (expected actual) (let (err) (exps-do-assertion expected actual 'mock nil (lambda (e a) (condition-case me (progn (mock-protect (lambda () (eval `(mock ,@e)) (eval `(progn ,@a)))) t) (mock-error (setq err me) nil)) (if err nil t)) (lambda (e a) (if (eq 'not-called (cadr err)) (format "FAIL: Expected function call <%S>" e) (destructuring-bind (_ e-args a-args) err (format "FAIL: Expected call <%S>, but was <%S>" e-args a-args)))) #'cdr))) (defun exps-assert-equal-eval (expected actual) (exps-do-assertion-1 (eval expected) actual t (lambda (e a) (equal e a)) (lambda (e a) (format "FAIL: Expected <%S> but was <%S>" expected a)))) (defun exps-assert (expected actual) (run-hook-with-args-until-success 'exps-assert-functions expected actual)) ;;;; next-error interface / occur-mode-like interface (define-derived-mode exps-display-mode fundamental-mode "EXPECT" (buffer-disable-undo) (setq next-error-function 'exps-next-error) (setq next-error-last-buffer (current-buffer)) (define-key exps-display-mode-map "\C-m" 'exps-goto-expect) (define-key exps-display-mode-map "\C-c\C-c" 'exps-goto-expect)) (defun exps-padding (desc &optional default-width) (let ((width (if noninteractive (or default-width (string-to-number (or (getenv "WIDTH") "60"))) (frame-width (window-frame (get-buffer-window (current-buffer) t)))))) (make-string (floor (/ (- width 8 (length desc)) 2)) ?=))) (defun exps-desc (desc &optional default-width) (let ((padding (exps-padding desc default-width))) (format "%s %s %s" padding desc padding))) (defface expectations-red '((t (:foreground "Red" :bold t))) "Face for expectations with failure." :group 'el-expectations) (defface expectations-green '((t (:foreground "Green" :bold t))) "Face for successful expectations." :group 'el-expectations) (defvar exps-red-face 'expectations-red) (defvar exps-green-face 'expectations-green) (defun exps-result-string (s f e) (let ((msg1 (format "%d expectations, %d failures, %d errors\n" (+ s f e) f e)) (msg2 (format "Expectations finished at %s\n" (current-time-string)))) (put-text-property 0 (length msg1) 'face (if (zerop (+ f e)) exps-green-face exps-red-face) msg1) (concat msg1 msg2))) (defun exps-display (results) (set-buffer (get-buffer-create expectations-result-buffer)) (erase-buffer) (display-buffer (current-buffer)) (exps-display-mode) (insert (format "Executing expectations in %s...\n" exps-last-filename)) (loop for result in results for i from 1 do (insert (format "%-3d:%s\n" i (if (consp result) (case (car result) (pass "OK") (fail (cdr result)) (error (format "ERROR: %s" (cdr result))) (desc (exps-desc (cdr result))) (t "not happened!")) result)))) (insert "\n") (loop for result in results for status = (car result) when (eq 'pass status) collecting result into successes when (eq 'fail status) collecting result into failures when (eq 'error status) collecting result into errors with summary finally (destructuring-bind (s f e) (mapcar #'length (list successes failures errors)) (setq summary (exps-result-string s f e)) (insert summary) (goto-char (point-min)) (forward-line 1) (insert summary) (goto-char (point-min)) (return (+ f e))))) (defun exps-goto-expect () (interactive) ;; assumes that current-buffer is *expectations result* (let ((n (progn (forward-line 0) (looking-at "^[0-9]+") (string-to-number (match-string 0))))) (when exps-last-filename (with-current-buffer (find-file-noselect exps-last-filename) (pop-to-buffer (current-buffer)) (goto-char (point-min)) (search-forward "(expectations\n" nil t) (forward-sexp n) (forward-sexp -1))))) (defun exps-next-error (&optional argp reset) "Move to the Nth (default 1) next failure/error in *expectations result* buffer. Compatibility function for \\[next-error] invocations." (interactive "p") ;; we need to run exps-find-failure from within the *expectations result* buffer (with-current-buffer ;; Choose the buffer and make it current. (if (next-error-buffer-p (current-buffer)) (current-buffer) (next-error-find-buffer nil nil (lambda () (eq major-mode 'exps-display-mode)))) (goto-char (cond (reset (point-min)) ((< argp 0) (line-beginning-position)) ((> argp 0) (line-end-position)) ((point)))) (exps-find-failure (abs argp) (if (> 0 argp) #'re-search-backward #'re-search-forward) "No more failures") ;; In case the *expectations result* buffer is visible in a nonselected window. (let ((win (get-buffer-window (current-buffer) t))) (if win (set-window-point win (point)))) (exps-goto-expect))) (defun exps-find-failure (n search-func errmsg) (loop repeat n do (unless (funcall search-func "^[0-9]+ *:\\(ERROR\\|FAIL\\)" nil t) (error errmsg)))) ;;;; edit support (put 'expect 'lisp-indent-function 1) (put 'expectations 'lisp-indent-function 0) ;; (edit-list (quote font-lock-keywords-alist)) (font-lock-add-keywords 'emacs-lisp-mode '(("\\<\\(expectations\\|expect\\)\\>" 0 font-lock-keyword-face) (exps-font-lock-desc 0 font-lock-warning-face prepend) (exps-font-lock-expected-value 0 font-lock-function-name-face prepend))) (defun exps-font-lock-desc (limit) (when (re-search-forward "(desc\\s " limit t) (backward-up-list 1) (set-match-data (list (point) (progn (forward-sexp 1) (point)))) t)) ;; I think expected value is so-called function name of `expect'. (defun exps-font-lock-expected-value (limit) (when (re-search-forward "(expect\\s " limit t) (forward-sexp 1) (let ((e (point))) (forward-sexp -1) (set-match-data (list (point) e)) t))) (defun expectations-eval-defun (arg) "Do `eval-defun'. If `expectations-execute-at-once' is non-nil, execute expectations if it is an expectations form." (interactive "P") (eval-defun arg) (when expectations-execute-at-once (save-excursion (beginning-of-defun) (and (looking-at "(expectations\\|(.+(fboundp 'expectations)") (expectations-execute))))) (substitute-key-definition 'eval-defun 'expectations-eval-defun emacs-lisp-mode-map)(substitute-key-definition 'eval-defun 'expectations-eval-defun lisp-interaction-mode-map) ;;;; batch mode (defun batch-expectations () (if (not noninteractive) (error "`batch-expectations' is to be used only with -batch")) (destructuring-bind (output-file . lispfiles) command-line-args-left (dolist (lispfile lispfiles) (load lispfile nil t)) (let ((fail-and-errors (expectations-execute))) (with-current-buffer expectations-result-buffer (write-region (point-min) (point-max) output-file nil 'nodisp)) (kill-emacs fail-and-errors)))) (defun batch-expectations-in-emacs () "Execute expectations in current file with batch mode." (interactive) (shell-command (concat "el-expectations " exps-last-filename) expectations-result-buffer) (with-current-buffer expectations-result-buffer (goto-char (point-min)) (while (re-search-forward "^[0-9].+\\([0-9]\\) failures, \\([0-9]+\\) errors" nil t) (put-text-property (match-beginning 0) (match-end 0) 'face (if (and (string= "0" (match-string 1)) (string= "0" (match-string 2))) exps-green-face exps-red-face))))) (provide 'el-expectations) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "el-expectations.el") ;;; el-expectations.el ends here
_______________________________________________ gnu-emacs-sources mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
