[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Unit testing with el-expectations.el and el-mock.el
|
From: |
rubikitch |
|
Subject: |
Unit testing with el-expectations.el and el-mock.el |
|
Date: |
Sat, 19 Apr 2008 03:24:34 +0900 (JST) |
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 <address@hidden>
;; 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 <address@hidden>
;; 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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- Unit testing with el-expectations.el and el-mock.el,
rubikitch <=