more protocol tests, fixed NPE in extend, #239

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>

3 files changed, 119 insertions, 7 deletions

diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index 960b0e3b..161514db 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -432,6 +432,10 @@
 (defn find-protocol-method [protocol methodk x]
   (get (find-protocol-impl protocol x) methodk))
 
+(defn- protocol?
+  [maybe-p]
+  (boolean (:on-interface maybe-p)))
+
 (defn- implements? [protocol atype]
   (and atype (.isAssignableFrom ^Class (:on-interface protocol) atype)))
 
@@ -655,6 +659,9 @@
   {:added "1.2"} 
   [atype & proto+mmaps]
   (doseq [[proto mmap] (partition 2 proto+mmaps)]
+    (when-not (protocol? proto)
+      (throw (IllegalArgumentException.
+              (str proto " is not a protocol"))))
     (when (implements? proto atype)
       (throw (IllegalArgumentException. 
               (str atype " already directly implements " (:on-interface proto) " for protocol:"  
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
index a98994f3..57db84d3 100644
--- a/test/clojure/test_clojure/protocols.clj
+++ b/test/clojure/test_clojure/protocols.clj
@@ -10,7 +10,32 @@
 
 (ns clojure.test-clojure.protocols
   (:use clojure.test clojure.test-clojure.protocols.examples)
-  (:require [clojure.test-clojure.protocols.more-examples :as other]))
+  (:require [clojure.test-clojure.protocols.more-examples :as other])
+  (:import [clojure.test_clojure.protocols.examples ExampleInterface]))
+
+(defn causes
+  [^Throwable throwable]
+  (loop [causes []
+         t throwable]
+    (if t (recur (conj causes t) (.getCause t)) causes)))
+
+;; this is how I wish clojure.test/thrown? worked...
+;; Does body throw expected exception, anywhere in the .getCause chain?
+(defmethod assert-expr 'fails-with-cause?
+  [msg [_ exception-class msg-re & body :as form]]
+  `(try
+   ~@body
+   (report {:type :fail, :message ~msg, :expected '~form, :actual nil})
+   (catch Throwable t#
+     (if (some (fn [cause#]
+                 (and
+                  (= ~exception-class (class cause#))
+                  (re-find ~msg-re (.getMessage cause#))))
+               (causes t#))
+       (report {:type :pass, :message ~msg,
+                :expected '~form, :actual t#})
+       (report {:type :fail, :message ~msg,
+                :expected '~form, :actual t#})))))
 
 ;; temporary hack until I decide how to cleanly reload protocol
 (defn reload-example-protocols
@@ -60,6 +85,9 @@
       (is (thrown? AbstractMethodError (baz obj))))))
 
 (deftype ExtendTestWidget [name])
+(deftype HasProtocolInline []
+  ExampleProtocol
+  (foo [this] :inline))
 (deftest extend-test
   (testing "you can extend a protocol to a class"
     (extend String ExampleProtocol
@@ -76,6 +104,18 @@
      {:foo (fn [this] (str "widget " (.name this)))})
     (is (= "widget z" (foo (ExtendTestWidget. "z"))))))
 
+(deftest illegal-extending
+  (testing "you cannot extend a protocol to a type that implements the protocol inline"
+    (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
+          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
+                         clojure.test-clojure.protocols.examples/ExampleProtocol
+                         {:foo (fn [_] :extended)})))))
+  (testing "you cannot extend to an interface"
+    (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
+          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
+                         clojure.test_clojure.protocols.examples.ExampleProtocol
+                         {:foo (fn [_] :extended)}))))))
+
 (deftype ExtendsTestWidget []
   ExampleProtocol)
 (deftest extends?-test
@@ -187,10 +227,71 @@
         (is (= (r 1 4) (.cons rec [:b 4])))
         (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
 
-;; todo
-;; what happens if you extend after implementing directly? Extend is ignored!!
-;; extend-type extend-protocol extend-class
-;; maybe: find-protocol-impl find-protocol-method
-;; deftype, printable forms
-;; reify, definterface
+(deftest reify-test
+  (testing "of an interface"
+    (let [s :foo
+          r (reify
+             java.util.List
+             (contains [_ o] (= s o)))]
+      (testing "implemented methods"
+        (is (true? (.contains r :foo)))
+        (is (false? (.contains r :bar))))
+      (testing "unimplemented methods"
+        (is (thrown? AbstractMethodError (.add r :baz))))))
+  (testing "of two interfaces"
+    (let [r (reify
+             java.util.List
+             (contains [_ o] (= :foo o))
+             java.util.Collection
+             (isEmpty [_] false))]
+      (is (true? (.contains r :foo)))
+      (is (false? (.contains r :bar)))
+      (is (false? (.isEmpty r)))))
+  (testing "you can't define a method twice"
+    (is (fails-with-cause?
+         java.lang.ClassFormatError #"^Duplicate method name"
+         (eval '(reify
+                 java.util.List
+                 (size [_] 10)
+                 java.util.Collection
+                 (size [_] 20))))))
+  (testing "you can't define a method not on an interface/protocol/j.l.Object"
+    (is (fails-with-cause? 
+         IllegalArgumentException #"^Can't define method not in interfaces: foo"
+         (eval '(reify java.util.List (foo [_]))))))
+  (testing "of a protocol"
+    (let [r (reify
+             ExampleProtocol
+             (bar [this o] o)
+             (baz [this] 1)
+             (baz [this o] 2))]
+      (= :foo (.bar r :foo))
+      (= 1 (.baz r))
+      (= 2 (.baz r nil))))
+  (testing "destructuring in method def"
+    (let [r (reify
+             ExampleProtocol
+             (bar [this [_ _ item]] item))]
+      (= :c (.bar r [:a :b :c]))))
+  (testing "methods can recur"
+    (let [r (reify
+             java.util.List
+             (get [_ index]
+                  (if (zero? index)
+                    :done
+                    (recur (dec index)))))]
+      (is (= :done (.get r 0)))
+      (is (= :done (.get r 1)))))
+  (testing "disambiguating with type hints"
+    (testing "you must hint an overloaded method"
+      (is (fails-with-cause?
+            IllegalArgumentException #"Must hint overloaded method: hinted"
+            (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
+    (testing "hinting"
+      (let [r (reify
+               ExampleInterface
+               (hinted [_ ^int i] (inc i))
+               (hinted [_ ^String s] (str s s)))]
+        (is (= 2 (.hinted r 1)))
+        (is (= "xoxo" (.hinted r "xo")))))))
 
diff --git a/test/clojure/test_clojure/protocols/examples.clj b/test/clojure/test_clojure/protocols/examples.clj
index f0296955..877559d0 100644
--- a/test/clojure/test_clojure/protocols/examples.clj
+++ b/test/clojure/test_clojure/protocols/examples.clj
@@ -8,3 +8,7 @@
   (baz [a] [a b] "method with multiple arities")
   (with-quux [a] "method name with a hyphen"))
 
+(definterface ExampleInterface
+  (hinted [^int i])
+  (hinted [^String s]))
+