From cf4790b017ab4d2840f9d224abfa9c6023f71262 Mon Sep 17 00:00:00 2001 From: Aaron Bedra and Stuart Halloway Date: Sun, 23 Aug 2009 13:09:53 -0400 Subject: added test-expect source, renamed namespaces for contrib --- build.xml | 3 + src/clojure/contrib/expect.clj | 264 +++++++++++++++++++++++++ src/clojure/contrib/expect/test_is_adapter.clj | 37 ++++ src/clojure/contrib/expect/util.clj | 21 ++ src/clojure/contrib/ns_utils.clj | 17 ++ 5 files changed, 342 insertions(+) create mode 100644 src/clojure/contrib/expect.clj create mode 100644 src/clojure/contrib/expect/test_is_adapter.clj create mode 100644 src/clojure/contrib/expect/util.clj diff --git a/build.xml b/build.xml index fc5fa65f..69390e1f 100644 --- a/build.xml +++ b/build.xml @@ -122,6 +122,9 @@ + + + diff --git a/src/clojure/contrib/expect.clj b/src/clojure/contrib/expect.clj new file mode 100644 index 00000000..9200e77b --- /dev/null +++ b/src/clojure/contrib/expect.clj @@ -0,0 +1,264 @@ +;;; clojure.contrib.expect.clj: mocking/expectation framework for Clojure + +;; by Matt Clark + +;; Copyright (c) Matt Clark, 2009. All rights reserved. The use +;; and distribution terms for this software are covered by the Eclipse +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). +;; By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. +;;------------------------------------------------------------------------------ + +(comment + ;; This is a simple function mocking library I accidentally wrote as a side + ;; effect of trying to write an opengl library in clojure. This is loosely + ;; based on various ruby and java mocking frameworks I have used in the past + ;; such as mockito, easymock, and whatever rspec uses. + ;; + ;; expect uses bindings to wrap the functions that are being tested and + ;; then validates the invocation count at the end. The expect macro is the + ;; main entry point and it is given a vector of binding pairs. + ;; The first of each pair names the dependent function you want to override, + ;; while the second is a hashmap containing the mock description, usually + ;; created via the simple helper methods described below. + ;; + ;; Usage: + ;; + ;; there are one or more dependent functions: + + (defn dep-fn1 [] "time consuming calculation in 3rd party library") + (defn dep-fn2 [x] "function with undesirable side effects while testing") + + ;; then we have the code under test that calls these other functions: + + (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) + + ;; to test this code, we simply surround it with an expect macro within + ;; the test: + + (expect [dep-fn1 (times 1) + dep-fn2 (times 1 (has-args [#(= "a" %)]))] + (my-code-under-test)) + + ;; When an expectation fails during execution of the function under test, + ;; an error condition function is called with the name of the function + ;; being mocked, the expected form and the actual value. These + ;; error functions can be overridden to allow easy integration into + ;; test frameworks such as test-is by reporting errors in the function + ;; overrides. + + ) ;; end comment + +(ns clojure.contrib.expect + (:use clojure.contrib.expect.util)) + + +;;------------------------------------------------------------------------------ +;; These are the error condition functions. Override them to integrate into +;; the test framework of your choice, or to simply customize error handling. + +(defn report-problem + ([function expected actual] + (report-problem function expected actual "Expectation not met.")) + ([function expected actual message] + (prn (str message " Function name: " function + " expected: " expected " actual: " actual)))) + +(defn no-matching-function-signature [function expected actual] + (report-problem function expected actual + "No matching real function signature for given argument count.")) + +(defn unexpected-args [function expected actual i] + (report-problem function expected actual + (str "Argument " i " has an unexpected value for function."))) + +(defn incorrect-invocation-count [function expected actual] + (report-problem function expected actual "Unexpected invocation count.")) + + +;;------------------------------------------------------------------------------ +;; Internal Functions - ignore these + + +(defn- has-arg-count-match? + "Given the sequence of accepted argument vectors for a function, +returns true if at least one matches the given-count value." + [arg-lists given-count] + (some #(if-let [ind (index-of % '&)] + (>= given-count ind) + (= (count %) given-count)) arg-lists)) + + +(defn has-matching-signature? + "Calls no-matching-function-signature if no match is found for the given +function. If no argslist meta data is available for the function, it is +not called." + [fn-name args] + (let [arg-count (count args) + arg-lists (:arglists (meta (resolve fn-name)))] + (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) + (no-matching-function-signature fn-name arg-lists args)))) + + +(defn make-arg-checker + "Creates the argument verifying function for a replaced dependency within +the expectation bound scope. These functions take the additional argument +of the name of the replaced function, then the rest of their args. It is +designed to be called from the mock function generated in the first argument +of the mock info object created by make-mock." + [arg-preds arg-pred-forms] + (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] + (fn [fn-name & args] + (every? true? + (map (fn [pred arg pred-form i] (if (pred arg) true + (unexpected-args fn-name pred-form arg i))) + sanitized-preds args arg-pred-forms (iterate inc 0)))))) + + +(defn make-count-checker + "creates the count checker that is invoked at the end of an expectation, after +the code under test has all been executed. The function returned takes the +name of the associated dependency and the invocation count as arguments." + [pred pred-form] + (let [pred-fn (if (integer? pred) #(= pred %) pred)] + (fn [fn-name v] (if (pred-fn v) true + (incorrect-invocation-count fn-name pred-form v))))) + + +(defn make-mock + "creates a vector containing the following information for the named function: +1. dependent function replacement - verifies signature, calls arg checker, +increases count, returns return value. +2. an atom containing the invocation count +3. the invocation count checker function +4. a symbol of the name of the function being replaced." + [fn-name expectation-hash] + (assert-args make-mock + (map? expectation-hash) "a map of expectations") + (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) + count-atom (atom 0) + ret-fn (or + (expectation-hash :calls) + (fn [& args] (expectation-hash :returns)))] + [(fn [& args] + (has-matching-signature? fn-name args) + (apply arg-checker fn-name args) + (swap! count-atom inc) + (apply ret-fn args)) + count-atom + (or (expectation-hash :times) (fn [fn-name v] true)) + fn-name])) + + +(defn validate-counts + "given the sequence of all mock data for the expectation, simply calls the +count checker for each dependency." + [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) + +(defn #^{:private true} make-bindings [expect-bindings mock-data-sym] + `[~@(interleave (map #(first %) (partition 2 expect-bindings)) + (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) + (range (quot (count expect-bindings) 2))))]) + + +;;------------------------------------------------------------------------------ +;; These are convenience functions to improve the readability and use of this +;; library. Useful in expressions such as: +;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) + +(defn once [x] (= 1 x)) + +(defn never [x] (zero? x)) + +(defn more-than [x] #(< x %)) + +(defn less-than [x] #(> x %)) + +(defn between [x y] #(and (< x %) (> y %))) + + +;;------------------------------------------------------------------------------ +;; The following functions can be used to build up the expectation hash. + +(defn returns + "Creates or associates to an existing expectation hash the :returns key with +a value to be returned by the expectation after a successful invocation +matching its expected arguments (if applicable). +Usage: +(returns ret-value expectation-hash?)" + + ([val] (returns val {})) + ([val expectation-hash] (assoc expectation-hash :returns val))) + + +(defn calls + "Creates or associates to an existing expectation hash the :calls key with a +function that will be called with the given arguments. The return value from +this function will be returned returned by the expected function. If both this +and returns are specified, the return value of \"calls\" will have precedence. +Usage: +(calls some-fn expectation-hash?)" + + ([val] (calls val {})) + ([val expectation-hash] (assoc expectation-hash :calls val))) + + +(defmacro has-args + "Creates or associates to an existing expectation hash the :has-args key with +a value corresponding to a function that will either return true if its +argument expectations are met or throw an exception with the details of the +first failed argument it encounters. +Only specify as many predicates as you are interested in verifying. The rest +of the values are safely ignored. +Usage: +(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" + + ([arg-pred-forms] `(has-args ~arg-pred-forms {})) + ([arg-pred-forms expect-hash-form] + (assert-args has-args + (vector? arg-pred-forms) "a vector of argument predicates") + `(assoc ~expect-hash-form :has-args + (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) + + +(defmacro times + "Creates or associates to an existing expectation hash the :times key with a +value corresponding to a predicate function which expects an integer value. +This function can either be specified as the first argument to times or can be +the result of calling times with an integer argument, in which case the +predicate will default to being an exact match. This predicate is called at +the end of an expect expression to validate that an expected dependency +function was called the expected number of times. +Usage: +(times n) +(times #(> n %)) +(times n expectation-hash)" + ([times-fn] `(times ~times-fn {})) + ([times-fn expectation-hash] + `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) + + +;------------------------------------------------------------------------------- +; The main expect macro. +(defmacro expect + "Use expect to redirect calls to dependent functions that are made within the +code under test. Instead of calling the functions that would normally be used, +temporary stubs are used, which can verify function parameters and call counts. +Return values can also be specified as needed. +Usage: +(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] + (function-under-test a b c))" + + [expect-bindings & body] + (assert-args expect + (vector? expect-bindings) "a vector of expectation bindings" + (even? (count expect-bindings)) + "an even number of forms in expectation bindings") + (let [mock-data (gensym "mock-data_")] + `(let [~mock-data (map (fn [args#] + (apply clojure.contrib.expect/make-mock args#)) + ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) + (partition 2 expect-bindings))))] + (binding ~(make-bindings expect-bindings mock-data) ~@body) + (clojure.contrib.expect/validate-counts ~mock-data) true))) diff --git a/src/clojure/contrib/expect/test_is_adapter.clj b/src/clojure/contrib/expect/test_is_adapter.clj new file mode 100644 index 00000000..ebe09773 --- /dev/null +++ b/src/clojure/contrib/expect/test_is_adapter.clj @@ -0,0 +1,37 @@ +;;; test_is_adapter.clj: test-is adapter for mocking/expectation framework for Clojure + +;; by Matt Clark + +;; Copyright (c) Matt Clark, 2009. All rights reserved. The use +;; and distribution terms for this software are covered by the Eclipse +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). +;; By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + +(ns clojure.contrib.expect.test-is-adapter + (:require [clojure.contrib.expect :as expect]) + (:use clojure.test + clojure.contrib.ns-utils)) + +(immigrate 'clojure.contrib.expect) + +(defn report-problem + "This function is designed to be used in a binding macro to override +the report-problem function in the test-expect namespace. Instead of printing +the error to the console, the error is logged via test-is." + [fn-name expected actual msg] + (report {:type :fail, + :message (str msg " Function name: " fn-name), + :expected expected, + :actual actual})) + + +(defmacro expect [& body] + "Use this macro instead of the standard test-expect expect macro to have +failures reported through test-is." + `(binding [expect/report-problem report-problem] + (expect/expect ~@body))) + + + diff --git a/src/clojure/contrib/expect/util.clj b/src/clojure/contrib/expect/util.clj new file mode 100644 index 00000000..a5b018c1 --- /dev/null +++ b/src/clojure/contrib/expect/util.clj @@ -0,0 +1,21 @@ +(ns clojure.contrib.expect.util + (:use clojure.contrib.seq-utils)) + +(defmacro assert-args [fnname & pairs] + `(do (when-not ~(first pairs) + (throw (IllegalArgumentException. + ~(str fnname " requires " (second pairs))))) + ~(let [more (nnext pairs)] + (when more + (list* `assert-args fnname more))))) + +(defn indexes + "Returns a lazy sequence of the indexes in coll for which the element +is equal to v." + [coll v] + (map #(first %) (filter (fn [[i el]] (= el v)) (indexed coll)))) + +(defn index-of + "Returns the first index of value v in the collection or nil." + [coll v] + (first (indexes coll v))) diff --git a/src/clojure/contrib/ns_utils.clj b/src/clojure/contrib/ns_utils.clj index 7a866d5a..0d9075a9 100644 --- a/src/clojure/contrib/ns_utils.clj +++ b/src/clojure/contrib/ns_utils.clj @@ -22,6 +22,9 @@ ;; 'print-docs' prints documentation for the public vars in a ;; namespace ;; +;; 'immigrate' Create a public var in this namespace for each +;; public var in the namespaces named by ns-names. +;; From James Reeves ;; Convenience ;; ;; 'vars' returns a sorted seq of symbols naming public vars @@ -87,3 +90,17 @@ "Prints documentation for the public vars in a namespace" [nsname] `(print-docs (get-ns '~nsname))) + +(defn immigrate + "Create a public var in this namespace for each public var in the + namespaces named by ns-names. The created vars have the same name, value, + and metadata as the original except that their :ns metadata value is this + namespace." + [& ns-names] + (doseq [ns ns-names] + (require ns) + (doseq [[sym var] (ns-publics ns)] + (let [sym (with-meta sym (assoc (meta var) :ns *ns*))] + (if (.isBound var) + (intern *ns* sym (var-get var)) + (intern *ns* sym)))))) -- cgit v1.2.3-18-g5258