|
rlm@10
|
1 ; Copyright (c) Rich Hickey. All rights reserved.
|
|
rlm@10
|
2 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
4 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
5 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
6 ; the terms of this license.
|
|
rlm@10
|
7 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
8
|
|
rlm@10
|
9 ; Author: Stuart Halloway
|
|
rlm@10
|
10
|
|
rlm@10
|
11 (ns clojure.test-clojure.protocols
|
|
rlm@10
|
12 (:use clojure.test clojure.test-clojure.protocols.examples)
|
|
rlm@10
|
13 (:require [clojure.test-clojure.protocols.more-examples :as other]
|
|
rlm@10
|
14 [clojure.set :as set]
|
|
rlm@10
|
15 clojure.test-clojure.helpers)
|
|
rlm@10
|
16 (:import [clojure.test_clojure.protocols.examples ExampleInterface]))
|
|
rlm@10
|
17
|
|
rlm@10
|
18 ;; temporary hack until I decide how to cleanly reload protocol
|
|
rlm@10
|
19 (defn reload-example-protocols
|
|
rlm@10
|
20 []
|
|
rlm@10
|
21 (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
|
|
rlm@10
|
22 assoc :impls {})
|
|
rlm@10
|
23 (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
|
|
rlm@10
|
24 assoc :impls {})
|
|
rlm@10
|
25 (require :reload
|
|
rlm@10
|
26 'clojure.test-clojure.protocols.examples
|
|
rlm@10
|
27 'clojure.test-clojure.protocols.more-examples))
|
|
rlm@10
|
28
|
|
rlm@10
|
29 (defn method-names
|
|
rlm@10
|
30 "return sorted list of method names on a class"
|
|
rlm@10
|
31 [c]
|
|
rlm@10
|
32 (->> (.getMethods c)
|
|
rlm@10
|
33 (map #(.getName %))
|
|
rlm@10
|
34 (sort)))
|
|
rlm@10
|
35
|
|
rlm@10
|
36 (defrecord EmptyRecord [])
|
|
rlm@10
|
37 (defrecord TestRecord [a b])
|
|
rlm@10
|
38 (defn r
|
|
rlm@10
|
39 ([a b] (TestRecord. a b))
|
|
rlm@10
|
40 ([a b meta ext] (TestRecord. a b meta ext)))
|
|
rlm@10
|
41 (defrecord MapEntry [k v]
|
|
rlm@10
|
42 java.util.Map$Entry
|
|
rlm@10
|
43 (getKey [_] k)
|
|
rlm@10
|
44 (getValue [_] v))
|
|
rlm@10
|
45
|
|
rlm@10
|
46 (deftest protocols-test
|
|
rlm@10
|
47 (testing "protocol fns have useful metadata"
|
|
rlm@10
|
48 (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)
|
|
rlm@10
|
49 :protocol #'ExampleProtocol}]
|
|
rlm@10
|
50 (are [m f] (= (merge (quote m) common-meta)
|
|
rlm@10
|
51 (meta (var f)))
|
|
rlm@10
|
52 {:name foo :arglists ([a]) :doc "method with one arg"} foo
|
|
rlm@10
|
53 {:name bar :arglists ([a b]) :doc "method with two args"} bar
|
|
rlm@10
|
54 {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz
|
|
rlm@10
|
55 {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux)))
|
|
rlm@10
|
56 (testing "protocol fns throw IllegalArgumentException if no impl matches"
|
|
rlm@10
|
57 (is (thrown-with-msg?
|
|
rlm@10
|
58 IllegalArgumentException
|
|
rlm@10
|
59 #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer"
|
|
rlm@10
|
60 (foo 10))))
|
|
rlm@10
|
61 (testing "protocols generate a corresponding interface using _ instead of - for method names"
|
|
rlm@10
|
62 (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
|
|
rlm@10
|
63 (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
|
|
rlm@10
|
64 (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
|
|
rlm@10
|
65 (foo [] "foo!"))]
|
|
rlm@10
|
66 (is (= "foo!" (.foo obj)) "call through interface")
|
|
rlm@10
|
67 (is (= "foo!" (foo obj)) "call through protocol")))
|
|
rlm@10
|
68 (testing "you can implement just part of a protocol if you want"
|
|
rlm@10
|
69 (let [obj (reify ExampleProtocol
|
|
rlm@10
|
70 (baz [a b] "two-arg baz!"))]
|
|
rlm@10
|
71 (is (= "two-arg baz!" (baz obj nil)))
|
|
rlm@10
|
72 (is (thrown? AbstractMethodError (baz obj)))))
|
|
rlm@10
|
73 (testing "you can redefine a protocol with different methods"
|
|
rlm@10
|
74 (eval '(defprotocol Elusive (old-method [x])))
|
|
rlm@10
|
75 (eval '(defprotocol Elusive (new-method [x])))
|
|
rlm@10
|
76 (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
|
|
rlm@10
|
77 (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\.\)"
|
|
rlm@10
|
78 (eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
|
|
rlm@10
|
79
|
|
rlm@10
|
80 (deftype ExtendTestWidget [name])
|
|
rlm@10
|
81 (deftype HasProtocolInline []
|
|
rlm@10
|
82 ExampleProtocol
|
|
rlm@10
|
83 (foo [this] :inline))
|
|
rlm@10
|
84 (deftest extend-test
|
|
rlm@10
|
85 (testing "you can extend a protocol to a class"
|
|
rlm@10
|
86 (extend String ExampleProtocol
|
|
rlm@10
|
87 {:foo identity})
|
|
rlm@10
|
88 (is (= "pow" (foo "pow"))))
|
|
rlm@10
|
89 (testing "you can have two methods with the same name. Just use namespaces!"
|
|
rlm@10
|
90 (extend String other/SimpleProtocol
|
|
rlm@10
|
91 {:foo (fn [s] (.toUpperCase s))})
|
|
rlm@10
|
92 (is (= "POW" (other/foo "pow"))))
|
|
rlm@10
|
93 (testing "you can extend deftype types"
|
|
rlm@10
|
94 (extend
|
|
rlm@10
|
95 ExtendTestWidget
|
|
rlm@10
|
96 ExampleProtocol
|
|
rlm@10
|
97 {:foo (fn [this] (str "widget " (.name this)))})
|
|
rlm@10
|
98 (is (= "widget z" (foo (ExtendTestWidget. "z"))))))
|
|
rlm@10
|
99
|
|
rlm@10
|
100 (deftest illegal-extending
|
|
rlm@10
|
101 (testing "you cannot extend a protocol to a type that implements the protocol inline"
|
|
rlm@10
|
102 (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
|
|
rlm@10
|
103 (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
|
|
rlm@10
|
104 clojure.test-clojure.protocols.examples/ExampleProtocol
|
|
rlm@10
|
105 {:foo (fn [_] :extended)})))))
|
|
rlm@10
|
106 (testing "you cannot extend to an interface"
|
|
rlm@10
|
107 (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
|
|
rlm@10
|
108 (eval '(extend clojure.test-clojure.protocols.HasProtocolInline
|
|
rlm@10
|
109 clojure.test_clojure.protocols.examples.ExampleProtocol
|
|
rlm@10
|
110 {:foo (fn [_] :extended)}))))))
|
|
rlm@10
|
111
|
|
rlm@10
|
112 (deftype ExtendsTestWidget []
|
|
rlm@10
|
113 ExampleProtocol)
|
|
rlm@10
|
114 (deftest extends?-test
|
|
rlm@10
|
115 (reload-example-protocols)
|
|
rlm@10
|
116 (testing "returns false if a type does not implement the protocol at all"
|
|
rlm@10
|
117 (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
|
|
rlm@10
|
118 (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
|
|
rlm@10
|
119 (is (true? (extends? ExampleProtocol ExtendsTestWidget))))
|
|
rlm@10
|
120 (testing "returns true if a type explicitly extends protocol"
|
|
rlm@10
|
121 (extend
|
|
rlm@10
|
122 ExtendsTestWidget
|
|
rlm@10
|
123 other/SimpleProtocol
|
|
rlm@10
|
124 {:foo identity})
|
|
rlm@10
|
125 (is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
|
|
rlm@10
|
126
|
|
rlm@10
|
127 (deftype ExtendersTestWidget [])
|
|
rlm@10
|
128 (deftest extenders-test
|
|
rlm@10
|
129 (reload-example-protocols)
|
|
rlm@10
|
130 (testing "a fresh protocol has no extenders"
|
|
rlm@10
|
131 (is (nil? (extenders ExampleProtocol))))
|
|
rlm@10
|
132 (testing "extending with no methods doesn't count!"
|
|
rlm@10
|
133 (deftype Something [])
|
|
rlm@10
|
134 (extend ::Something ExampleProtocol)
|
|
rlm@10
|
135 (is (nil? (extenders ExampleProtocol))))
|
|
rlm@10
|
136 (testing "extending a protocol (and including an impl) adds an entry to extenders"
|
|
rlm@10
|
137 (extend ExtendersTestWidget ExampleProtocol {:foo identity})
|
|
rlm@10
|
138 (is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
|
|
rlm@10
|
139
|
|
rlm@10
|
140 (deftype SatisfiesTestWidget []
|
|
rlm@10
|
141 ExampleProtocol)
|
|
rlm@10
|
142 (deftest satisifies?-test
|
|
rlm@10
|
143 (reload-example-protocols)
|
|
rlm@10
|
144 (let [whatzit (SatisfiesTestWidget.)]
|
|
rlm@10
|
145 (testing "returns false if a type does not implement the protocol at all"
|
|
rlm@10
|
146 (is (false? (satisfies? other/SimpleProtocol whatzit))))
|
|
rlm@10
|
147 (testing "returns true if a type implements the protocol directly"
|
|
rlm@10
|
148 (is (true? (satisfies? ExampleProtocol whatzit))))
|
|
rlm@10
|
149 (testing "returns true if a type explicitly extends protocol"
|
|
rlm@10
|
150 (extend
|
|
rlm@10
|
151 SatisfiesTestWidget
|
|
rlm@10
|
152 other/SimpleProtocol
|
|
rlm@10
|
153 {:foo identity})
|
|
rlm@10
|
154 (is (true? (satisfies? other/SimpleProtocol whatzit))))) )
|
|
rlm@10
|
155
|
|
rlm@10
|
156 (deftype ReExtendingTestWidget [])
|
|
rlm@10
|
157 (deftest re-extending-test
|
|
rlm@10
|
158 (reload-example-protocols)
|
|
rlm@10
|
159 (extend
|
|
rlm@10
|
160 ReExtendingTestWidget
|
|
rlm@10
|
161 ExampleProtocol
|
|
rlm@10
|
162 {:foo (fn [_] "first foo")
|
|
rlm@10
|
163 :baz (fn [_] "first baz")})
|
|
rlm@10
|
164 (testing "if you re-extend, the old implementation is replaced (not merged!)"
|
|
rlm@10
|
165 (extend
|
|
rlm@10
|
166 ReExtendingTestWidget
|
|
rlm@10
|
167 ExampleProtocol
|
|
rlm@10
|
168 {:baz (fn [_] "second baz")
|
|
rlm@10
|
169 :bar (fn [_ _] "second bar")})
|
|
rlm@10
|
170 (let [whatzit (ReExtendingTestWidget.)]
|
|
rlm@10
|
171 (is (thrown? IllegalArgumentException (foo whatzit)))
|
|
rlm@10
|
172 (is (= "second bar" (bar whatzit nil)))
|
|
rlm@10
|
173 (is (= "second baz" (baz whatzit))))))
|
|
rlm@10
|
174
|
|
rlm@10
|
175 (defrecord DefrecordObjectMethodsWidgetA [a])
|
|
rlm@10
|
176 (defrecord DefrecordObjectMethodsWidgetB [a])
|
|
rlm@10
|
177 (deftest defrecord-object-methods-test
|
|
rlm@10
|
178 (testing "= depends on fields and type"
|
|
rlm@10
|
179 (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
|
|
rlm@10
|
180 (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
|
|
rlm@10
|
181 (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
|
|
rlm@10
|
182
|
|
rlm@10
|
183 (deftest defrecord-acts-like-a-map
|
|
rlm@10
|
184 (let [rec (r 1 2)]
|
|
rlm@10
|
185 (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
|
|
rlm@10
|
186 (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
|
|
rlm@10
|
187 (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
|
|
rlm@10
|
188
|
|
rlm@10
|
189 (deftest degenerate-defrecord-test
|
|
rlm@10
|
190 (let [empty (EmptyRecord.)]
|
|
rlm@10
|
191 (is (nil? (seq empty)))
|
|
rlm@10
|
192 (is (not (.containsValue empty :a)))))
|
|
rlm@10
|
193
|
|
rlm@10
|
194 (deftest defrecord-interfaces-test
|
|
rlm@10
|
195 (testing "java.util.Map"
|
|
rlm@10
|
196 (let [rec (r 1 2)]
|
|
rlm@10
|
197 (is (= 2 (.size rec)))
|
|
rlm@10
|
198 (is (= 3 (.size (assoc rec :c 3))))
|
|
rlm@10
|
199 (is (not (.isEmpty rec)))
|
|
rlm@10
|
200 (is (.isEmpty (EmptyRecord.)))
|
|
rlm@10
|
201 (is (.containsKey rec :a))
|
|
rlm@10
|
202 (is (not (.containsKey rec :c)))
|
|
rlm@10
|
203 (is (.containsValue rec 1))
|
|
rlm@10
|
204 (is (not (.containsValue rec 3)))
|
|
rlm@10
|
205 (is (= 1 (.get rec :a)))
|
|
rlm@10
|
206 (is (thrown? UnsupportedOperationException (.put rec :a 1)))
|
|
rlm@10
|
207 (is (thrown? UnsupportedOperationException (.remove rec :a)))
|
|
rlm@10
|
208 (is (thrown? UnsupportedOperationException (.putAll rec {})))
|
|
rlm@10
|
209 (is (thrown? UnsupportedOperationException (.clear rec)))
|
|
rlm@10
|
210 (is (= #{:a :b} (.keySet rec)))
|
|
rlm@10
|
211 (is (= #{1 2} (set (.values rec))))
|
|
rlm@10
|
212 (is (= #{[:a 1] [:b 2]} (.entrySet rec)))
|
|
rlm@10
|
213
|
|
rlm@10
|
214 ))
|
|
rlm@10
|
215 (testing "IPersistentCollection"
|
|
rlm@10
|
216 (testing ".cons"
|
|
rlm@10
|
217 (let [rec (r 1 2)]
|
|
rlm@10
|
218 (are [x] (= rec (.cons rec x))
|
|
rlm@10
|
219 nil {})
|
|
rlm@10
|
220 (is (= (r 1 3) (.cons rec {:b 3})))
|
|
rlm@10
|
221 (is (= (r 1 4) (.cons rec [:b 4])))
|
|
rlm@10
|
222 (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
|
|
rlm@10
|
223
|
|
rlm@10
|
224 (defrecord RecordWithSpecificFieldNames [this that k m o])
|
|
rlm@10
|
225 (deftest defrecord-with-specific-field-names
|
|
rlm@10
|
226 (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]
|
|
rlm@10
|
227 (is (= rec rec))
|
|
rlm@10
|
228 (is (= 1 (:this (with-meta rec {:foo :bar}))))
|
|
rlm@10
|
229 (is (= 3 (get rec :k)))
|
|
rlm@10
|
230 (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
|
|
rlm@10
|
231 (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
|
|
rlm@10
|
232
|
|
rlm@10
|
233 (deftest reify-test
|
|
rlm@10
|
234 (testing "of an interface"
|
|
rlm@10
|
235 (let [s :foo
|
|
rlm@10
|
236 r (reify
|
|
rlm@10
|
237 java.util.List
|
|
rlm@10
|
238 (contains [_ o] (= s o)))]
|
|
rlm@10
|
239 (testing "implemented methods"
|
|
rlm@10
|
240 (is (true? (.contains r :foo)))
|
|
rlm@10
|
241 (is (false? (.contains r :bar))))
|
|
rlm@10
|
242 (testing "unimplemented methods"
|
|
rlm@10
|
243 (is (thrown? AbstractMethodError (.add r :baz))))))
|
|
rlm@10
|
244 (testing "of two interfaces"
|
|
rlm@10
|
245 (let [r (reify
|
|
rlm@10
|
246 java.util.List
|
|
rlm@10
|
247 (contains [_ o] (= :foo o))
|
|
rlm@10
|
248 java.util.Collection
|
|
rlm@10
|
249 (isEmpty [_] false))]
|
|
rlm@10
|
250 (is (true? (.contains r :foo)))
|
|
rlm@10
|
251 (is (false? (.contains r :bar)))
|
|
rlm@10
|
252 (is (false? (.isEmpty r)))))
|
|
rlm@10
|
253 (testing "you can't define a method twice"
|
|
rlm@10
|
254 (is (fails-with-cause?
|
|
rlm@10
|
255 java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name"
|
|
rlm@10
|
256 (eval '(reify
|
|
rlm@10
|
257 java.util.List
|
|
rlm@10
|
258 (size [_] 10)
|
|
rlm@10
|
259 java.util.Collection
|
|
rlm@10
|
260 (size [_] 20))))))
|
|
rlm@10
|
261 (testing "you can't define a method not on an interface/protocol/j.l.Object"
|
|
rlm@10
|
262 (is (fails-with-cause?
|
|
rlm@10
|
263 IllegalArgumentException #"^Can't define method not in interfaces: foo"
|
|
rlm@10
|
264 (eval '(reify java.util.List (foo [_]))))))
|
|
rlm@10
|
265 (testing "of a protocol"
|
|
rlm@10
|
266 (let [r (reify
|
|
rlm@10
|
267 ExampleProtocol
|
|
rlm@10
|
268 (bar [this o] o)
|
|
rlm@10
|
269 (baz [this] 1)
|
|
rlm@10
|
270 (baz [this o] 2))]
|
|
rlm@10
|
271 (= :foo (.bar r :foo))
|
|
rlm@10
|
272 (= 1 (.baz r))
|
|
rlm@10
|
273 (= 2 (.baz r nil))))
|
|
rlm@10
|
274 (testing "destructuring in method def"
|
|
rlm@10
|
275 (let [r (reify
|
|
rlm@10
|
276 ExampleProtocol
|
|
rlm@10
|
277 (bar [this [_ _ item]] item))]
|
|
rlm@10
|
278 (= :c (.bar r [:a :b :c]))))
|
|
rlm@10
|
279 (testing "methods can recur"
|
|
rlm@10
|
280 (let [r (reify
|
|
rlm@10
|
281 java.util.List
|
|
rlm@10
|
282 (get [_ index]
|
|
rlm@10
|
283 (if (zero? index)
|
|
rlm@10
|
284 :done
|
|
rlm@10
|
285 (recur (dec index)))))]
|
|
rlm@10
|
286 (is (= :done (.get r 0)))
|
|
rlm@10
|
287 (is (= :done (.get r 1)))))
|
|
rlm@10
|
288 (testing "disambiguating with type hints"
|
|
rlm@10
|
289 (testing "you must hint an overloaded method"
|
|
rlm@10
|
290 (is (fails-with-cause?
|
|
rlm@10
|
291 IllegalArgumentException #"Must hint overloaded method: hinted"
|
|
rlm@10
|
292 (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
|
|
rlm@10
|
293 (testing "hinting"
|
|
rlm@10
|
294 (let [r (reify
|
|
rlm@10
|
295 ExampleInterface
|
|
rlm@10
|
296 (hinted [_ ^int i] (inc i))
|
|
rlm@10
|
297 (hinted [_ ^String s] (str s s)))]
|
|
rlm@10
|
298 (is (= 2 (.hinted r 1)))
|
|
rlm@10
|
299 (is (= "xoxo" (.hinted r "xo")))))))
|
|
rlm@10
|
300
|
