Formatting.

[cl-mock.git] / src / mock.lisp

diff --git a/src/mock.lisp b/src/mock.lisp
index 481de12..e10bb32 100644 (file)
--- a/src/mock.lisp
+++ b/src/mock.lisp
@@ -1,46 +1,62 @@
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
+;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
 
 (in-package #:cl-mock)
-
+\f
 ;;; mocking of regular functions
 
 (defstruct mock-bindings
+  "Contains a set of mocked functions and their behaviour."
   mocks)
 
 (defvar *previous*)
 (defvar *arguments*)
 
 (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*)
+  "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 first return value, if any.  If RECORDP is set, all invocations will
-be recorded and returned as the second return value, else NIL."
+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))
-         invocations)
-    (call-with-function-bindings
-     functions
-     (mapcar (lambda (binding previous &aux (name (car binding)) (cases (cdr binding)))
-               (lambda (&rest args)
-                 (when recordp
-                   (push (cons name args) invocations))
-                 (find-and-invoke-mock previous cases args)))
-             mocks previous)
-     (lambda ()
-       (values
-        (funcall function)
-        (nreverse invocations)))
-     previous)))
+         (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))))
+
+(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 register-mock (mock-bindings 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)))
     (or (car found)
         (let ((binding (list name)))
@@ -48,6 +64,9 @@ be recorded and returned as the second return value, else NIL."
           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)))
     (if at-start