rlm@10: ;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure
rlm@10: 
rlm@10: ;; by Matt Clark
rlm@10: 
rlm@10: ;; Copyright (c) Matt Clark, 2009. All rights reserved.  The use
rlm@10: ;; and distribution terms for this software are covered by the Eclipse
rlm@10: ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php).
rlm@10: ;; By using this software in any fashion, you are
rlm@10: ;; agreeing to be bound by the terms of this license.  You must not
rlm@10: ;; remove this notice, or any other, from this software.
rlm@10: ;;------------------------------------------------------------------------------
rlm@10: 
rlm@10: (comment
rlm@10:   ;; This is a simple function mocking library I accidentally wrote as a side
rlm@10:   ;; effect of trying to write an opengl library in clojure. This is loosely
rlm@10:   ;; based on various ruby and java mocking frameworks I have used in the past
rlm@10:   ;; such as mockito, easymock, and whatever rspec uses.
rlm@10:   ;;
rlm@10:   ;; expect uses bindings to wrap the functions that are being tested and
rlm@10:   ;; then validates the invocation count at the end. The expect macro is the
rlm@10:   ;; main entry point and it is given a vector of binding pairs.
rlm@10:   ;; The first of each pair names the dependent function you want to override,
rlm@10:   ;; while the second is a hashmap containing the mock description, usually
rlm@10:   ;; created via the simple helper methods described below.
rlm@10:   ;;
rlm@10:   ;; Usage:
rlm@10:   ;;
rlm@10:   ;; there are one or more dependent functions:
rlm@10:   
rlm@10:   (defn dep-fn1 [] "time consuming calculation in 3rd party library")
rlm@10:   (defn dep-fn2 [x] "function with undesirable side effects while testing")
rlm@10:   
rlm@10:   ;; then we have the code under test that calls these other functions:
rlm@10:   
rlm@10:   (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2))
rlm@10: 
rlm@10:   ;; to test this code, we simply surround it with an expect macro within
rlm@10:   ;; the test:
rlm@10:   
rlm@10:   (expect [dep-fn1 (times 1)
rlm@10:            dep-fn2 (times 1 (has-args [#(= "a" %)]))]
rlm@10:     (my-code-under-test))
rlm@10: 
rlm@10:   ;; When an expectation fails during execution of the function under test,
rlm@10:   ;; an error condition function is called with the name of the function
rlm@10:   ;; being mocked, the expected form and the actual value. These
rlm@10:   ;; error functions can be overridden to allow easy integration into
rlm@10:   ;; test frameworks such as test-is by reporting errors in the function
rlm@10:   ;; overrides.
rlm@10:   
rlm@10:   ) ;; end comment
rlm@10: 
rlm@10: (ns clojure.contrib.mock
rlm@10:   ^{:author "Matt Clark",
rlm@10:      :doc "function mocking/expectations for Clojure" }
rlm@10:   (:use [clojure.contrib.seq :only (positions)]
rlm@10:         [clojure.contrib.def :only (defmacro-)]))
rlm@10: 
rlm@10: 
rlm@10: ;;------------------------------------------------------------------------------
rlm@10: ;; These are the error condition functions. Override them to integrate into
rlm@10: ;; the test framework of your choice, or to simply customize error handling.
rlm@10: 
rlm@10: (defn report-problem
rlm@10:   {:dynamic true}
rlm@10:   ([function expected actual]
rlm@10:     (report-problem function expected actual "Expectation not met."))
rlm@10:   ([function expected actual message]
rlm@10:     (prn (str message " Function name: " function
rlm@10:            " expected: " expected " actual: " actual))))
rlm@10: 
rlm@10: (defn no-matching-function-signature
rlm@10:   {:dynamic true} 
rlm@10:   [function expected actual]
rlm@10:   (report-problem function expected actual
rlm@10:     "No matching real function signature for given argument count."))
rlm@10: 
rlm@10: (defn unexpected-args 
rlm@10:   {:dynamic true}
rlm@10:   [function expected actual i]
rlm@10:   (report-problem function expected actual
rlm@10:     (str "Argument " i " has an unexpected value for function.")))
rlm@10: 
rlm@10: (defn incorrect-invocation-count 
rlm@10:   {:dynamic true}
rlm@10:   [function expected actual]
rlm@10:   (report-problem function expected actual "Unexpected invocation count."))
rlm@10: 
rlm@10: 
rlm@10: ;;------------------------------------------------------------------------------
rlm@10: ;;  Internal Functions - ignore these
rlm@10: 
rlm@10: 
rlm@10: (defn- has-arg-count-match?
rlm@10:   "Given the sequence of accepted argument vectors for a function,
rlm@10: returns true if at least one matches the given-count value."
rlm@10:   [arg-lists given-count]
rlm@10:   (some #(let [[ind] (positions #{'&} %)]
rlm@10:            (if ind
rlm@10:              (>= given-count ind)
rlm@10:              (= (count %) given-count)))
rlm@10:         arg-lists))
rlm@10: 
rlm@10: 
rlm@10: (defn has-matching-signature?
rlm@10:   "Calls no-matching-function-signature if no match is found for the given
rlm@10: function. If no argslist meta data is available for the function, it is
rlm@10: not called."
rlm@10:   [fn-name args]
rlm@10:   (let [arg-count (count args)
rlm@10:             arg-lists (:arglists (meta (resolve fn-name)))]
rlm@10:         (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count)))
rlm@10:           (no-matching-function-signature fn-name arg-lists args))))
rlm@10: 
rlm@10: 
rlm@10: (defn make-arg-checker
rlm@10:   "Creates the argument verifying function for a replaced dependency within
rlm@10: the expectation bound scope. These functions take the additional argument
rlm@10: of the name of the replaced function, then the rest of their args. It is
rlm@10: designed to be called from the mock function generated in the first argument
rlm@10: of the mock info object created by make-mock."
rlm@10:   [arg-preds arg-pred-forms]
rlm@10:   (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)]
rlm@10:     (fn [fn-name & args]
rlm@10:       (every? true?
rlm@10:         (map (fn [pred arg pred-form i] (if (pred arg) true
rlm@10:                                           (unexpected-args fn-name pred-form arg i)))
rlm@10:           sanitized-preds args arg-pred-forms (iterate inc 0))))))
rlm@10: 
rlm@10: 
rlm@10: (defn make-count-checker
rlm@10:   "creates the count checker that is invoked at the end of an expectation, after
rlm@10: the code under test has all been executed. The function returned takes the
rlm@10: name of the associated dependency and the invocation count as arguments."
rlm@10:   [pred pred-form]
rlm@10:   (let [pred-fn (if (integer? pred) #(= pred %) pred)]
rlm@10:     (fn [fn-name v] (if (pred-fn v) true
rlm@10:                       (incorrect-invocation-count fn-name pred-form v)))))
rlm@10: 
rlm@10: ; Borrowed from clojure core. Remove if this ever becomes public there.
rlm@10: (defmacro- assert-args
rlm@10:   [fnname & pairs]
rlm@10:   `(do (when-not ~(first pairs)
rlm@10:          (throw (IllegalArgumentException.
rlm@10:                   ~(str fnname " requires " (second pairs)))))
rlm@10:      ~(let [more (nnext pairs)]
rlm@10:         (when more
rlm@10:           (list* `assert-args fnname more)))))
rlm@10: 
rlm@10: (defn make-mock
rlm@10:   "creates a vector containing the following information for the named function:
rlm@10: 1. dependent function replacement - verifies signature, calls arg checker,
rlm@10: increases count, returns return value.
rlm@10: 2. an atom containing the invocation count
rlm@10: 3. the invocation count checker function
rlm@10: 4. a symbol of the name of the function being replaced."
rlm@10:   [fn-name expectation-hash]
rlm@10:   (assert-args make-mock
rlm@10:     (map? expectation-hash) "a map of expectations")
rlm@10:   (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true))
rlm@10:         count-atom (atom 0)
rlm@10:         ret-fn (or
rlm@10:                  (expectation-hash :calls)
rlm@10:                  (fn [& args] (expectation-hash :returns)))]
rlm@10:     [(fn [& args]
rlm@10:        (has-matching-signature? fn-name args)
rlm@10:        (apply arg-checker fn-name args)
rlm@10:        (swap! count-atom inc)
rlm@10:        (apply ret-fn args))
rlm@10:      count-atom
rlm@10:      (or (expectation-hash :times) (fn [fn-name v] true))
rlm@10:      fn-name]))
rlm@10: 
rlm@10: 
rlm@10: (defn validate-counts
rlm@10:   "given the sequence of all mock data for the expectation, simply calls the
rlm@10: count checker for each dependency."
rlm@10:   [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i)))
rlm@10: 
rlm@10: (defn ^{:private true} make-bindings [expect-bindings mock-data-sym]
rlm@10:   `[~@(interleave (map #(first %) (partition 2 expect-bindings))
rlm@10:         (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0))
rlm@10:           (range (quot (count expect-bindings) 2))))])
rlm@10: 
rlm@10: 
rlm@10: ;;------------------------------------------------------------------------------
rlm@10: ;; These are convenience functions to improve the readability and use of this
rlm@10: ;; library. Useful in expressions such as:
rlm@10: ;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc)
rlm@10: 
rlm@10: (defn once [x] (= 1 x))
rlm@10: 
rlm@10: (defn never [x] (zero? x))
rlm@10: 
rlm@10: (defn more-than [x] #(< x %))
rlm@10: 
rlm@10: (defn less-than [x] #(> x %))
rlm@10: 
rlm@10: (defn between [x y] #(and (< x %) (> y %)))
rlm@10: 
rlm@10: 
rlm@10: ;;------------------------------------------------------------------------------
rlm@10: ;; The following functions can be used to build up the expectation hash.
rlm@10: 
rlm@10: (defn returns
rlm@10:   "Creates or associates to an existing expectation hash the :returns key with
rlm@10: a value to be returned by the expectation after a successful invocation
rlm@10: matching its expected arguments (if applicable).
rlm@10: Usage:
rlm@10: (returns ret-value expectation-hash?)"
rlm@10: 
rlm@10:   ([val] (returns val {}))
rlm@10:   ([val expectation-hash] (assoc expectation-hash :returns val)))
rlm@10: 
rlm@10: 
rlm@10: (defn calls
rlm@10:   "Creates or associates to an existing expectation hash the :calls key with a
rlm@10: function that will be called with the given arguments. The return value from
rlm@10: this function will be returned returned by the expected function. If both this
rlm@10: and returns are specified, the return value of \"calls\" will have precedence.
rlm@10: Usage:
rlm@10: (calls some-fn expectation-hash?)"
rlm@10: 
rlm@10:   ([val] (calls val {}))
rlm@10:   ([val expectation-hash] (assoc expectation-hash :calls val)))
rlm@10: 
rlm@10: 
rlm@10: (defmacro has-args
rlm@10:   "Creates or associates to an existing expectation hash the :has-args key with
rlm@10: a value corresponding to a function that will either return true if its
rlm@10: argument expectations are met or throw an exception with the details of the
rlm@10: first failed argument it encounters.
rlm@10: Only specify as many predicates as you are interested in verifying. The rest
rlm@10: of the values are safely ignored.
rlm@10: Usage:
rlm@10: (has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)"
rlm@10: 
rlm@10:   ([arg-pred-forms] `(has-args ~arg-pred-forms {}))
rlm@10:   ([arg-pred-forms expect-hash-form]
rlm@10:     (assert-args has-args
rlm@10:       (vector? arg-pred-forms) "a vector of argument predicates")
rlm@10:     `(assoc ~expect-hash-form :has-args
rlm@10:        (make-arg-checker ~arg-pred-forms '~arg-pred-forms))))
rlm@10: 
rlm@10: 
rlm@10: (defmacro times
rlm@10:   "Creates or associates to an existing expectation hash the :times key with a
rlm@10: value corresponding to a predicate function which expects an integer value.
rlm@10: This function can either be specified as the first argument to times or can be
rlm@10: the result of calling times with an integer argument, in which case the
rlm@10: predicate will default to being an exact match.  This predicate is called at
rlm@10: the end of an expect expression to validate that an expected dependency
rlm@10: function was called the expected number of times.
rlm@10: Usage:
rlm@10: (times n)
rlm@10: (times #(> n %))
rlm@10: (times n expectation-hash)"
rlm@10:   ([times-fn] `(times ~times-fn {}))
rlm@10:   ([times-fn expectation-hash]
rlm@10:     `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn))))
rlm@10: 
rlm@10: 
rlm@10: ;-------------------------------------------------------------------------------
rlm@10: ; The main expect macro.
rlm@10: (defmacro expect
rlm@10:  "Use expect to redirect calls to dependent functions that are made within the
rlm@10: code under test. Instead of calling the functions that would normally be used,
rlm@10: temporary stubs are used, which can verify function parameters and call counts.
rlm@10: Return values can also be specified as needed.
rlm@10: Usage:
rlm@10: (expect [dep-fn (has-args [arg-pred1] (times n (returns x)))]
rlm@10:   (function-under-test a b c))"
rlm@10: 
rlm@10:   [expect-bindings & body]
rlm@10:   (assert-args expect
rlm@10:     (vector? expect-bindings) "a vector of expectation bindings"
rlm@10:     (even? (count expect-bindings))
rlm@10:     "an even number of forms in expectation bindings")
rlm@10:   (let [mock-data (gensym "mock-data_")]
rlm@10:     `(let [~mock-data (map (fn [args#]
rlm@10:                              (apply clojure.contrib.mock/make-mock args#))
rlm@10:                         ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m))
rlm@10:                                        (partition 2 expect-bindings))))]
rlm@10:        (binding ~(make-bindings expect-bindings mock-data) ~@body)
rlm@10:        (clojure.contrib.mock/validate-counts ~mock-data) true)))