Permalink
Browse files

Fixed #198: deftype-openly and Java classes

  • Loading branch information...
1 parent d40fd2b commit 11fc986672894ea02a52a141f4a2bf4bea12b301 @marick committed Mar 22, 2013
Showing with 71 additions and 26 deletions.
  1. +29 −19 src/midje/open_protocols.clj
  2. +28 −0 test/behaviors/t_protocols.clj
  3. +14 −7 test/midje/t_open_protocols.clj
@@ -13,23 +13,33 @@
[name-or-impl]
(not (symbol? name-or-impl)))
-(letfn [(open-spec
- ;;Return function that checks if its name has been bound to a fake-function.
- [[name args & body]]
- `(~name ~args
- (if (implements-a-fake? ~name)
- (apply ~name ~args)
- (do ~@body))))
-
- (revised-specs [specifications]
- (for [spec specifications]
- (if (and (user-desires-checking?) (implementation? spec))
- (open-spec spec)
- spec)))]
-
- (defmacro deftype-openly [name fields & specs]
- `(deftype ~name ~fields ~@(revised-specs specs)))
-
- (defmacro defrecord-openly [name fields & specs]
- `(defrecord ~name ~fields ~@(revised-specs specs))))
+(defn- ^:testable protocol?
+ "Is this a java interface or class (like Object) or a Clojure protocol?"
+ [symbol]
+ (not (instance? java.lang.Class (resolve symbol))))
+
+(defn- rewrite-as-mockable-function [[name args & body]]
+ `(~name ~args
+ (if (implements-a-fake? ~name)
+ (apply ~name ~args)
+ (do ~@body))))
+
+(defn- rewrite-def*-body [body]
+ (if (user-desires-checking?)
+ (first
+ (reduce (fn [[revised-body working-on-protocol?] form]
+ (if (implementation? form)
+ (vector (conj revised-body (if working-on-protocol? (rewrite-as-mockable-function form) form))
+ working-on-protocol?)
+ (vector (conj revised-body form)
+ (protocol? form))))
+ [[] false]
+ body))
+ body))
+
+(defmacro deftype-openly [name fields & specs]
+ `(deftype ~name ~fields ~@(rewrite-def*-body specs)))
+
+(defmacro defrecord-openly [name fields & specs]
+ `(defrecord ~name ~fields ~@(rewrite-def*-body specs)))
@@ -121,3 +121,31 @@
(pzero? anything) => true))
(note-that fact-fails, (fact-expected '(psuccessor (padd (Peano. ...a...) (Peano. ...b...)))))
+
+
+;;; When you deftype a Java class or interface, no function is
+;;; created, therefore you cannot treat it as a prerequisite.
+
+(defprotocol Fearful
+ (fear? [this]))
+
+(deftype-openly Fear []
+ Fearful
+ (fear? [this] true)
+ Comparable
+ (compareTo [this that] -1)
+ Object
+ (toString [this] "object"))
+
+(fact "The Java functions are harmlessly skipped."
+ (fear? (Fear.)) => true
+ (.compareTo (Fear.) :anything) => -1
+ (.toString (Fear.)) => "object")
+
+(fact "Only the protocol function can be mocked."
+ (resolve 'compareTo) => falsey
+ (resolve 'toString) => falsey
+ (let [fear (Fear.)]
+ (fear? fear) => :faked
+ (provided
+ (fear? fear) => :faked)))
@@ -1,15 +1,22 @@
(ns midje.t-open-protocols
- (:use midje.open-protocols)
- (:use [midje sweet test-util]))
+ (:use midje.open-protocols
+ midje.sweet
+ midje.test-util
+ midje.util))
+(expose-testables midje.open-protocols)
-;; The end-to-endish tests are under tests/behaviors.
+(fact "can distinguish a protocol/interface name from a function implementation"
+ (implementation? 'Object) => false
+ (implementation? '(fake-me [this f] form1 form2)) => true)
-(fact "can distinguish a protocol name from a function implementation"
- (#'midje.open-protocols/implementation? 'REDEEMABLE) => falsey
- (#'midje.open-protocols/implementation? '(fake-me [this f] form1 form2)) => truthy)
+(defprotocol P (f [this x]))
+
+(fact "can distinguish a protocol from an interface"
+ (protocol? 'Object) => false
+ (protocol? 'java.lang.Comparable) => false
+ (protocol? 'P) => true)
-(defprotocol P (f [this x]))
(let [type-or-record-tail '([a b c] P (f [this x] (+ x a b c)))
in-typ (list* 'deftype-openly 'T type-or-record-tail)
unexpanded-out-typ (list* 'clojure.core/deftype 'T type-or-record-tail)

0 comments on commit 11fc986

Please sign in to comment.