adding 'testing tools' section and an ert example to the testing discussion

org-tests/ert-publish-test.el

@@ -0,0 +1,49 @@
+(add-to-list 'load-path (expand-file-name "tools"))
+(require 'ert)
+
+(defun org-export-as-html-test-fixture (file body)
+  "Export the example.org buffer to html, then run the tests in
+body passing in the org-buffer and the html-buffer as arguments"
+  (unwind-protect
+      (let* ((org-buffer (save-excursion (find-file file)
+					 (buffer-name)))
+	     (html-buffer "*Org HTML Export*"))
+	;; setup
+	(set-buffer org-buffer)
+	(call-interactively 'org-export-as-html-to-buffer)
+	(save-excursion
+	  ;; run the tests
+	  (eval (list body org-buffer html-buffer))))
+    (progn
+      ;; clean up
+      (kill-buffer "*Org HTML Export*")
+      (kill-buffer file))))
+
+(defun org-test-search-map-all-org-html-links (buffer body)
+  "for each org link in BUFFER call BODY passing the link-url and
+link-text as arguments."
+  (save-excursion
+    (set-buffer buffer)
+    (goto-char (point-min))
+    (while (re-search-forward "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" nil t)
+      (eval (list body (match-string 1) (replace-regexp-in-string "[\r\n]" " " (match-string 3)))))))
+
+;; this actually defines the test to be run by ert
+(ert-deftest org-test-export-as-html ()
+  (org-export-as-html-test-fixture
+   "example.org"
+   (lambda (org-buffer html-buffer)
+     (org-test-search-map-all-org-html-links
+      org-buffer
+      (lambda (link-url link-text)
+	(save-excursion
+	  (message (format "%s as %s" link-url link-text))
+	  (set-buffer html-buffer)
+	  (goto-char (point-min))
+	  (search-forward link-text)
+	  (re-search-backward "<a href=\"\\(.*\\)\"" nil t)
+	  (should (string= (match-string 1)
+			   link-url))))))))
+
+;; this runs the ert test
+(ert-run-tests-interactively "^org-test-export-" " *org export tests*")

org-tests/example.org

@@ -0,0 +1,21 @@
+#+TITLE:     example.org
+#+AUTHOR:    Eric Schulte
+#+EMAIL:     schulte.eric@gmail.com
+#+DATE:      2008-10-23 Thu
+#+LANGUAGE:  en
+#+OPTIONS:   H:3 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t TeX:t LaTeX:t skip:nil d:nil tags:not-in-toc
+#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js
+#+EXPORT_SELECT_TAGS: export
+#+EXPORT_EXCUDE_TAGS: noexport
+#+LINK_UP:   
+#+LINK_HOME: 
+
+This file is just for testing...
+
+Lets make sure that all of the http links on this page are exported
+correctly.
+- [[http://orgmode.org/][Org-Mode Homepage]]
+- [[http://google.com][google home page]]
+
+and [[http://orgmode.org/worg/org-tests/index.php][a link with a
+multi-line name]]

org-tests/index.org

@@ -45,10 +45,10 @@ the great [[file:org-mailing-list.org][Org mailing list]].
 - Veryfy the output of tests with tools like =diff= (think /export/ here).
 - http://www.emacswiki.org/emacs-fr/UnitTesting
 
-* What we to know to actually write tests
+* What we need to know to actually write tests
 
-The tutorial I'd need to write a test is one which lays out code I could copy
-and paste to do the following
+The tutorial I'd need to write a test is one which lays out code I
+could copy and paste to do the following
 
 ** setup the test environment
 
@@ -67,7 +67,7 @@ and paste to do the following
   - create the agenda
   - export .html .ics .dvi file
 
-* How do we specify the correct result???
+** How do we specify the correct result???
 
   - check that the headline folded properly.  What's the lisp code for getting
     the folded string as displayed?
@@ -80,6 +80,33 @@ and paste to do the following
     between them.  That way different people who  run the same test on different
     hosts can get the same result.
 
+** Testing tools
+
+Many of the above questions (how to we setup and tear down tests, and
+how can we make and check assertions) will depend heavily on the
+chosen testing tool.  Two options posited to the list so far are...
+
+- ERT :: (from http://github.com/ohler/ert/tree/master/ert.el) ert is
+         a tool for automated testing, reporting results, as well as
+         debugging errors
+- EmacsLispExpectations :: (from
+     http://www.emacswiki.org/cgi-bin/emacs/EmacsLispExpectations) is
+     a minimalist elisp testing framework based on 
+
+Both of these elisp files have been included in the =tools= directory
+inside this directory.
+
+I've never used EmacsLispExpectations, so I can't make any reasonable
+judgment between the two, perhaps if someone can implement some tests
+in both we could come to some sort of agreement.
+
+*** ERT Example
+
+I implemented a toy test of org's html export facility using ert.el.
+See [[file:ert-publish-test.el]] for the implementation.  To run the test
+open up org-publish-test.el, and =M-x eval-buffer=.  This should load
+ert, and run the simple html export test.
+
 * Clipboard
 
 Running a minimal emacs should suppress custom config files:
@@ -87,3 +114,7 @@ Running a minimal emacs should suppress custom config files:
 
 Getting a list of all variables (incomplete):
 : grep -r defvar lisp/*.el
+
+* COMMENT buffer dictionary
+
+ LocalWords:  ert el EmacsLispExpectations org's

org-tests/tools/el-expectations.el

@@ -0,0 +1,798 @@
+;;; el-expectations.el --- minimalist unit testing framework
+;; $Id: el-expectations.el,v 1.47 2008/08/28 19:28:37 rubikitch Exp $
+
+;; Copyright (C) 2008  rubikitch
+
+;; Author: rubikitch <rubikitch@ruby-lang.org>
+;; 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' and `dont-compile'. dont-compile
+;; is needed to prevent unit tests from being byte-compiled.
+
+;; (dont-compile
+;;   (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.47  2008/08/28 19:28:37  rubikitch
+;; not-called assertion
+;;
+;; Revision 1.46  2008/08/28 19:06:24  rubikitch
+;; `exps-padding': use `window-width'
+;;
+;; Revision 1.45  2008/08/24 20:36:37  rubikitch
+;; mention `dont-compile'
+;;
+;; Revision 1.44  2008/08/22 20:48:52  rubikitch
+;; fixed a stupid bug
+;;
+;; Revision 1.43  2008/08/22 20:43:00  rubikitch
+;; non-nil (true) assertion
+;;
+;; 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:
+* (non-nil)
+* (true)
+  Any non-nil value, eg. t, 1, '(1).
+
+* (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))
+
+* (not-called FUNCTION)
+  Body should not call FUNCTION.
+  Not-called assertion depends on `el-mock' library.
+  If available, you do not have to require it: el-expectations detects it.
+
+  Example:
+    (expect (not-called hoge)
+      1)
+ 
+* 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-non-nil
+    exps-assert-true
+    exps-assert-buffer
+    exps-assert-regexp
+    exps-assert-type
+    exps-assert-error
+    exps-assert-error-message
+    exps-assert-mock
+    exps-assert-not-called
+    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-non-nil (expected actual)
+  (exps-do-assertion
+   expected actual 'non-nil t
+   (lambda (e a) (not (null a)))
+   (lambda (e a) (format "FAIL: Expected non-nil but was nil"))))
+
+(defun exps-assert-true (expected actual)
+  (exps-do-assertion
+   expected actual 'true t
+   (lambda (e a) (not (null a)))
+   (lambda (e a) (format "FAIL: Expected non-nil but was nil"))))
+(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-not-called (expected actual)
+  (let (err)
+    (exps-do-assertion
+     expected actual 'not-called nil
+     (lambda (e a)
+       (condition-case me
+           (progn
+             (mock-protect
+              (lambda ()
+                (eval `(not-called ,@e))
+                (eval `(progn ,@a))))
+             t)
+         (mock-error (setq err me) nil))
+       (if err nil t))
+     (lambda (e a)
+       (if (eq 'called (cadr err))
+           (format "FAIL: Expected not-called <%S>" e)))
+     #'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")))
+           (window-width (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)\\|(dont-compile\n.*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

org-tests/tools/el-mock.el

@@ -0,0 +1,655 @@
+;;; el-mock.el --- Tiny Mock and Stub framework in Emacs Lisp
+;; $Id: el-mock.el,v 1.17 2008/08/28 19:04:48 rubikitch Exp $
+
+;; Copyright (C) 2008  rubikitch
+
+;; Author: rubikitch <rubikitch@ruby-lang.org>
+;; 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.17  2008/08/28 19:04:48  rubikitch
+;; Implement `not-called' mock.
+;;
+;; Revision 1.16  2008/08/28 18:23:28  rubikitch
+;; unit test: use dont-compile
+;;
+;; 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))))))
+
+(defun not-called/setup (funcsym)
+  (mock-suppress-redefinition-message
+   (lambda ()
+     (let ()
+       (when (fboundp funcsym)
+         (put 'mock-original-func funcsym (symbol-function funcsym)))
+       (ad-safe-fset funcsym
+                     `(lambda (&rest actual-args)
+                        (signal 'mock-error '(called))))))))
+
+(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))))
+
+(defmacro not-called (function)
+  "Create a not-called mock for FUNCTION.
+Not-called mocks are temporary functions which raises an error when called.
+If not-called functions are called, an `mock-error' occurs.
+Not-called mocks are removed outside `with-mock' and `mocklet'.
+
+Synopsis:
+* (not-called FUNCTION)
+  Create a FUNCTION not-called mock.
+
+Example:
+  (with-mock
+    (not-called f)
+    t)     ; => t
+  (with-mock
+    (not-called g)
+    (g 7)) ; => (mock-error called)
+"
+  (let ()
+    `(if (not in-mocking)
+         (error "Do not use `not-called' outside")
+       (not-called/setup ',function)
+       (push ',function -mocked-functions))))
+
+
+(defun mock-parse-spec (spec)
+  (cons 'progn
+        (mapcar (lambda (args)
+                  (if (eq (cadr args) 'not-called)
+                      `(not-called ,(car 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', `not-called' and `stub'.
+
+Create mocks and stubs described by SPECLIST then execute the forms in BODY.
+SPECLIST is a list of mock/not-called/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', `not-called' 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
+* (FUNCTION not-called)                 ; not-called FUNCTION
+
+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
+(dont-compile
+  (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))))
+      (expect '(progn
+                 (not-called g))
+        (mock-parse-spec
+         '((g not-called))))
+
+      (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)))))
+      (desc "not-called macro")
+      (expect 'ok
+        (with-mock
+          (not-called foom)
+          'ok))
+      (desc "mocklet/notcalled")
+      (expect 'ok
+        (mocklet ((foom not-called))
+          'ok))
+      (desc "unfulfilled not-called")
+      (expect (error mock-error '(called))
+        (with-mock
+          (not-called hoge)
+          (hoge 1)))
+      (desc "abused not-called macro")
+      (expect (error-message "Do not use `not-called' outside")
+        (let (in-mocking) ; while executing `expect', `in-mocking' is t.
+          (not-called hahahaha)))
+      (desc "not-called for adviced function")
+      (expect "not-called"
+        (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 not-called))
+                   "not-called"))
+             (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 not-called))
+                   "not-called")
+                 (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