From: Olof-Joachim Frahm <olof@macrolet.net>
Date: Mon, 22 Dec 2014 02:21:04 +0000 (+0000)
Subject: Overhaul and version bump.
X-Git-Tag: 1.0.0~1
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e8b227cbde3cf3eeb9b28f347f9ff78acb0cf0a8;p=cl-mock.git

Overhaul and version bump.

Add better functionality for matching via OPTIMA.
New documentation for split packages (because of OPTIMA dependency).
Drop all mention of generic functions for now.
---

diff --git a/README.md b/README.md
index d453b5a..650a7be 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
 -*- mode: markdown; coding: utf-8-unix; -*-
 
-CL-MOCK - Mocking (generic) functions.
+CL-MOCK - Mocking functions.
 
 Copyright (C) 2013-14 Olof-Joachim Frahm
 
@@ -8,65 +8,92 @@ Release under a Simplified BSD license.
 
 Working, but unfinished.
 
-Should be portable thanks to [`CLOSER-MOP`][1].
+Should be portable.
 
 
 # INTRODUCTION
 
 This small library provides a way to replace the actual implementation
-of either regular or generic functions with mocks.  How to integrate
-this facility with a testing library is up to the user; the tests for
-the library are written in [`FIVEAM`][2] though, so most examples will
-take that into account.
+of either regular or generic functions with mocks.  On the one hand how
+to integrate this facility with a testing library is up to the user; the
+tests for the library are written in [`FIVEAM`][2] though, so most
+examples will take that into account.  On the other hand writing
+interactions for mocks usually relies on a bit of pattern matching,
+therefore the regular `CL-MOCK` package relies on [`OPTIMA`][3] to
+provide that facility instead of deferring to the user.  Should this be
+a concern a reduced system definition is available as `CL-MOCK-BASIC`,
+which excludes the definition of `ANSWER` and the dependency on
+[`OPTIMA`][3].
 
 Since it is pretty easy to just roll something like this on your own,
 the main purpose is to develop a nice (lispy, declarative) syntax to
 keep your tests readable and maintainable.
 
 Some parts may be used independently of the testing facilities,
