├── .gitattributes ├── tests ├── suite.lisp ├── package.lisp ├── facade.lisp ├── functions.lisp └── mock.lisp ├── cl-mock-tests.asd ├── cl-mock-tests-basic.asd ├── src ├── package.lisp ├── facade.lisp ├── functions.lisp └── mock.lisp ├── cl-mock.asd ├── cl-mock-basic.asd ├── .travis.yml └── README.md /.gitattributes: -------------------------------------------------------------------------------- 1 | *.lisp diff=lisp 2 | -------------------------------------------------------------------------------- /tests/suite.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-mock-tests) 2 | 3 | (def-suite cl-mock) 4 | -------------------------------------------------------------------------------- /tests/package.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (defpackage #:cl-mock-tests 6 | (:use #:cl #:cl-mock #:fiveam)) 7 | -------------------------------------------------------------------------------- /cl-mock-tests.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (asdf:defsystem #:cl-mock-tests 6 | :description "Tests for CL-MOCK (extended version)" 7 | :author "Olof-Joachim Frahm " 8 | :license "AGPL-3+" 9 | :version "1.0.1" 10 | #+asdf-unicode :encoding #+asdf-unicode :utf-8 11 | :depends-on (#:cl-mock #:cl-mock-tests-basic) 12 | :serial T 13 | :components ((:module "tests" 14 | :components 15 | ((:file "facade"))))) 16 | -------------------------------------------------------------------------------- /cl-mock-tests-basic.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (asdf:defsystem #:cl-mock-tests-basic 6 | :description "Tests for CL-MOCK" 7 | :author "Olof-Joachim Frahm " 8 | :license "AGPL-3+" 9 | :version "1.0.0" 10 | #+asdf-unicode :encoding #+asdf-unicode :utf-8 11 | :depends-on (#:cl-mock-basic #:fiveam) 12 | :serial T 13 | :components ((:module "tests" 14 | :components 15 | ((:file "package") 16 | (:file "suite") 17 | (:file "functions") 18 | (:file "mock"))))) 19 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (defpackage #:cl-mock 6 | (:use #:closer-common-lisp #:alexandria) 7 | (:export 8 | ;; regular functions 9 | #:maybe-fdefinition 10 | #:set-fdefinition 11 | #:set-or-unbind-fdefinition 12 | #:call-with-function-bindings 13 | 14 | #:progf 15 | #:dflet 16 | 17 | ;; mocking of regular functions 18 | #:*previous* 19 | #:*arguments* 20 | #:call-previous 21 | #:register-mock 22 | #:invocations 23 | #:if-called 24 | #:unhandled 25 | #:answer 26 | #:call-with-mocks 27 | #:with-mocks 28 | 29 | ;; mocking of generic functions 30 | )) 31 | -------------------------------------------------------------------------------- /cl-mock.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (asdf:defsystem #:cl-mock 6 | :description "Mocking library" 7 | :long-description "Mocking library to test plain functions (extended version)." 8 | :author "Olof-Joachim Frahm " 9 | :license "AGPL-3+" 10 | :version "1.1.0" 11 | #+asdf-unicode :encoding #+asdf-unicode :utf-8 12 | :depends-on (#:cl-mock-basic #:trivia) 13 | :in-order-to ((asdf:test-op (asdf:load-op #:cl-mock-tests))) 14 | :perform (asdf:test-op :after (op c) 15 | (funcall (find-symbol (symbol-name '#:run!) '#:fiveam) 16 | (find-symbol (symbol-name '#:cl-mock) '#:cl-mock-tests))) 17 | :serial T 18 | :components ((:module "src" 19 | :components 20 | ((:file "facade"))))) 21 | -------------------------------------------------------------------------------- /tests/facade.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*- 2 | 3 | (in-package #:cl-mock-tests) 4 | 5 | (in-suite cl-mock) 6 | 7 | (def-test answer.simple () 8 | (with-mocks () 9 | (answer (foo 1) 42) 10 | (answer foo 23) 11 | (is (eql 42 (foo 1))))) 12 | 13 | (def-test answer.literal () 14 | (with-mocks () 15 | (answer (foo 1) 2) 16 | (answer (foo 2) 3) 17 | (answer foo 42) 18 | (is (eql 2 (foo 1))) 19 | (is (eql 2 (foo 1))) 20 | (is (eql 3 (foo 2))) 21 | (is (eql 3 (foo 2))) 22 | (is (eql 42 (foo))) 23 | (is (eql 42 (foo 'foo))))) 24 | 25 | (def-test answer.times () 26 | (with-mocks () 27 | (answer foo 1 2 3) 28 | (is (eql 1 (foo))) 29 | (is (eql 2 (foo))) 30 | (is (eql 3 (foo))) 31 | (is (eql 3 (foo))))) 32 | 33 | (def-test answer.call-previous () 34 | (with-mocks () 35 | (answer foo 3 (call-previous)) 36 | (is (eql 3 (foo))) 37 | (is (eq 'foo (foo))))) 38 | -------------------------------------------------------------------------------- /cl-mock-basic.asd: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- 2 | 3 | (in-package #:cl-user) 4 | 5 | (asdf:defsystem #:cl-mock-basic 6 | :description "Mocking library" 7 | :long-description "Mocking library to test plain functions." 8 | :author "Olof-Joachim Frahm " 9 | :license "AGPL-3+" 10 | :version "1.1.0" 11 | #+asdf-unicode :encoding #+asdf-unicode :utf-8 12 | :depends-on (#:closer-mop #:alexandria #:bordeaux-threads) 13 | :in-order-to ((asdf:test-op (asdf:load-op #:cl-mock-tests-basic))) 14 | :perform (asdf:test-op :after (op c) 15 | (funcall (find-symbol (symbol-name '#:run!) '#:fiveam) 16 | (find-symbol (symbol-name '#:cl-mock) '#:cl-mock-tests))) 17 | :serial T 18 | :components ((:static-file "README.md") 19 | (:module "src" 20 | :components 21 | ((:file "package") 22 | (:file "functions") 23 | (:file "mock"))))) 24 | -------------------------------------------------------------------------------- /src/facade.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- 2 | 3 | (in-package #:cl-mock) 4 | 5 | ;;; syntactic sugar for defining the mock interactions 6 | 7 | (defun true (&rest arguments) 8 | (declare (ignore arguments)) 9 | T) 10 | 11 | (defmacro answer (call &body forms) 12 | (let ((name (if (listp call) (car call) call)) 13 | (sym (gensym))) 14 | `(if-called 15 | ',name 16 | (let ((,sym (fdefinition ',name))) 17 | (declare (ignorable ,sym)) 18 | (let ((times 0)) 19 | (lambda (&rest args) 20 | (declare (ignorable args)) 21 | ,(let ((cases 22 | `(case (prog1 times (incf times)) 23 | ,.(loop 24 | for i from 0 25 | for (form . rest) on forms 26 | collect `(,(if rest i T) ,form))))) 27 | (if (listp call) 28 | `(trivia:match args 29 | ((list . ,(cdr call)) ,cases) 30 | (_ (unhandled))) 31 | cases)))))))) 32 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: lisp 2 | 3 | env: 4 | matrix: 5 | - LISP=abcl 6 | - LISP=allegro 7 | - LISP=sbcl 8 | - LISP=sbcl32 9 | - LISP=ccl 10 | - LISP=ccl32 11 | - LISP=clisp 12 | - LISP=clisp32 13 | - LISP=cmucl 14 | - LISP=ecl 15 | 16 | matrix: 17 | allow_failures: 18 | # CIM not available for CMUCL 19 | - env: LISP=cmucl 20 | # optima fails for ecl 21 | - env: LISP=ecl 22 | 23 | install: 24 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | sh 25 | 26 | script: 27 | # work around fiveam 28 | - cl -e '(ql:quickload :cl-mock-tests-basic) 29 | (unless (let ((results (fiveam:run (find-symbol "CL-MOCK" "CL-MOCK-TESTS")))) 30 | (fiveam:explain! results) 31 | (notany (function fiveam::test-failure-p) results)) 32 | (uiop:quit 1))' 33 | - cl -e '(ql:quickload :cl-mock-tests) 34 | (unless (let ((results (fiveam:run (find-symbol "CL-MOCK" "CL-MOCK-TESTS")))) 35 | (fiveam:explain! results) 36 | (notany (function fiveam::test-failure-p) results)) 37 | (uiop:quit 1))' 38 | -------------------------------------------------------------------------------- /src/functions.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- 2 | 3 | (in-package #:cl-mock) 4 | 5 | ;;; dynamic rebinding of functions 6 | 7 | (defun maybe-fdefinition (name) 8 | "If NAME is FBOUNDP, return its FDEFINITION, else NIL." 9 | (and (fboundp name) (fdefinition name))) 10 | 11 | (defun set-fdefinition (name value) 12 | "FUNCALLABLE expansion of (SETF (FDEFINITION NAME) VALUE)." 13 | (setf (fdefinition name) value)) 14 | 15 | (defun set-or-unbind-fdefinition (name value) 16 | "If VALUE is true, set the FDEFINITION of NAME to it, else FMAKUNBOUND 17 | it completely." 18 | (if value (set-fdefinition name value) (fmakunbound name))) 19 | 20 | (defun call-with-function-bindings (functions values function 21 | &optional previous) 22 | "Calls FUNCTION while temporarily binding all FUNCTIONS with the given 23 | names to VALUES. See PROGF and PROGV. If PREVIOUS is set, it has to 24 | be the list of original values for each function." 25 | (let ((previous (or previous (mapcar #'maybe-fdefinition functions)))) 26 | (unwind-protect 27 | (progn 28 | (mapc #'set-fdefinition functions values) 29 | (funcall function)) 30 | (mapc #'set-or-unbind-fdefinition functions previous)))) 31 | 32 | (defmacro progf (functions values &body body) 33 | "Like PROGV, but for FUNCTIONS." 34 | `(call-with-function-bindings ,functions ,values (lambda () ,@body))) 35 | 36 | (defmacro dflet ((&rest definitions) &body body) 37 | "Like FLET, but dynamically sets the FDEFINITIONS during the duration of 38 | the BODY." 39 | `(progf 40 | ',(mapcar #'car definitions) 41 | (list 42 | ,.(mapcar (lambda (definition) 43 | `(lambda ,(cadr definition) 44 | ,@(cddr definition))) 45 | definitions)) 46 | ,@body)) 47 | -------------------------------------------------------------------------------- /tests/functions.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*- 2 | 3 | (in-package #:cl-mock-tests) 4 | 5 | (in-suite cl-mock) 6 | 7 | (def-test progf.calls-binding () 8 | (progf '(foo) (list (lambda () 23)) 9 | (is (eql 23 (foo))))) 10 | 11 | (def-test dflet.calls-binding () 12 | (dflet ((foo () 23)) 13 | (is (eql 23 (foo))))) 14 | 15 | (declaim (inline foo/inline)) 16 | (defun foo/inline () 17 | 23) 18 | 19 | (def-test dflet.inline.works () 20 | "If a function is declared INLINE (and that request is honored), DFLET 21 | won't work. Not a failure, since we can't force INLINE." 22 | (dflet ((foo/inline () 42)) 23 | (if (eql 23 (foo/inline)) 24 | (pass "INLINE declaration honored, so DFLET fails") 25 | (skip "INLINE declaration not honored, so DFLET works")))) 26 | 27 | (def-test dflet.notinline.works () 28 | "If a function is declared INLINE, but NOTINLINE is used locally, 29 | DFLET will work." 30 | (declare (notinline foo/inline)) 31 | (dflet ((foo/inline () 42)) 32 | (is (eql 42 (foo/inline))))) 33 | 34 | (defun foo/mock (&optional (string "Hello, World!")) 35 | (1+ (bar/mock string))) 36 | 37 | (defun bar/mock (string) 38 | (length string)) 39 | 40 | (def-test dflet.simple-mock () 41 | (dflet ((bar/mock (string) 42 | (cond 43 | ((equalp string "Hello, World!") 44 | 42)))) 45 | (is (eql 43 (foo/mock))) 46 | (is (eql 43 (foo/mock "HELLO, WORLD!"))))) 47 | 48 | (def-test dflet.package-locks () 49 | "Either we can rebind LIST, or an error occurs and the binding is not 50 | modified." 51 | (let ((list #'list)) 52 | (handler-case (dflet ((list ())) 53 | (is (eql 42 (list)))) 54 | (error () 55 | (is (eq #'list list)))))) 56 | 57 | (defun foo/lock () 58 | 23) 59 | 60 | (def-test dflet.package-locks.order.1 () 61 | "Either we can rebind LIST, or an error occurs and both binding are 62 | restored." 63 | (let ((list #'list) 64 | (foo/lock #'foo/lock)) 65 | (handler-case (dflet 66 | ((foo/lock () 13) 67 | (list () 42)) 68 | (is (eql 42 (list))) 69 | (is (eql 13 (foo/lock)))) 70 | (error () 71 | (is (eq #'list list)) 72 | (is (eq #'foo/lock foo/lock)))))) 73 | -------------------------------------------------------------------------------- /tests/mock.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*- 2 | 3 | (in-package #:cl-mock-tests) 4 | 5 | (in-suite cl-mock) 6 | 7 | (def-test call-with-mocks.empty () 8 | (is (eq T (with-mocks () T)))) 9 | 10 | (def-test call-with-mocks.discards-values () 11 | (is (equal 12 | '(1 2 3) 13 | (multiple-value-list 14 | (with-mocks () 15 | (values 1 2 3)))))) 16 | 17 | (declaim (notinline foo/simple)) 18 | (defun foo/simple () 19 | (fail "original function binding ~A was called" 'foo/simple)) 20 | 21 | (def-test call-with-mocks.simple () 22 | (with-mocks () 23 | (register-mock 'foo/simple) 24 | (foo/simple) 25 | (pass))) 26 | 27 | (declaim (notinline foo bar)) 28 | (defun foo () 'foo) 29 | (defun bar () 'bar) 30 | 31 | (def-test call-with-mocks.default-values () 32 | (with-mocks () 33 | (register-mock 'foo) 34 | (is (null (multiple-value-list (foo)))))) 35 | 36 | (def-test if-called.simple () 37 | (with-mocks () 38 | (if-called 'foo (constantly 42)) 39 | (is (eql 42 (foo))))) 40 | 41 | (def-test invocations.length () 42 | (with-mocks () 43 | (register-mock 'foo) 44 | (dotimes (i 3) (foo)) 45 | (is (eql 3 (length (invocations)))))) 46 | 47 | (def-test invocations.arguments () 48 | (with-mocks () 49 | (register-mock 'foo) 50 | (let ((sym (gensym))) 51 | (foo sym) 52 | (is (equal `((foo ,sym)) (invocations)))))) 53 | 54 | (def-test invocations.name () 55 | (with-mocks () 56 | (register-mock 'foo) 57 | (register-mock 'bar) 58 | (foo) 59 | (bar) 60 | (is (equal '((foo)) (invocations 'foo))))) 61 | 62 | ;; utility function to check asynchronous results 63 | (defun assert-cond (assert-fun max-time &optional (sleep-time 0.05)) 64 | (do ((wait-time sleep-time (+ wait-time sleep-time)) 65 | (fun-result nil (funcall assert-fun))) 66 | ((eq fun-result t) (return t)) 67 | (if (> wait-time max-time) (return) 68 | (sleep sleep-time)))) 69 | 70 | (def-test invocations.threaded () 71 | (with-mocks () 72 | (register-mock 'foo) 73 | (register-mock 'bar) 74 | (bt:make-thread (lambda () 75 | (foo) 76 | (bar))) 77 | (is (assert-cond (lambda () 78 | (and (equal '((foo)) (invocations 'foo)) 79 | (equal '((bar)) (invocations 'bar)))) 80 | .5)))) 81 | -------------------------------------------------------------------------------- /src/mock.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- 2 | 3 | (in-package #:cl-mock) 4 | 5 | ;;; mocking of regular functions 6 | 7 | (defvar *mock-bindings*) 8 | (defvar *invocations*) 9 | (defvar *recordp*) 10 | 11 | (defvar *invocations-lock* (bt:make-lock)) 12 | 13 | (defvar *previous*) 14 | (defvar *arguments*) 15 | 16 | (defun invocations (&optional name) 17 | (let ((invocations (car *invocations*))) 18 | (if name 19 | (remove name invocations :key #'car :test-not #'eq) 20 | invocations))) 21 | 22 | (defun call-previous (&rest args) 23 | "Invokes the previous binding either with the current arguments or with 24 | the given ones. Use *PREVIOUS*/*ARGUMENTS* directly in edge cases." 25 | (apply *previous* (or args *arguments*))) 26 | 27 | (defun record-invocation (record &aux (record (list record))) 28 | (bt:with-lock-held (*invocations-lock*) 29 | (setf (cdr *invocations*) 30 | (if (null (car *invocations*)) 31 | (setf (car *invocations*) record) 32 | (setf (cddr *invocations*) record))))) 33 | 34 | (defun find-and-invoke-mock (binding *arguments*) 35 | "Looks for a compatible mock (i.e. calls the TEST until one returns true) 36 | and executes it. If no mock was found, no values are returned instead." 37 | (when *recordp* 38 | (record-invocation (cons (car binding) *arguments*))) 39 | (dolist (case (cdddr binding) (values)) 40 | (let ((*previous* (cadr binding))) 41 | (catch 'unhandled 42 | (return (apply case *arguments*)))))) 43 | 44 | (defun unhandled () 45 | (throw 'unhandled (values))) 46 | 47 | (defun register-mock (name) 48 | "Registers a mocked function under NAME. The mocked function will 49 | return no values. See IF-CALLED to add some behaviour to it." 50 | (let ((found (member name *mock-bindings* :key #'car :test #'eq))) 51 | (or (car found) 52 | (let* ((binding (list name (maybe-fdefinition name) NIL)) 53 | (function (lambda (&rest arguments) 54 | (find-and-invoke-mock binding arguments)))) 55 | (setf (caddr binding) function) 56 | (push binding *mock-bindings*) 57 | (set-fdefinition name function) 58 | binding)))) 59 | 60 | (defun if-called (name function &key at-start) 61 | "Registers a new binding, which should return true if it handled the 62 | invocation. If AT-START is set, the binding is put at the start of the 63 | bindings list instead. Calls REGISTER-MOCK automatically." 64 | (let ((binding (register-mock name))) 65 | (if at-start 66 | (push function (cdddr binding)) 67 | (setf (cdddr binding) (append (cdddr binding) (list function)))))) 68 | 69 | (defun call-with-mocks (function &key ((:recordp recordp) T)) 70 | "Call FUNCTION with a new mocking context. Invocations will be 71 | recorded if RECORDP is set (default true)." 72 | (let (*mock-bindings*) 73 | (setf *invocations* (list NIL)) 74 | (setf *recordp* recordp) 75 | (unwind-protect (funcall function) 76 | (mapc (lambda (binding) 77 | (set-or-unbind-fdefinition (car binding) (cadr binding))) 78 | *mock-bindings*)))) 79 | 80 | (defmacro with-mocks ((&key (recordp T)) &body body) 81 | "Execute BODY in a new mocking context. Invocations will be recorded 82 | if RECORDP is set (default true)." 83 | `(call-with-mocks 84 | (lambda () ,@body) 85 | :recordp ,recordp)) 86 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | -*- mode: markdown; coding: utf-8-unix; -*- 2 | 3 | CL-MOCK - Mocking functions. 4 | 5 | Copyright (C) 2013-16 Olof-Joachim Frahm 6 | 7 | This program is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU Affero General Public License as 9 | published by the Free Software Foundation, either version 3 of the 10 | License, or (at your option) any later version. 11 | 12 | This program is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU Affero General Public License for more details. 16 | 17 | You should have received a copy of the GNU Affero General Public License 18 | along with this program. If not, see . 19 | 20 | Working, but unfinished. 21 | 22 | [![Build Status](https://travis-ci.org/Ferada/cl-mock.svg?branch=master)](https://travis-ci.org/Ferada/cl-mock) 23 | 24 | Portable to at least ABCL, Allegro CL (with one problem with inlining 25 | settings), SBCL, CCL and CLISP. CMUCL possibly, but not tested on 26 | Travis CI. ECL fails on Travis CI ([`TRIVIA`][3] fails there as well), 27 | but runs successfully on my own machine, so YMMV. See the detailed 28 | reports at 29 | [https://travis-ci.org/Ferada/cl-mock](https://travis-ci.org/Ferada/cl-mock) 30 | for more information and [`CL-TRAVIS`][5], and [`.travis.yml`][6] for the 31 | setup. 32 | 33 | 34 | # INTRODUCTION 35 | 36 | This small library provides a way to replace the actual implementation 37 | of either regular or generic functions with mocks. On the one hand how 38 | to integrate this facility with a testing library is up to the user; the 39 | tests for the library are written in [`FIVEAM`][2] though, so most 40 | examples will take that into account. On the other hand writing 41 | interactions for mocks usually relies on a bit of pattern matching, 42 | therefore the regular `CL-MOCK` package relies on [`TRIVIA`][3] to 43 | provide that facility instead of deferring to the user. Should this be 44 | a concern a reduced system definition is available as `CL-MOCK-BASIC`, 45 | which excludes the definition of `ANSWER` and the dependency on 46 | [`TRIVIA`][3]. 47 | 48 | Since it is pretty easy to just roll something like this on your own, 49 | the main purpose is to develop a nice (lispy, declarative) syntax to 50 | keep your tests readable and maintainable. 51 | 52 | Some parts may be used independently of the testing facilities, 53 | e.g. dynamic `FLET` may be of general interest. 54 | 55 | 56 | # MOCKING REGULAR FUNCTIONS 57 | 58 | Let's say we have a function `FOO`, then we can replace it for testing 59 | by establishing a new mocking context and then specifying how the new 60 | function should behave (see below in **UTILITIES** for a more primitive 61 | dynamic function rebinding): 62 | 63 | > (declaim (notinline foo bar)) 64 | > (defun foo () 'foo) 65 | > (defun bar (&rest args) 66 | > (declare (ignore args)) 67 | > 'bar) 68 | > (with-mocks () 69 | > (answer (foo 1) 42) 70 | > (answer foo 23) 71 | > (values 72 | > (eql 42 (foo 1)) 73 | > (eql 23 (foo 'bar)))) 74 | > => T T 75 | 76 | The `ANSWER` macro has pattern matching (see [`TRIVIA`][3]) integrated. 77 | Therefore something like the following will now work as expected: 78 | 79 | > (with-mocks () 80 | > (answer (foo x) (format T "Hello, ~A!" x)) 81 | > (foo "world")) 82 | > => "Hello, world!" 83 | 84 | If you don't like `ANSWER` as it is, you can still use `IF-CALLED` 85 | directly. Note however that unless `UNHANDLED` is called, the function 86 | always matches and the return value is directly returned again: 87 | 88 | > (with-mocks () 89 | > (if-called 'foo (lambda (x) 90 | > (unhandled) 91 | > (error "Not executed!"))) 92 | > (if-called 'foo (lambda (x) (format T "Hello, ~A!" x))) 93 | > (foo "world")) 94 | > => "Hello, world!" 95 | 96 | Be especially careful to handle all given arguments, otherwise the 97 | function call will fail and that error is propagated upwards. 98 | 99 | `IF-CALLED` also has another option to push a binding to the front of 100 | the list, which (as of now) isn't available via `ANSWER` (and should be 101 | treated as subject to change anyway). 102 | 103 | Should you wish to run the previously defined function, use the function 104 | `CALL-PREVIOUS`. If no arguments are passed it will use the current 105 | arguments from `*ARGUMENTS*`, if any. Otherwise it will be called with 106 | the passed arguments instead. For cases where explicitely calling it 107 | with no arguments is necessary, using `(funcall *previous*)` is still 108 | possible as well. 109 | 110 | > (with-mocks () 111 | > (answer foo `(was originally ,(funcall *previous*))) 112 | > (answer bar `(was originally ,(call-previous))) 113 | > (values 114 | > (foo "hello") 115 | > (bar "hello"))) 116 | > => (WAS ORIGINALLY FOO) (WAS ORIGINALLY BAR) 117 | 118 | The function `INVOCATIONS` may be used to retrieve all recorded 119 | invocations of mocks (so far); the optional argument can be used to 120 | filter for a particular name: 121 | 122 | > (with-mocks () 123 | > (answer foo) 124 | > (foo "hello") 125 | > (foo "world") 126 | > (bar "test") 127 | > (invocations 'foo)) 128 | > => ((FOO "hello") 129 | > (FOO "world")) 130 | 131 | Currently there are no further predicates to check these values, this is 132 | however an area of investigation, so presumably either a macro like 133 | [`FIVEAM`][2]s `IS`, or regular predicates could appear in this place. 134 | 135 | 136 | # EXAMPLES 137 | 138 | The following examples may give a better impression. 139 | 140 | Here we test a particular [`ECLASTIC`][4] method, `GET*`. In order to 141 | replace the HTTP call with a supplied value, we use `ANSWER` with 142 | `HTTP-REQUEST` and return a pre-filled stream. Afterwards both the 143 | number of `INVOCATIONS` and the actual returned values are checked. 144 | 145 | (use-package '(#:cl-mock #:fiveam #:eclastic #:drakma #:puri)) 146 | 147 | (def-test search.empty () 148 | (let* ((events (make-instance ' :type "document" :index "index" 149 | :host "localhost" :port 9292)) 150 | (text "{\"took\":3,\"timed_out\":false,\"_shards\":{\"total\":5,\ 151 | \"successful\":5,\"failed\":0},\"hits\":{\"total\":123,\"max_score\":1.0,\ 152 | \"hits\":[{\"_index\":\"index\",\"_type\":\"document\",\"_id\":\"12345\",\ 153 | \"_score\":1.0,\"_source\":{\"test\": \"Hello, World!\"}}]}}") 154 | (stream (make-string-input-stream text))) 155 | (with-mocks () 156 | (answer http-request 157 | (values stream 200 NIL 158 | (parse-uri "http://localhost:9292/index/document/_search") 159 | stream NIL "OK")) 160 | (let ((values (multiple-value-list 161 | (get* events (new-search NIL))))) 162 | (is (eql 1 (length (invocations)))) 163 | (is (eql 1 (length (car values)))) 164 | (is-true (typep (caar values) ')) 165 | (is (equal (cdr values) 166 | '(NIL (:hits 123 167 | :shards (:total 5 :failed 0 :successful 5) 168 | :timed-out NIL :took 3)))))))) 169 | 170 | Of course, running this should produce no errors: 171 | 172 | > (run! 'search.empty) 173 | > 174 | > Running test SEARCH.EMPTY .... 175 | > Did 4 checks. 176 | > Pass: 4 (100%) 177 | > Skip: 0 ( 0%) 178 | > Fail: 0 ( 0%) 179 | > 180 | > => NIL 181 | 182 | 183 | # UTILITIES 184 | 185 | `DFLET` dynamically rebinds functions similar to `FLET`: 186 | 187 | > (defun foo () 42) 188 | > (defun bar () (foo)) 189 | > (bar) 190 | > => 42 191 | > (dflet ((foo () 23)) 192 | > (bar)) 193 | > => 23 194 | > (OR) => 42, if FOO was inlined 195 | 196 | The caveat is that this might not work on certain optimisation settings, 197 | including inlining. That trade-off seems acceptable; it would be nice 198 | if a warning could be issued depending on the current optimisation 199 | settings, however that is particularly implementation dependent, so lack 200 | of a warning won't indicate a working environment. 201 | 202 | The underlying function `PROGF` may be used as well similarly to the 203 | standard `PROG`: 204 | 205 | > (progf '(foo) (list (lambda () 23)) 206 | > (bar)) 207 | > => 23 208 | > (OR) => 42, if FOO was inlined 209 | 210 | [1]: http://common-lisp.net/project/closer/closer-mop.html 211 | [2]: http://common-lisp.net/project/fiveam/ 212 | [3]: https://github.com/guicho271828/trivia 213 | [4]: https://github.com/gschjetne/eclastic 214 | [5]: https://github.com/luismbo/cl-travis 215 | [6]: https://raw.githubusercontent.com/Ferada/cl-mock/master/.travis.yml 216 | --------------------------------------------------------------------------------