1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test_clojure/protocols.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,300 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +; Author: Stuart Halloway
    1.13 +
    1.14 +(ns clojure.test-clojure.protocols
    1.15 +  (:use clojure.test clojure.test-clojure.protocols.examples)
    1.16 +  (:require [clojure.test-clojure.protocols.more-examples :as other]
    1.17 +            [clojure.set :as set]
    1.18 +            clojure.test-clojure.helpers)
    1.19 +  (:import [clojure.test_clojure.protocols.examples ExampleInterface]))
    1.20 +
    1.21 +;; temporary hack until I decide how to cleanly reload protocol
    1.22 +(defn reload-example-protocols
    1.23 +  []
    1.24 +  (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
    1.25 +                  assoc :impls {})
    1.26 +  (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
    1.27 +                  assoc :impls {})
    1.28 +  (require :reload
    1.29 +           'clojure.test-clojure.protocols.examples
    1.30 +           'clojure.test-clojure.protocols.more-examples))
    1.31 +
    1.32 +(defn method-names
    1.33 +  "return sorted list of method names on a class"
    1.34 +  [c]
    1.35 +  (->> (.getMethods c)
    1.36 +     (map #(.getName %))
    1.37 +     (sort)))
    1.38 +
    1.39 +(defrecord EmptyRecord [])
    1.40 +(defrecord TestRecord [a b])
    1.41 +(defn r
    1.42 +  ([a b] (TestRecord. a b))
    1.43 +  ([a b meta ext] (TestRecord. a b meta ext)))
    1.44 +(defrecord MapEntry [k v]
    1.45 +  java.util.Map$Entry
    1.46 +  (getKey [_] k)
    1.47 +  (getValue [_] v))
    1.48 +
    1.49 +(deftest protocols-test
    1.50 +  (testing "protocol fns have useful metadata"
    1.51 +    (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)
    1.52 +                       :protocol #'ExampleProtocol}]
    1.53 +      (are [m f] (= (merge (quote m) common-meta)
    1.54 +                    (meta (var f)))
    1.55 +           {:name foo :arglists ([a]) :doc "method with one arg"} foo
    1.56 +           {:name bar :arglists ([a b]) :doc "method with two args"} bar
    1.57 +           {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz
    1.58 +           {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux)))
    1.59 +  (testing "protocol fns throw IllegalArgumentException if no impl matches"
    1.60 +    (is (thrown-with-msg?
    1.61 +          IllegalArgumentException
    1.62 +          #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer"
    1.63 +          (foo 10))))
    1.64 +  (testing "protocols generate a corresponding interface using _ instead of - for method names"
    1.65 +    (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
    1.66 +  (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
    1.67 +    (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
    1.68 +                (foo [] "foo!"))]
    1.69 +      (is (= "foo!" (.foo obj)) "call through interface")
    1.70 +      (is (= "foo!" (foo obj)) "call through protocol")))
    1.71 +  (testing "you can implement just part of a protocol if you want"
    1.72 +    (let [obj (reify ExampleProtocol
    1.73 +                     (baz [a b] "two-arg baz!"))]
    1.74 +      (is (= "two-arg baz!" (baz obj nil)))
    1.75 +      (is (thrown? AbstractMethodError (baz obj)))))
    1.76 +  (testing "you can redefine a protocol with different methods"
    1.77 +    (eval '(defprotocol Elusive (old-method [x])))
    1.78 +    (eval '(defprotocol Elusive (new-method [x])))
    1.79 +    (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
    1.80 +    (is (fails-with-cause? IllegalArgumentException #"No method of interface: user\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)"
    1.81 +          (eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
    1.82 +
    1.83 +(deftype ExtendTestWidget [name])
    1.84 +(deftype HasProtocolInline []
    1.85 +  ExampleProtocol
    1.86 +  (foo [this] :inline))
    1.87 +(deftest extend-test
    1.88 +  (testing "you can extend a protocol to a class"
    1.89 +    (extend String ExampleProtocol
    1.90 +            {:foo identity})
    1.91 +    (is (= "pow" (foo "pow"))))
    1.92 +  (testing "you can have two methods with the same name. Just use namespaces!"
    1.93 +    (extend String other/SimpleProtocol
    1.94 +     {:foo (fn [s] (.toUpperCase s))})
    1.95 +    (is (= "POW" (other/foo "pow"))))
    1.96 +  (testing "you can extend deftype types"
    1.97 +    (extend
    1.98 +     ExtendTestWidget
    1.99 +     ExampleProtocol
   1.100 +     {:foo (fn [this] (str "widget " (.name this)))})
   1.101 +    (is (= "widget z" (foo (ExtendTestWidget. "z"))))))
   1.102 +
   1.103 +(deftest illegal-extending
   1.104 +  (testing "you cannot extend a protocol to a type that implements the protocol inline"
   1.105 +    (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
   1.106 +          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
   1.107 +                         clojure.test-clojure.protocols.examples/ExampleProtocol
   1.108 +                         {:foo (fn [_] :extended)})))))
   1.109 +  (testing "you cannot extend to an interface"
   1.110 +    (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
   1.111 +          (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
   1.112 +                         clojure.test_clojure.protocols.examples.ExampleProtocol
   1.113 +                         {:foo (fn [_] :extended)}))))))
   1.114 +
   1.115 +(deftype ExtendsTestWidget []
   1.116 +  ExampleProtocol)
   1.117 +(deftest extends?-test
   1.118 +  (reload-example-protocols)
   1.119 +  (testing "returns false if a type does not implement the protocol at all"
   1.120 +    (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
   1.121 +  (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
   1.122 +    (is (true? (extends? ExampleProtocol ExtendsTestWidget))))
   1.123 +  (testing "returns true if a type explicitly extends protocol"
   1.124 +    (extend
   1.125 +     ExtendsTestWidget
   1.126 +     other/SimpleProtocol
   1.127 +     {:foo identity})
   1.128 +    (is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
   1.129 +
   1.130 +(deftype ExtendersTestWidget [])
   1.131 +(deftest extenders-test
   1.132 +  (reload-example-protocols)
   1.133 +  (testing "a fresh protocol has no extenders"
   1.134 +    (is (nil? (extenders ExampleProtocol))))
   1.135 +  (testing "extending with no methods doesn't count!"
   1.136 +    (deftype Something [])
   1.137 +    (extend ::Something ExampleProtocol)
   1.138 +    (is (nil? (extenders ExampleProtocol))))
   1.139 +  (testing "extending a protocol (and including an impl) adds an entry to extenders"
   1.140 +    (extend ExtendersTestWidget ExampleProtocol {:foo identity})
   1.141 +    (is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
   1.142 +
   1.143 +(deftype SatisfiesTestWidget []
   1.144 +  ExampleProtocol)
   1.145 +(deftest satisifies?-test
   1.146 +  (reload-example-protocols)
   1.147 +  (let [whatzit (SatisfiesTestWidget.)]
   1.148 +    (testing "returns false if a type does not implement the protocol at all"
   1.149 +      (is (false? (satisfies? other/SimpleProtocol whatzit))))
   1.150 +    (testing "returns true if a type implements the protocol directly"
   1.151 +      (is (true? (satisfies? ExampleProtocol whatzit))))
   1.152 +    (testing "returns true if a type explicitly extends protocol"
   1.153 +      (extend
   1.154 +       SatisfiesTestWidget
   1.155 +       other/SimpleProtocol
   1.156 +       {:foo identity})
   1.157 +      (is (true? (satisfies? other/SimpleProtocol whatzit)))))  )
   1.158 +
   1.159 +(deftype ReExtendingTestWidget [])
   1.160 +(deftest re-extending-test
   1.161 +  (reload-example-protocols)
   1.162 +  (extend
   1.163 +   ReExtendingTestWidget
   1.164 +   ExampleProtocol
   1.165 +   {:foo (fn [_] "first foo")
   1.166 +    :baz (fn [_] "first baz")})
   1.167 +  (testing "if you re-extend, the old implementation is replaced (not merged!)"
   1.168 +    (extend
   1.169 +     ReExtendingTestWidget
   1.170 +     ExampleProtocol
   1.171 +     {:baz (fn [_] "second baz")
   1.172 +      :bar (fn [_ _] "second bar")})
   1.173 +    (let [whatzit (ReExtendingTestWidget.)]
   1.174 +      (is (thrown? IllegalArgumentException (foo whatzit)))
   1.175 +      (is (= "second bar" (bar whatzit nil)))
   1.176 +      (is (= "second baz" (baz whatzit))))))
   1.177 +
   1.178 +(defrecord DefrecordObjectMethodsWidgetA [a])
   1.179 +(defrecord DefrecordObjectMethodsWidgetB [a])
   1.180 +(deftest defrecord-object-methods-test
   1.181 +  (testing "= depends on fields and type"
   1.182 +    (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
   1.183 +    (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
   1.184 +    (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
   1.185 +
   1.186 +(deftest defrecord-acts-like-a-map
   1.187 +  (let [rec (r 1 2)]
   1.188 +    (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
   1.189 +    (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
   1.190 +    (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
   1.191 +
   1.192 +(deftest degenerate-defrecord-test
   1.193 +  (let [empty (EmptyRecord.)]
   1.194 +    (is (nil? (seq empty)))
   1.195 +    (is (not (.containsValue empty :a)))))
   1.196 +
   1.197 +(deftest defrecord-interfaces-test
   1.198 +  (testing "java.util.Map"
   1.199 +    (let [rec (r 1 2)]
   1.200 +      (is (= 2 (.size rec)))
   1.201 +      (is (= 3 (.size (assoc rec :c 3))))
   1.202 +      (is (not (.isEmpty rec)))
   1.203 +      (is (.isEmpty (EmptyRecord.)))
   1.204 +      (is (.containsKey rec :a))
   1.205 +      (is (not (.containsKey rec :c)))
   1.206 +      (is (.containsValue rec 1))
   1.207 +      (is (not (.containsValue rec 3)))
   1.208 +      (is (= 1 (.get rec :a)))
   1.209 +      (is (thrown? UnsupportedOperationException (.put rec :a 1)))
   1.210 +      (is (thrown? UnsupportedOperationException (.remove rec :a)))
   1.211 +      (is (thrown? UnsupportedOperationException (.putAll rec {})))
   1.212 +      (is (thrown? UnsupportedOperationException (.clear rec)))
   1.213 +      (is (= #{:a :b} (.keySet rec)))
   1.214 +      (is (= #{1 2} (set (.values rec))))
   1.215 +      (is (= #{[:a 1] [:b 2]} (.entrySet rec)))
   1.216 +      
   1.217 +      ))
   1.218 +  (testing "IPersistentCollection"
   1.219 +    (testing ".cons"
   1.220 +      (let [rec (r 1 2)]
   1.221 +        (are [x] (= rec (.cons rec x))
   1.222 +             nil {})
   1.223 +        (is (= (r 1 3) (.cons rec {:b 3})))
   1.224 +        (is (= (r 1 4) (.cons rec [:b 4])))
   1.225 +        (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
   1.226 +
   1.227 +(defrecord RecordWithSpecificFieldNames [this that k m o])
   1.228 +(deftest defrecord-with-specific-field-names
   1.229 +  (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]
   1.230 +    (is (= rec rec))
   1.231 +    (is (= 1 (:this (with-meta rec {:foo :bar}))))
   1.232 +    (is (= 3 (get rec :k)))
   1.233 +    (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
   1.234 +    (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
   1.235 +
   1.236 +(deftest reify-test
   1.237 +  (testing "of an interface"
   1.238 +    (let [s :foo
   1.239 +          r (reify
   1.240 +             java.util.List
   1.241 +             (contains [_ o] (= s o)))]
   1.242 +      (testing "implemented methods"
   1.243 +        (is (true? (.contains r :foo)))
   1.244 +        (is (false? (.contains r :bar))))
   1.245 +      (testing "unimplemented methods"
   1.246 +        (is (thrown? AbstractMethodError (.add r :baz))))))
   1.247 +  (testing "of two interfaces"
   1.248 +    (let [r (reify
   1.249 +             java.util.List
   1.250 +             (contains [_ o] (= :foo o))
   1.251 +             java.util.Collection
   1.252 +             (isEmpty [_] false))]
   1.253 +      (is (true? (.contains r :foo)))
   1.254 +      (is (false? (.contains r :bar)))
   1.255 +      (is (false? (.isEmpty r)))))
   1.256 +  (testing "you can't define a method twice"
   1.257 +    (is (fails-with-cause?
   1.258 +         java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name"
   1.259 +         (eval '(reify
   1.260 +                 java.util.List
   1.261 +                 (size [_] 10)
   1.262 +                 java.util.Collection
   1.263 +                 (size [_] 20))))))
   1.264 +  (testing "you can't define a method not on an interface/protocol/j.l.Object"
   1.265 +    (is (fails-with-cause? 
   1.266 +         IllegalArgumentException #"^Can't define method not in interfaces: foo"
   1.267 +         (eval '(reify java.util.List (foo [_]))))))
   1.268 +  (testing "of a protocol"
   1.269 +    (let [r (reify
   1.270 +             ExampleProtocol
   1.271 +             (bar [this o] o)
   1.272 +             (baz [this] 1)
   1.273 +             (baz [this o] 2))]
   1.274 +      (= :foo (.bar r :foo))
   1.275 +      (= 1 (.baz r))
   1.276 +      (= 2 (.baz r nil))))
   1.277 +  (testing "destructuring in method def"
   1.278 +    (let [r (reify
   1.279 +             ExampleProtocol
   1.280 +             (bar [this [_ _ item]] item))]
   1.281 +      (= :c (.bar r [:a :b :c]))))
   1.282 +  (testing "methods can recur"
   1.283 +    (let [r (reify
   1.284 +             java.util.List
   1.285 +             (get [_ index]
   1.286 +                  (if (zero? index)
   1.287 +                    :done
   1.288 +                    (recur (dec index)))))]
   1.289 +      (is (= :done (.get r 0)))
   1.290 +      (is (= :done (.get r 1)))))
   1.291 +  (testing "disambiguating with type hints"
   1.292 +    (testing "you must hint an overloaded method"
   1.293 +      (is (fails-with-cause?
   1.294 +            IllegalArgumentException #"Must hint overloaded method: hinted"
   1.295 +            (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
   1.296 +    (testing "hinting"
   1.297 +      (let [r (reify
   1.298 +               ExampleInterface
   1.299 +               (hinted [_ ^int i] (inc i))
   1.300 +               (hinted [_ ^String s] (str s s)))]
   1.301 +        (is (= 2 (.hinted r 1)))
   1.302 +        (is (= "xoxo" (.hinted r "xo")))))))
   1.303 +