-e.g. dynamic `FLET` and method bindings with `PROGM` may be of general
-interest.
-
-
-# MOCKING CONTEXT
-
-In addition to having macros and functions to install bindings into the
-mocking context, the actual context object may be retrieved and passed
-around as well.  This might be useful for further analysis or other
-helpers.
-
-
-# GENERIC FUNCTIONS
-
-Since behaviour isn't bound to classes, but to generic functions,
-creating new classes on the fly isn't particularly interesting.  If
-necessary, additional shortcuts will be added, but until then I don't
-see the need for this.  On the contrary, providing a way to temporarily
-supersede generic function bindings sounds like a more viable approach,
-especially with regards to (custom) method combinations.
-
-Thus, the form `PROGM` is provided to bind a number of methods during
-the execution of its body:
-
-    > (progm
-    >     '((baz NIL (list)))
-    >     '((lambda (list) list))
-    >   ...)
-
-For example:
-
-    > (defclass foo () ())
-    > (defgeneric baz (foo)
-        (:method ((foo foo))
-          42))
-    > (progm '((baz NIL (list)))
-             '((lambda (list) list))
-        (values (baz (make-instance 'foo)) (baz '(1 2 3))))
-    > => 42
-    > => (1 2 3)
-
-This is implemented via [`CLOSER-MOP`][1], so compatiblity with that
-library is required.
+e.g. dynamic `FLET` may be of general interest.
+
+
+# MOCKING REGULAR FUNCTIONS
+
+Let's say we have a function `FOO`, then we can replace it for testing
+by establishing a new mocking context and then specifying how the new
+function should behave (see below in **UTILITIES** for a more primitive
+dynamic function rebinding):
+
+    > (declaim (notinline foo bar))
+    > (defun foo () 'foo)
+    > (defun bar () 'bar)
+    > (with-mocks ()
+    >   (answer (foo 1) 42)
+    >   (answer foo 23)
+    >   (values
+    >    (eql 42 (foo 1))
+    >    (eql 23 (foo 'bar))))
+    > => T T
+
+The `ANSWER` macro has pattern matching (see [`OPTIMA`][3]) integrated.
+Therefore something like the following will now work as expected:
+
+    > (with-mocks ()
+    >   (answer (foo x) (format T "Hello, ~A!" x))
+    >   (foo "world"))
+    > => "Hello, world!"
+
+If you don't like `ANSWER` as it is, you can still use `IF-CALLED`
+directly.  Note however that unless `UNHANDLED` is called, the function
+always matches and the return value is directly returned again:
+
+    > (with-mocks ()
+    >   (if-called 'foo (lambda (x)
+    >                     (unhandled)
+    >                     (error "Not executed!")))
+    >   (if-called 'foo (lambda (x) (format T "Hello, ~A!" x)))
+    >   (foo "world"))
+    > => "Hello, world!"
+
+Be especially careful to handle all given arguments, otherwise the
+function call will fail and that error is propagated upwards.
+
+`IF-CALLED` also has another option to push a binding to the front of
+the list, which (as of now) isn't available via `ANSWER` (and should be
+treated as subject to change anyway).
+
+The function `INVOCATIONS` may be used to retrieve all recorded
+invocations of mocks (so far); the optional argument can be used to
+filter for a particular name:
+
+    > (with-mocks ()
+    >   (answer foo)
+    >   (foo "hello")
+    >   (foo "world")
+    >   (bar "test")
+    >   (invocations 'foo))
+    > => ((FOO "hello")
+    >     (FOO "world"))
+
+Currently there are no further predicates to check these values, this is
+however an area of investigation, so presumably either a macro like
+[`FIVEAM`][2]s `IS`, or regular predicates could appear in this place.
 
 
 # UTILITIES
@@ -97,3 +124,5 @@ standard `PROG`:
     > (OR) => 42, if FOO was inlined
 
 [1]: http://common-lisp.net/project/closer/closer-mop.html
+[2]: http://common-lisp.net/project/fiveam/
+[3]: https://github.com/m2ym/optima
diff --git a/cl-mock-basic.asd b/cl-mock-basic.asd
new file mode 100644
index 0000000..03d3006
--- /dev/null
+++ b/cl-mock-basic.asd
@@ -0,0 +1,23 @@
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+
+(in-package #:cl-user)
+
+(asdf:defsystem #:cl-mock-basic
+  :description "Mocking library"
+  :long-description "Mocking library to test plain functions."
+  :author "Olof-Joachim Frahm <olof@macrolet.net>"
+  :license "Simplified BSD License"
+  :version "1.0.0"
+  #+asdf-unicode :encoding #+asdf-unicode :utf-8
+  :depends-on (#:closer-mop #:alexandria)
+  :in-order-to ((asdf:test-op (asdf:load-op #:cl-mock-tests-basic)))
+  :perform (asdf:test-op :after (op c)
+             (funcall (find-symbol (symbol-name '#:run!) '#:fiveam)
+                      (find-symbol (symbol-name '#:cl-mock) '#:cl-mock-tests)))
+  :serial T
+  :components ((:static-file "README.md")
+               (:module "src"
+                :components
+                ((:file "package")
+                 (:file "functions")
+                 (:file "mock")))))
diff --git a/cl-mock-tests-basic.asd b/cl-mock-tests-basic.asd
new file mode 100644
index 0000000..37da5ac
--- /dev/null
+++ b/cl-mock-tests-basic.asd
@@ -0,0 +1,18 @@
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+
+(in-package #:cl-user)
+
+(asdf:defsystem #:cl-mock-tests-basic
+  :description "Tests for CL-MOCK"
+  :author "Olof-Joachim Frahm <olof@macrolet.net>"
+  :license "Simplified BSD License"
+  :version "1.0.0"
+  #+asdf-unicode :encoding #+asdf-unicode :utf-8
+  :depends-on (#:cl-mock #:fiveam)
+  :serial T
+  :components ((:module "tests"
+                :components
+                ((:file "package")
+                 (:file "suite")
+                 (:file "functions")
+                 (:file "mock")))))
diff --git a/cl-mock-tests.asd b/cl-mock-tests.asd
index 5c82c9a..9bf4406 100644
--- a/cl-mock-tests.asd
+++ b/cl-mock-tests.asd
@@ -3,17 +3,13 @@
 (in-package #:cl-user)
 
 (asdf:defsystem #:cl-mock-tests
-  :description "Tests for CL-MOCK"
+  :description "Tests for CL-MOCK (extended version)"
   :author "Olof-Joachim Frahm <olof@macrolet.net>"
   :license "Simplified BSD License"
-  :version "0.0.1"
+  :version "1.0.0"
   #+asdf-unicode :encoding #+asdf-unicode :utf-8
-  :depends-on (#:cl-mock #:fiveam)
+  :depends-on (#:cl-mock-tests-basic)
   :serial T
   :components ((:module "tests"
                 :components
-                ((:file "package")
-                 (:file "suite")
-                 (:file "functions")
-                 (:file "facade")
-                 (:file "methods")))))
+                ((:file "facade")))))
diff --git a/cl-mock.asd b/cl-mock.asd
index fac28ae..7b71beb 100644
--- a/cl-mock.asd
+++ b/cl-mock.asd
@@ -4,22 +4,18 @@
 
 (asdf:defsystem #:cl-mock
   :description "Mocking library"
-  :long-description "Mocking library to test plain and generic functions."
+  :long-description "Mocking library to test plain functions (extended
+version)."
   :author "Olof-Joachim Frahm <olof@macrolet.net>"
   :license "Simplified BSD License"
-  :version "0.0.1"
+  :version "1.0.0"
   #+asdf-unicode :encoding #+asdf-unicode :utf-8
-  :depends-on (#:closer-mop #:alexandria #:arnesi)
+  :depends-on (#:cl-mock-basic #:closer-mop #:alexandria #:optima)
   :in-order-to ((asdf:test-op (asdf:load-op #:cl-mock-tests)))
   :perform (asdf:test-op :after (op c)
              (funcall (find-symbol (symbol-name '#:run!) '#:fiveam)
                       (find-symbol (symbol-name '#:cl-mock) '#:cl-mock-tests)))
   :serial T
-  :components ((:static-file "README.md")
-               (:module "src"
+  :components ((:module "src"
                 :components
-                ((:file "package")
-                 (:file "functions")
-                 (:file "mock")
-                 (:file "methods")
-                 (:file "facade")))))
+                ((:file "facade")))))
diff --git a/src/facade.lisp b/src/facade.lisp
index e14c4ea..a16e88f 100644
--- a/src/facade.lisp
+++ b/src/facade.lisp
@@ -4,52 +4,28 @@
 
 ;;; syntactic sugar for defining the mock interactions
 
-(defun make-lambda-pattern (literal-pattern)
-  (let (lambda-pattern values)
-    (loop
-      for (car . cdr) = literal-pattern
-      while car
-      do (let ((sym (gensym)))
-           (setf lambda-pattern (append lambda-pattern (list sym)))
-           (push `(,sym . ,(if (or (symbolp car) (listp car)) `(quote ,car) car)) values)
-           (pop literal-pattern)))
-    (values lambda-pattern values)))
+(defun true (&rest arguments)
+  (declare (ignore arguments))
+  T)
 
-(defun make-test-pattern (values)
-  `(and ,.(mapcar (lambda (value)
-                    `(equal ,(car value) ,(cdr value)))
-                  values)))
-
-(defmacro when-called (mock-bindings call &body forms)
+(defmacro answer (call &body forms)
   (let ((name (if (listp call) (car call) call))
         (sym (gensym)))
     `(if-called
-      ,mock-bindings
       ',name
-      ,(if (listp call)
-           (multiple-value-bind (lambda-pattern values)
-               (make-lambda-pattern (cdr call))
-             `(lambda (&rest args)
-                (destructuring-bind ,lambda-pattern args
-                  ,(make-test-pattern values))))
-           '(constantly T))
       (let ((,sym (fdefinition ',name)))
         (declare (ignorable ,sym))
-        ,(if (cdr forms)
-             `(let ((times 0))
-                (lambda (&rest args)
-                  (declare (ignorable args))
-                  (case (prog1 times (incf times))
-                    ,.(loop
-                        for i from 0
-                        for (form . rest) on forms
-                        collect `(,(if rest i T) ,form)))))
-             `(lambda (&rest args)
-                (declare (ignorable args))
-                ,@forms))))))
-
-(defun invocation-count (name invocations)
-  (count name invocations :key #'car :test #'eq))
-
-(defun was-called-p (name invocations)
-  (member name invocations :key #'car :test #'eq))
+        (let ((times 0))
+          (lambda (&rest args)
+            (declare (ignorable args))
+            ,(let ((cases
+                     `(case (prog1 times (incf times))
+                        ,.(loop
+                            for i from 0
+                            for (form . rest) on forms
+                            collect `(,(if rest i T) ,form)))))
+               (if (listp call)
+                   `(match args
+                     ((list . ,(cdr call)) ,cases)
+                     (_ (unhandled)))
+                   cases))))))))
diff --git a/src/functions.lisp b/src/functions.lisp
index 803a3f2..b1dfb4c 100644
--- a/src/functions.lisp
+++ b/src/functions.lisp
@@ -18,14 +18,16 @@ it completely."
   (if value (set-fdefinition name value) (fmakunbound name)))
 
 (defun call-with-function-bindings (functions values function
-                                    &optional (previous (mapcar #'maybe-fdefinition functions)))
-  "Calls FUNCTION while temporarily binding all FUNCTIONS to VALUES.
-See PROGF and PROGV."
-  (unwind-protect
-       (progn
-         (mapc #'set-fdefinition functions values)
-         (funcall function))
-    (mapc #'set-or-unbind-fdefinition functions previous)))
+                                    &optional previous)
+  "Calls FUNCTION while temporarily binding all FUNCTIONS with the given
+names to VALUES.  See PROGF and PROGV.  If PREVIOUS is set, it has to
+be the list of original values for each function."
+  (let ((previous (or previous (mapcar #'maybe-fdefinition functions))))
+    (unwind-protect
+         (progn
+           (mapc #'set-fdefinition functions values)
+           (funcall function))
+      (mapc #'set-or-unbind-fdefinition functions previous))))
 
 (defmacro progf (functions values &body body)
   "Like PROGV, but for FUNCTIONS."
diff --git a/src/methods.lisp b/src/methods.lisp
deleted file mode 100644
index 4688d2b..0000000
--- a/src/methods.lisp
+++ /dev/null
@@ -1,76 +0,0 @@
-;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
-
-(in-package #:cl-mock)
-
-;;; mocking of generic methods and objects
-
-(defun find-methods (methods)
-  (mapcar (lambda (method)
-            (destructuring-bind (generic-function qualifiers specializers) method
-              (cons
-               generic-function
-               (find-method generic-function qualifiers specializers NIL))))
-          methods))
-
-;; TODO: because we use ENSURE-METHOD, each value is a FORM rather than a
-;; FUNCTION, so not quite the same as PROGF; judging by the implementation-
-;; specific code in CLOSER-MOP, we also can just create method objects
-;; ourselves reliably, so either we duplicate the cases or just use SBCL
-
-(defun call-with-method-bindings* (methods values function
-                                   &optional (previous (find-methods methods)))
-  (mapc (lambda (previous)
-          (destructuring-bind (generic-function . method) previous
-            (when method
-              (remove-method generic-function method))))
-        previous)
-  (let ((new-methods
-          (mapcar (lambda (method previous value)
-                    (destructuring-bind (generic-function qualifiers specializers) method
-                      (declare (ignore generic-function))
-                      (destructuring-bind (generic-function . method) previous
-                        (cons
-                         generic-function
-                         (if method
-                             (ensure-method generic-function value
-                                            :method-class (class-of method)
-                                            :qualifiers (method-qualifiers method)
-                                            :lambda-list (method-lambda-list method)
-                                            :specializers (method-specializers method))
-                             (ensure-method generic-function value
-                                            :qualifiers qualifiers
-                                            :specializers specializers))))))
-                  methods previous values)))
-    (unwind-protect (funcall function)
-      (mapc (lambda (new-method)
-              (destructuring-bind (generic-function . method) new-method
-                (remove-method generic-function method)))
-            new-methods)
-      (mapc (lambda (previous)
-              (destructuring-bind (generic-function . method) previous
-                (when method
-                  (add-method generic-function method))))
-            previous))))
-
-(defmacro progm* (methods values &body body)
-  `(call-with-method-bindings* ,methods ,values (lambda () ,@body)))
-
-(defun classify (specializer)
-  (if (classp specializer)
-      specializer
-      (find-class specializer)))
-
-(defun call-with-method-bindings (methods values function
-                                  &optional previous)
-  (let ((methods
-          (mapcar (lambda (method)
-                    (destructuring-bind (generic-function qualifiers specializers) method
-                      (list
-                       (ensure-function generic-function)
-                       qualifiers
-                       (mapcar #'classify specializers))))
-                  methods)))
-    (call-with-method-bindings* methods values function (or previous (find-methods methods)))))
-
-(defmacro progm (methods values &body body)
-  `(call-with-method-bindings ,methods ,values (lambda () ,@body)))
diff --git a/src/mock.lisp b/src/mock.lisp
index e10bb32..fab5f73 100644
--- a/src/mock.lisp
+++ b/src/mock.lisp
@@ -4,71 +4,77 @@
 
 ;;; mocking of regular functions
 
-(defstruct mock-bindings
-  "Contains a set of mocked functions and their behaviour."
-  mocks)
+(defvar *mock-bindings*)
+(defvar *invocations*)
+(defvar *recordp*)
 
 (defvar *previous*)
 (defvar *arguments*)
 
+(defun invocations (&optional name)
+  (let ((invocations (car *invocations*)))
+    (if name
+        (remove name invocations :key #'car :test-not #'eq)
+        invocations)))
+
 (defun call-previous (&rest args)
   "Invokes the previous binding either with the current arguments or with
 the given ones.  Use *PREVIOUS*/*ARGUMENTS* directly in edge cases."
   (apply *previous* (or args *arguments*)))
 
-(defun find-and-invoke-mock (*previous* cases *arguments*)
+(defun find-and-invoke-mock (binding *arguments*)
   "Looks for a compatible mock (i.e. calls the TEST until one returns true)
 and executes it.  If no mock was found, no values are returned instead."
-  (dolist (case cases (values))
-    (when (ignore-errors (apply (car case) *arguments*))
-      (return (apply (cdr case) *arguments*)))))
-
-(defun call-with-mocks (mock-bindings function &key (recordp T))
-  "Calls FUNCTION with the given MOCK-BINDINGS established and returns
-its return values as a LIST.  If RECORDP is set, all invocations will be
-recorded and returned as the second return value, else NIL."
-  (let* ((mocks (mock-bindings-mocks mock-bindings))
-         (functions (mapcar #'car mocks))
-         (previous (mapcar #'maybe-fdefinition functions)))
-    (with-collector (invocations)
-      (call-with-function-bindings
-       functions
-       (mapcar (lambda (binding previous &aux (name (car binding)) (cases (cdr binding)))
-                 (lambda (&rest args)
-                   (when recordp
-                     (invocations (cons name args)))
-                   (find-and-invoke-mock previous cases args)))
-               mocks previous)
-       (lambda ()
-         (values
-          (multiple-value-list
-           (funcall function))
-          (invocations)))
-       previous))))
+  (when *recordp*
+    (let ((record (list (cons (car binding) *arguments*))))
+      (if (null (car *invocations*))
+          (setf (cdr *invocations*)
+                (setf (car *invocations*) record))
+          (setf (cdr *invocations*)
+                (setf (cddr *invocations*) record)))))
+  (dolist (case (cdddr binding) (values))
+    (let ((*previous* (cadr binding)))
+      (catch 'unhandled
+        (return (apply case *arguments*))))))
 
-(defmacro with-mocks ((mock-bindings &key (recordp T)) form &body body)
-  `(multiple-value-bind (,values ,calls)
-       (call-with-mocks
-        ,mock-bindings
-        (lambda () ,form)
-        :recordp ,recordp)
-     ,@body))
+(defun unhandled ()
+  (throw 'unhandled (values)))
 
-(defun register-mock (mock-bindings name)
+(defun register-mock (name)
   "Registers a mocked function under NAME.  The mocked function will
 return no values.  See IF-CALLED to add some behaviour to it."
-  (let ((found (member name (mock-bindings-mocks mock-bindings) :key #'car :test #'eq)))
+  (let ((found (member name *mock-bindings* :key #'car :test #'eq)))
     (or (car found)
-        (let ((binding (list name)))
-          (push binding (mock-bindings-mocks mock-bindings))
+        (let* ((binding (list name (maybe-fdefinition name) NIL))
+               (function (lambda (&rest arguments)
+                           (find-and-invoke-mock binding arguments))))
+          (setf (caddr binding) function)
+          (push binding *mock-bindings*)
+          (set-fdefinition name function)
           binding))))
 
-(defun if-called (mock-bindings name test function &key at-start)
-  "Registers a new binding to be called when the TEST function returns
-true.  If AT-START is set, the binding is put at the start of the bindings
-list instead.  Calls REGISTER-MOCK automatically."
-  (let ((binding (register-mock mock-bindings name))
-        (case (cons test function)))
+(defun if-called (name function &key at-start)
+  "Registers a new binding, which should return true if it handled the
+invocation.  If AT-START is set, the binding is put at the start of the
+bindings list instead.  Calls REGISTER-MOCK automatically."
+  (let ((binding (register-mock name)))
     (if at-start
-        (push case (cdr binding))
-        (setf (cdr binding) (append (cdr binding) (list case))))))
+        (push function (cdddr binding))
+        (setf (cdddr binding) (append (cdddr binding) (list function))))))
+
+(defun call-with-mocks (function &key ((:recordp *recordp*) T))
+  "Call FUNCTION with a new mocking context.  Invocations will be
+recorded if RECORDP is set (default true)."
+  (let (*mock-bindings*
+        (*invocations* (list NIL)))
+    (unwind-protect (funcall function)
+      (mapc (lambda (binding)
+              (set-or-unbind-fdefinition (car binding) (cadr binding)))
+            *mock-bindings*))))
+
+(defmacro with-mocks ((&key (recordp T)) &body body)
+  "Execute BODY in a new mocking context.  Invocations will be recorded
+if RECORDP is set (default true)."
+  `(call-with-mocks
+    (lambda () ,@body)
+    :recordp ,recordp))
diff --git a/src/package.lisp b/src/package.lisp
index a499a26..8f802ae 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -3,12 +3,26 @@
 (in-package #:cl-user)
 
 (defpackage #:cl-mock
-  (:use #:closer-common-lisp #:alexandria)
-  (:import-from #:arnesi #:with-collector)
-  (:export ;; regular functions
-           #:progf
-           #:dflet
-
-           ;; mocking of regular functions
-           ;; mocking of generic functions
-           ))
+  (:use #:closer-common-lisp #:alexandria #:optima)
+  (:export
+   ;; regular functions
+   #:maybe-fdefinition
+   #:set-fdefinition
+   #:set-or-unbind-fdefinition
+   #:call-with-function-bindings
+
+   #:progf
+   #:dflet
+
+   ;; mocking of regular functions
+   #:call-previous
+   #:register-mock
+   #:invocations
+   #:if-called
+   #:unhandled
+   #:answer
+   #:call-with-mocks
+   #:with-mocks
+
+   ;; mocking of generic functions
+   ))
diff --git a/tests/facade.lisp b/tests/facade.lisp
index c8534cf..ff4840f 100644
--- a/tests/facade.lisp
+++ b/tests/facade.lisp
@@ -4,115 +4,34 @@
 
 (in-suite cl-mock)
 
-(def-test call-with-mocks.empty ()
-  (is (equal '(T) (call-with-mocks
-                   (make-mock-bindings)
-                   (constantly T)))))
-
-(def-test call-with-mocks.discards-values ()
-  (is (equal
-       '((1 2 3) NIL)
-       (multiple-value-list
-        (call-with-mocks
-         (make-mock-bindings)
-         (lambda ()
-           (values 1 2 3)))))))
-
-(def-test call-with-mocks.simple ()
-  (declare (notinline foo))
-  (defun foo ()
-    (fail "original function binding ~A was called" 'foo))
-  (let ((mock-bindings (make-mock-bindings)))
-    (register-mock mock-bindings 'foo)
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (foo)
-       (pass)))))
-
-(def-test call-with-mocks.default-values ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (register-mock mock-bindings 'foo)
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (null (multiple-value-list (foo))))))))
-
-(def-test if-called.simple ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (if-called mock-bindings 'foo (constantly T) (constantly 42))
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (eql 42 (foo)))))))
-
-(def-test call-with-mocks.invocations ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (register-mock mock-bindings 'foo)
-    (is (equal
-         '(NIL ((foo 1) (foo 2) (foo 3)))
-         (multiple-value-list
-          (call-with-mocks
-           mock-bindings
-           (lambda ()
-             (foo 1)
-             (foo 2)
-             (foo 3))))))))
-
-(def-test when-called.simple ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (when-called mock-bindings foo 42)
-    (when-called mock-bindings foo 23)
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (eql 42 (foo)))))))
-
-(def-test when-called.literal ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (when-called mock-bindings (foo 1) 2)
-    (when-called mock-bindings (foo 2) 3)
-    (when-called mock-bindings foo 42)
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (eql 2 (foo 1)))
-       (is (eql 2 (foo 1)))
-       (is (eql 3 (foo 2)))
-       (is (eql 3 (foo 2)))
-       (is (eql 42 (foo)))
-       (is (eql 42 (foo 'foo)))))))
-
-(def-test when-called.times ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (when-called mock-bindings foo 1 2 3)
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (eql 1 (foo)))
-       (is (eql 2 (foo)))
-       (is (eql 3 (foo)))
-       (is (eql 3 (foo)))))))
-
-(def-test when-called.call-previous ()
-  (declare (notinline foo))
-  (defun foo () 'foo)
-  (let ((mock-bindings (make-mock-bindings)))
-    (when-called mock-bindings foo 3 (call-previous))
-    (call-with-mocks
-     mock-bindings
-     (lambda ()
-       (is (eql 3 (foo)))
-       (is (eq 'foo (foo)))))))
+(def-test answer.simple ()
+  (with-mocks ()
+    (answer (foo 1) 42)
+    (answer foo 23)
+    (is (eql 42 (foo 1)))))
+
+(def-test answer.literal ()
+  (with-mocks ()
+    (answer (foo 1) 2)
+    (answer (foo 2) 3)
+    (answer foo 42)
+    (is (eql 2 (foo 1)))
+    (is (eql 2 (foo 1)))
+    (is (eql 3 (foo 2)))
+    (is (eql 3 (foo 2)))
+    (is (eql 42 (foo)))
+    (is (eql 42 (foo 'foo)))))
+
+(def-test answer.times ()
+  (with-mocks ()
+    (answer foo 1 2 3)
+    (is (eql 1 (foo)))
+    (is (eql 2 (foo)))
+    (is (eql 3 (foo)))
+    (is (eql 3 (foo)))))
+
+(def-test answer.call-previous ()
+  (with-mocks ()
+    (answer foo 3 (call-previous))
+    (is (eql 3 (foo)))
+    (is (eq 'foo (foo)))))
diff --git a/tests/functions.lisp b/tests/functions.lisp
index 21761f2..507ae38 100644
--- a/tests/functions.lisp
+++ b/tests/functions.lisp
@@ -11,24 +11,37 @@
 (def-test dflet.calls-binding ()
   (dflet ((foo () 23))
     (is (eql 23 (foo)))))
+
+(declaim (inline foo/inline))
+(defun foo/inline ()
+  23)
+
+(def-test dflet.inline.works ()
+  "If a function is declared INLINE (and that request is honored), DFLET
+won't work."
+  (dflet ((foo/inline () 42))
+    (is (eql 23 (foo/inline)))))
 
 (def-test dflet.notinline.works ()
-  (declare (notinline foo bar))
-  (defun foo () 23)
-  (dflet ((foo () 42))
-    (is (eql 42 (foo)))))
+  "If a function is declared INLINE, but NOTINLINE is used locally,
+DFLET will work."
+  (declare (notinline foo/inline))
+  (dflet ((foo/inline () 42))
+    (is (eql 42 (foo/inline)))))
+
+(defun foo/mock (&optional (string "Hello, World!"))
+  (1+ (bar/mock string)))
+
+(defun bar/mock (string)
+  (length string))
 
 (def-test dflet.simple-mock ()
-  (defun foo (&optional (string "Hello, World!"))
-    (1+ (bar string)))
-  (defun bar (string)
-    (length string))
-  (dflet ((bar (string)
+  (dflet ((bar/mock (string)
             (cond
               ((equalp string "Hello, World!")
                42))))
-    (is (eql 43 (foo)))
-    (is (eql 43 (foo "HELLO, WORLD!")))))
+    (is (eql 43 (foo/mock)))
+    (is (eql 43 (foo/mock "HELLO, WORLD!")))))
 
 (def-test dflet.package-locks ()
   "Either we can rebind LIST, or an error occurs and the binding is not
@@ -39,30 +52,19 @@ modified."
       (error ()
         (is (eq #'list list))))))
 
+(defun foo/lock ()
+  23)
+
 (def-test dflet.package-locks.order.1 ()
-  (defun foo ()
-    23)
+  "Either we can rebind LIST, or an error occurs and both binding are
+restored."
   (let ((list #'list)
-        (foo #'foo))
+        (foo/lock #'foo/lock))
     (handler-case (dflet
-                      ((foo () 13)
+                      ((foo/lock () 13)
                        (list () 42))
                     (is (eql 42 (list)))
-                    (is (eql 13 (foo))))
-      (error ()
-        (is (eq #'list list))
-        (is (eq #'foo foo))))))
-
-(def-test dflet.package-locks.order.2 ()
-  (defun foo ()
-    23)
-  (let ((list #'list)
-        (foo #'foo))
-    (handler-case (dflet
-                      ((list () 42)
-                       (foo () 13))
-                    (is (eql 42 (list)))
-                    (is (eql 13 (foo))))
+                    (is (eql 13 (foo/lock))))
       (error ()
         (is (eq #'list list))
-        (is (eq #'foo foo))))))
+        (is (eq #'foo/lock foo/lock))))))
diff --git a/tests/methods.lisp b/tests/methods.lisp
deleted file mode 100644
index 681712c..0000000
--- a/tests/methods.lisp
+++ /dev/null
@@ -1,27 +0,0 @@
-;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*-
-
-(in-package #:cl-mock-tests)
-
-(in-suite cl-mock)
-
-(defclass foo ()
-  ())
-
-(defgeneric baz (foo)
-  (:method ((foo foo))
-    42))
-
-(def-test gf.simple ()
-  (progm
-      '((baz NIL (list)))
-      '((lambda (list) list))
-    (is (equal '(1 2 3) (baz '(1 2 3))))
-    (signals error (eq T (baz T)))
-    (is (eql 42 (baz (make-instance 'foo))))))
-
-(def-test gf.overwrite ()
-  (progm
-      '((baz NIL (foo)))
-      '((lambda (foo) 23))
-    (is (eql 23 (baz (make-instance 'foo)))))
-  (is (eql 42 (baz (make-instance 'foo)))))
diff --git a/tests/mock.lisp b/tests/mock.lisp
new file mode 100644
index 0000000..c935e8e
--- /dev/null
+++ b/tests/mock.lisp
@@ -0,0 +1,60 @@
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*-
+
+(in-package #:cl-mock-tests)
+
+(in-suite cl-mock)
+
+(def-test call-with-mocks.empty ()
+  (is (eq T (with-mocks () T))))
+
+(def-test call-with-mocks.discards-values ()
+  (is (equal
+       '(1 2 3)
+       (multiple-value-list
+        (with-mocks ()
+          (values 1 2 3))))))
+
+(declaim (notinline foo/simple))
+(defun foo/simple ()
+  (fail "original function binding ~A was called" 'foo/simple))
+
+(def-test call-with-mocks.simple ()
+  (with-mocks ()
+    (register-mock 'foo/simple)
+    (foo/simple)
+    (pass)))
+
+(declaim (notinline foo bar))
+(defun foo () 'foo)
+(defun bar () 'bar)
+
+(def-test call-with-mocks.default-values ()
+  (with-mocks ()
+    (register-mock 'foo)
+    (is (null (multiple-value-list (foo))))))
+
+(def-test if-called.simple ()
+  (with-mocks ()
+    (if-called 'foo (constantly 42))
+    (is (eql 42 (foo)))))
+
+(def-test invocations.length ()
+  (with-mocks ()
+    (register-mock 'foo)
+    (dotimes (i 3) (foo))
+    (is (eql 3 (length (invocations))))))
+
+(def-test invocations.arguments ()
+  (with-mocks ()
+    (register-mock 'foo)
+    (let ((sym (gensym)))
+      (foo sym)
+      (is (equal `((foo ,sym)) (invocations))))))
+
+(def-test invocations.name ()
+  (with-mocks ()
+    (register-mock 'foo)
+    (register-mock 'bar)
+    (foo)
+    (bar)
+    (is (equal `((foo)) (invocations 'foo)))))
diff --git a/tests/package.lisp b/tests/package.lisp
index 1198756..dd74ae4 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -6,8 +6,8 @@
   (:use #:cl #:cl-mock #:fiveam)
   (:import-from #:cl-mock
                 #:call-with-mocks
+                #:with-mocks
                 #:progm
-                #:make-mock-bindings
                 #:if-called
                 #:when-called
                 #:call-previous