From 82370fd12b07679559c9e0b3f720aade582d42fb Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Wed, 17 Dec 2014 16:45:49 +0100 Subject: [PATCH] Current state. --- .gitattributes | 1 + README.md | 27 ++++++++++++++++++++++++++- cl-mock-tests.asd | 19 +++++++++++++++++++ cl-mock.asd | 22 +++++++--------------- src/facade.lisp | 2 +- src/functions.lisp | 2 +- src/methods.lisp | 2 +- src/mock.lisp | 33 +++++++++++++++++---------------- src/package.lisp | 3 ++- tests/facade.lisp | 2 +- tests/functions.lisp | 2 +- tests/methods.lisp | 13 ++++++++++--- tests/package.lisp | 12 ++++++++++-- tests/suite.lisp | 2 +- 14 files changed, 98 insertions(+), 44 deletions(-) create mode 100644 .gitattributes create mode 100644 cl-mock-tests.asd diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..4058346 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +*.lisp diff=lisp diff --git a/README.md b/README.md index a873afe..ad9bcb6 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,32 @@ e.g. dynamic `FLET` and method bindings with `PROGM` may be of general interest. +# GENERIC FUNCTIONS + +Since behaviour isn't bound to classes, but to generic functions, +creating new classes on the fly isn't particularly interesting. + +We provide the form `PROGM` to bind a number of methods during the +execution of its contained 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) + + # UTILITIES `DFLET` dynamically rebinds functions similar to `FLET`: @@ -43,5 +69,4 @@ The underlying function `PROGF` may be used as well similarly to standard > => 23 > (OR) => 42, if FOO was inlined - [1]: http://common-lisp.net/project/closer/closer-mop.html diff --git a/cl-mock-tests.asd b/cl-mock-tests.asd new file mode 100644 index 0000000..dcb0eb4 --- /dev/null +++ b/cl-mock-tests.asd @@ -0,0 +1,19 @@ +;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- + +(in-package #:cl-user) + +(asdf:defsystem #:cl-mock-tests + :description "Tests for CL-MOCK" + :author "Olof-Joachim Frahm " + :license "Simplified BSD License" + :version "0.0.1" + #+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 "facade") + (:file "methods"))))) \ No newline at end of file diff --git a/cl-mock.asd b/cl-mock.asd index c6aa5f6..9111724 100644 --- a/cl-mock.asd +++ b/cl-mock.asd @@ -1,33 +1,25 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- (in-package #:cl-user) - + (asdf:defsystem #:cl-mock :description "Mocking library" - :description "Mocking (generic) functions." + :long-description "Mocking library to test plain and generic functions." :author "Olof-Joachim Frahm " :license "Simplified BSD License" - :depends-on (#:closer-mop #:alexandria) + :version "0.0.1" + #+asdf-unicode :encoding #+asdf-unicode :utf-8 + :depends-on (#:closer-mop #:alexandria #:arnesi) :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 ((:module "src" + :components ((:static-file "README.md") + (:module "src" :components ((:file "package") (:file "functions") (:file "mock") (:file "methods") (:file "facade"))))) - -(asdf:defsystem #:cl-mock-tests - :depends-on (#:cl-mock #:fiveam) - :serial T - :components ((:module "tests" - :components - ((:file "package") - (:file "suite") - (:file "functions") - (:file "facade") - (:file "methods"))))) diff --git a/src/facade.lisp b/src/facade.lisp index d863988..8e73de9 100644 --- a/src/facade.lisp +++ b/src/facade.lisp @@ -1,7 +1,7 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- (in-package #:cl-mock) - + ;;; syntactic sugar for defining the mock interactions (defun make-lambda-pattern (literal-pattern) diff --git a/src/functions.lisp b/src/functions.lisp index f7b7479..cd8c772 100644 --- a/src/functions.lisp +++ b/src/functions.lisp @@ -1,7 +1,7 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- (in-package #:cl-mock) - + ;;; dynamic rebinding of functions (defun maybe-fdefinition (name) diff --git a/src/methods.lisp b/src/methods.lisp index ec9bba7..351938f 100644 --- a/src/methods.lisp +++ b/src/methods.lisp @@ -1,7 +1,7 @@ ;;; -*- 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) diff --git a/src/mock.lisp b/src/mock.lisp index 33b4ba2..ae9522d 100644 --- a/src/mock.lisp +++ b/src/mock.lisp @@ -1,10 +1,11 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*- (in-package #:cl-mock) - + ;;; mocking of regular functions (defstruct mock-bindings + "Contains a set of mocked functions and their behaviour." mocks) (defvar *previous*) @@ -28,21 +29,21 @@ its first return value, if any. 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 + (funcall function) + (invocations))) + previous)))) (defun register-mock (mock-bindings name) "Registers a mocked function under NAME. The mocked function will diff --git a/src/package.lisp b/src/package.lisp index b145b4f..498b4e1 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,9 +1,10 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- (in-package #:cl-user) - + (defpackage #:cl-mock (:use #:closer-common-lisp #:alexandria) + (:import-from #:arnesi #:with-collector) (:export ;;; regular functions #:progf #:dflet diff --git a/tests/facade.lisp b/tests/facade.lisp index 2eeeec8..5db3530 100644 --- a/tests/facade.lisp +++ b/tests/facade.lisp @@ -1,7 +1,7 @@ ;;; -*- 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 () diff --git a/tests/functions.lisp b/tests/functions.lisp index c3219b2..3e5f23b 100644 --- a/tests/functions.lisp +++ b/tests/functions.lisp @@ -1,7 +1,7 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*- (in-package #:cl-mock-tests) - + (in-suite cl-mock) (def-test progf.calls-binding () diff --git a/tests/methods.lisp b/tests/methods.lisp index fa88e4a..89c0860 100644 --- a/tests/methods.lisp +++ b/tests/methods.lisp @@ -1,7 +1,7 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock-tests; -*- (in-package #:cl-mock-tests) - + (in-suite cl-mock) (defclass foo () @@ -16,5 +16,12 @@ '((baz NIL (list))) '((lambda (list) list)) (is (equal '(1 2 3) (baz '(1 2 3)))) - (signals error (equal T (baz T))) - (is (equal 42 (baz (make-instance 'foo)))))) + (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/package.lisp b/tests/package.lisp index 0faeab1..5c47243 100644 --- a/tests/package.lisp +++ b/tests/package.lisp @@ -1,7 +1,15 @@ ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*- (in-package #:cl-user) - + (defpackage #:cl-mock-tests (:use #:cl #:cl-mock #:fiveam) - (:import-from #:cl-mock #:call-with-mocks #:progm #:make-mock-bindings #:if-called #:when-called)) + (:import-from + #:cl-mock + #:call-with-mocks + #:progm + #:make-mock-bindings + #:if-called + #:when-called + #:call-previous + #:register-mock)) diff --git a/tests/suite.lisp b/tests/suite.lisp index 04d89be..8cb7144 100644 --- a/tests/suite.lisp +++ b/tests/suite.lisp @@ -1,3 +1,3 @@ (in-package #:cl-mock-tests) - + (def-suite cl-mock) -- 1.7.10.4