|
Java example source code file (protocols.clj)
The protocols.clj Java example source code; Copyright (c) Rich Hickey. 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) ; which can be found in the file epl-v10.html at the root of this distribution. ; 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. ; Author: Stuart Halloway (ns clojure.test-clojure.protocols (:use clojure.test clojure.test-clojure.protocols.examples) (:require [clojure.test-clojure.protocols.more-examples :as other] [clojure.set :as set] clojure.test-helper) (:import [clojure.test_clojure.protocols.examples ExampleInterface])) ;; temporary hack until I decide how to cleanly reload protocol ;; this no longer works (defn reload-example-protocols [] (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol assoc :impls {}) (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol assoc :impls {}) (require :reload 'clojure.test-clojure.protocols.examples 'clojure.test-clojure.protocols.more-examples)) (defn method-names "return sorted list of method names on a class" [c] (->> (.getMethods c) (map #(.getName %)) (sort))) (defrecord EmptyRecord []) (defrecord TestRecord [a b]) (defn r ([a b] (TestRecord. a b)) ([a b meta ext] (TestRecord. a b meta ext))) (defrecord MapEntry [k v] java.util.Map$Entry (getKey [_] k) (getValue [_] v)) (deftest protocols-test (testing "protocol fns have useful metadata" (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples) :protocol #'ExampleProtocol}] (are [m f] (= (merge (quote m) common-meta) (meta (var f))) {:name foo :arglists ([a]) :doc "method with one arg"} foo {:name bar :arglists ([a b]) :doc "method with two args"} bar {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux))) (testing "protocol fns throw IllegalArgumentException if no impl matches" (is (thrown-with-msg? IllegalArgumentException #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Long" (foo 10)))) (testing "protocols generate a corresponding interface using _ instead of - for method names" (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol)))) (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)" (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] [] (foo [] "foo!"))] (is (= "foo!" (.foo obj)) "call through interface") (is (= "foo!" (foo obj)) "call through protocol"))) (testing "you can implement just part of a protocol if you want" (let [obj (reify ExampleProtocol (baz [a b] "two-arg baz!"))] (is (= "two-arg baz!" (baz obj nil))) (is (thrown? AbstractMethodError (baz obj))))) (testing "error conditions checked when defining protocols" (is (thrown-with-msg? Exception #"Definition of function m in protocol badprotdef must take at least one arg." (eval '(defprotocol badprotdef (m []))))) (is (thrown-with-msg? Exception #"Function m in protocol badprotdef was redefined. Specify all arities in single definition." (eval '(defprotocol badprotdef (m [this arg]) (m [this arg1 arg2])))))) (testing "you can redefine a protocol with different methods" (eval '(defprotocol Elusive (old-method [x]))) (eval '(defprotocol Elusive (new-method [x]))) (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method)))))) (is (fails-with-cause? IllegalArgumentException #"No method of interface: .*\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)" (eval '(old-method (reify Elusive (new-method [x] :new-method)))))))) (deftype HasMarkers [] ExampleProtocol (foo [this] "foo") MarkerProtocol MarkerProtocol2) (deftype WillGetMarker [] ExampleProtocol (foo [this] "foo")) (extend-type WillGetMarker MarkerProtocol) (deftest marker-tests (testing "That a marker protocol has no methods" (is (= '() (method-names clojure.test_clojure.protocols.examples.MarkerProtocol)))) (testing "That types with markers are reportedly satifying them." (let [hm (HasMarkers.) wgm (WillGetMarker.)] (is (satisfies? MarkerProtocol hm)) (is (satisfies? MarkerProtocol2 hm)) (is (satisfies? MarkerProtocol wgm))))) (deftype ExtendTestWidget [name]) (deftype HasProtocolInline [] ExampleProtocol (foo [this] :inline)) (deftest extend-test (testing "you can extend a protocol to a class" (extend String ExampleProtocol {:foo identity}) (is (= "pow" (foo "pow")))) (testing "you can have two methods with the same name. Just use namespaces!" (extend String other/SimpleProtocol {:foo (fn [s] (.toUpperCase s))}) (is (= "POW" (other/foo "pow")))) (testing "you can extend deftype types" (extend ExtendTestWidget ExampleProtocol {:foo (fn [this] (str "widget " (.name this)))}) (is (= "widget z" (foo (ExtendTestWidget. "z")))))) (deftest record-marker-interfaces (testing "record? and type? return expected result for IRecord and IType" (let [r (TestRecord. 1 2)] (is (record? r))))) (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 (reload-example-protocols) (testing "returns false if a type does not implement the protocol at all" (is (false? (extends? other/SimpleProtocol ExtendsTestWidget)))) (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010 (is (true? (extends? ExampleProtocol ExtendsTestWidget)))) (testing "returns true if a type explicitly extends protocol" (extend ExtendsTestWidget other/SimpleProtocol {:foo identity}) (is (true? (extends? other/SimpleProtocol ExtendsTestWidget))))) (deftype ExtendersTestWidget []) #_(deftest extenders-test (reload-example-protocols) (testing "a fresh protocol has no extenders" (is (nil? (extenders ExampleProtocol)))) (testing "extending with no methods doesn't count!" (deftype Something []) (extend ::Something ExampleProtocol) (is (nil? (extenders ExampleProtocol)))) (testing "extending a protocol (and including an impl) adds an entry to extenders" (extend ExtendersTestWidget ExampleProtocol {:foo identity}) (is (= [ExtendersTestWidget] (extenders ExampleProtocol))))) (deftype SatisfiesTestWidget [] ExampleProtocol) #_(deftest satisifies?-test (reload-example-protocols) (let [whatzit (SatisfiesTestWidget.)] (testing "returns false if a type does not implement the protocol at all" (is (false? (satisfies? other/SimpleProtocol whatzit)))) (testing "returns true if a type implements the protocol directly" (is (true? (satisfies? ExampleProtocol whatzit)))) (testing "returns true if a type explicitly extends protocol" (extend SatisfiesTestWidget other/SimpleProtocol {:foo identity}) (is (true? (satisfies? other/SimpleProtocol whatzit))))) ) (deftype ReExtendingTestWidget []) #_(deftest re-extending-test (reload-example-protocols) (extend ReExtendingTestWidget ExampleProtocol {:foo (fn [_] "first foo") :baz (fn [_] "first baz")}) (testing "if you re-extend, the old implementation is replaced (not merged!)" (extend ReExtendingTestWidget ExampleProtocol {:baz (fn [_] "second baz") :bar (fn [_ _] "second bar")}) (let [whatzit (ReExtendingTestWidget.)] (is (thrown? IllegalArgumentException (foo whatzit))) (is (= "second bar" (bar whatzit nil))) (is (= "second baz" (baz whatzit)))))) (defrecord DefrecordObjectMethodsWidgetA [a]) (defrecord DefrecordObjectMethodsWidgetB [a]) (deftest defrecord-object-methods-test (testing "= depends on fields and type" (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1)))) (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2)))) (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1)))))) (deftest defrecord-acts-like-a-map (let [rec (r 1 2)] (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4}))) (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo}))) (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10}))))) (deftest degenerate-defrecord-test (let [empty (EmptyRecord.)] (is (nil? (seq empty))) (is (not (.containsValue empty :a))))) (deftest defrecord-interfaces-test (testing "java.util.Map" (let [rec (r 1 2)] (is (= 2 (.size rec))) (is (= 3 (.size (assoc rec :c 3)))) (is (not (.isEmpty rec))) (is (.isEmpty (EmptyRecord.))) (is (.containsKey rec :a)) (is (not (.containsKey rec :c))) (is (.containsValue rec 1)) (is (not (.containsValue rec 3))) (is (= 1 (.get rec :a))) (is (thrown? UnsupportedOperationException (.put rec :a 1))) (is (thrown? UnsupportedOperationException (.remove rec :a))) (is (thrown? UnsupportedOperationException (.putAll rec {}))) (is (thrown? UnsupportedOperationException (.clear rec))) (is (= #{:a :b} (.keySet rec))) (is (= #{1 2} (set (.values rec)))) (is (= #{[:a 1] [:b 2]} (.entrySet rec))) )) (testing "IPersistentCollection" (testing ".cons" (let [rec (r 1 2)] (are [x] (= rec (.cons rec x)) nil {}) (is (= (r 1 3) (.cons rec {:b 3}))) (is (= (r 1 4) (.cons rec [:b 4]))) (is (= (r 1 5) (.cons rec (MapEntry. :b 5)))))))) (defrecord RecordWithSpecificFieldNames [this that k m o]) (deftest defrecord-with-specific-field-names (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)] (is (= rec rec)) (is (= 1 (:this (with-meta rec {:foo :bar})))) (is (= 3 (get rec :k))) (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5]))) (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5})))) (defrecord RecordToTestStatics1 [a]) (defrecord RecordToTestStatics2 [a b]) (defrecord RecordToTestStatics3 [a b c]) (defrecord RecordToTestBasis [a b c]) (defrecord RecordToTestBasisHinted [^String a ^Long b c]) (defrecord RecordToTestHugeBasis [a b c d e f g h i j k l m n o p q r s t u v w x y z]) (defrecord TypeToTestBasis [a b c]) (defrecord TypeToTestBasisHinted [^String a ^Long b c]) (deftest test-statics (testing "that a record has its generated static methods" (let [r1 (RecordToTestStatics1. 1) r2 (RecordToTestStatics2. 1 2) r3 (RecordToTestStatics3. 1 2 3) rn (RecordToTestStatics3. 1 nil nil)] (testing "that a record created with the ctor equals one by the static factory method" (is (= r1 (RecordToTestStatics1/create {:a 1}))) (is (= r2 (RecordToTestStatics2/create {:a 1 :b 2}))) (is (= r3 (RecordToTestStatics3/create {:a 1 :b 2 :c 3}))) (is (= rn (RecordToTestStatics3/create {:a 1})))) (testing "that a literal record equals one by the static factory method" (is (= #clojure.test_clojure.protocols.RecordToTestStatics1{:a 1} (RecordToTestStatics1/create {:a 1}))) (is (= #clojure.test_clojure.protocols.RecordToTestStatics2{:a 1 :b 2} (RecordToTestStatics2/create {:a 1 :b 2}))) (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b 2 :c 3} (RecordToTestStatics3/create {:a 1 :b 2 :c 3}))) (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1} (RecordToTestStatics3/create {:a 1}))) (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b nil :c nil} (RecordToTestStatics3/create {:a 1})))))) (testing "that records and types have a sane generated basis method" (let [rb (clojure.test_clojure.protocols.RecordToTestBasis/getBasis) rbh (clojure.test_clojure.protocols.RecordToTestBasisHinted/getBasis) rhg (clojure.test_clojure.protocols.RecordToTestHugeBasis/getBasis) tb (clojure.test_clojure.protocols.TypeToTestBasis/getBasis) tbh (clojure.test_clojure.protocols.TypeToTestBasisHinted/getBasis)] (is (= '[a b c] rb)) (is (= '[a b c] rb)) (is (= '[a b c d e f g h i j k l m n o p q r s t u v w x y z] rhg)) (testing "that record basis hinting looks as we expect" (is (= (:tag (meta (rbh 0))) 'String)) (is (= (:tag (meta (rbh 1))) 'Long)) (is (nil? (:tag (meta (rbh 2)))))) (testing "that type basis hinting looks as we expect" (is (= (:tag (meta (tbh 0))) 'String)) (is (= (:tag (meta (tbh 1))) 'Long)) (is (nil? (:tag (meta (tbh 2))))))))) (defrecord RecordToTestFactories [a b c]) (defrecord RecordToTestA [a]) (defrecord RecordToTestB [b]) (defrecord RecordToTestHugeFactories [a b c d e f g h i j k l m n o p q r s t u v w x y z]) (defrecord RecordToTestDegenerateFactories []) (deftest test-record-factory-fns (testing "if the definition of a defrecord generates the appropriate factory functions" (let [r (RecordToTestFactories. 1 2 3) r-n (RecordToTestFactories. nil nil nil) huge (RecordToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) r-a (map->RecordToTestA {:a 1 :b 2}) r-b (map->RecordToTestB {:a 1 :b 2}) r-d (RecordToTestDegenerateFactories.)] (testing "that a record created with the ctor equals one by the positional factory fn" (is (= r (->RecordToTestFactories 1 2 3))) (is (= huge (->RecordToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)))) (testing "that a record created with the ctor equals one by the map-> factory fn" (is (= r (map->RecordToTestFactories {:a 1 :b 2 :c 3}))) (is (= r-n (map->RecordToTestFactories {}))) (is (= r (map->RecordToTestFactories (map->RecordToTestFactories {:a 1 :b 2 :c 3})))) (is (= r-n (map->RecordToTestFactories (map->RecordToTestFactories {})))) (is (= r-d (map->RecordToTestDegenerateFactories {}))) (is (= r-d (map->RecordToTestDegenerateFactories (map->RecordToTestDegenerateFactories {}))))) (testing "that ext maps work correctly" (is (= (assoc r :xxx 42) (map->RecordToTestFactories {:a 1 :b 2 :c 3 :xxx 42}))) (is (= (assoc r :xxx 42) (map->RecordToTestFactories (map->RecordToTestFactories {:a 1 :b 2 :c 3 :xxx 42})))) (is (= (assoc r-n :xxx 42) (map->RecordToTestFactories {:xxx 42}))) (is (= (assoc r-n :xxx 42) (map->RecordToTestFactories (map->RecordToTestFactories {:xxx 42})))) (is (= (assoc r-d :xxx 42) (map->RecordToTestDegenerateFactories {:xxx 42}))) (is (= (assoc r-d :xxx 42) (map->RecordToTestDegenerateFactories (map->RecordToTestDegenerateFactories {:xxx 42}))))) (testing "record equality" (is (not= r-a r-b)) (is (= (into {} r-a) (into {} r-b))) (is (not= (into {} r-a) r-b)) (is (= (map->RecordToTestA {:a 1 :b 2}) (map->RecordToTestA (map->RecordToTestB {:a 1 :b 2})))) (is (= (map->RecordToTestA {:a 1 :b 2 :c 3}) (map->RecordToTestA (map->RecordToTestB {:a 1 :b 2 :c 3})))) (is (= (map->RecordToTestA {:a 1 :d 4}) (map->RecordToTestA (map->RecordToTestDegenerateFactories {:a 1 :d 4})))) (is (= r-n (map->RecordToTestFactories (java.util.HashMap.)))) (is (= r-a (map->RecordToTestA (into {} r-b)))) (is (= r-a (map->RecordToTestA r-b))) (is (not= r-a (map->RecordToTestB r-a))) (is (= r (assoc r-n :a 1 :b 2 :c 3))) (is (not= r-a (assoc r-n :a 1 :b 2))) (is (not= (assoc r-b :c 3 :d 4) (assoc r-n :a 1 :b 2 :c 3 :d 4))) (is (= (into {} (assoc r-b :c 3 :d 4)) (into {} (assoc r-n :a 1 :b 2 :c 3 :d 4)))) (is (= (assoc r :d 4) (assoc r-n :a 1 :b 2 :c 3 :d 4)))) (testing "that factory functions have docstrings" ;; just test non-nil to avoid overspecifiying what's in the docstring (is (false? (-> ->RecordToTestFactories var meta :doc nil?))) (is (false? (-> map->RecordToTestFactories var meta :doc nil?)))) (testing "that a literal record equals one by the positional factory fn" (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (->RecordToTestFactories 1 2 3))) (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (->RecordToTestFactories 1 nil nil))) (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a [] :b {} :c ()} (->RecordToTestFactories [] {} ())))) (testing "that a literal record equals one by the map-> factory fn" (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (map->RecordToTestFactories {:a 1 :b 2 :c 3}))) (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (map->RecordToTestFactories {:a 1}))) (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a nil :b nil :c nil} (map->RecordToTestFactories {}))))))) (defn compare-huge-types [hugeL hugeR] (and (= (.a hugeL) (.a hugeR)) (= (.b hugeL) (.b hugeR)) (= (.c hugeL) (.c hugeR)) (= (.d hugeL) (.d hugeR)) (= (.e hugeL) (.e hugeR)) (= (.f hugeL) (.f hugeR)) (= (.g hugeL) (.g hugeR)) (= (.h hugeL) (.h hugeR)) (= (.i hugeL) (.i hugeR)) (= (.j hugeL) (.j hugeR)) (= (.k hugeL) (.k hugeR)) (= (.l hugeL) (.l hugeR)) (= (.m hugeL) (.m hugeR)) (= (.n hugeL) (.n hugeR)) (= (.o hugeL) (.o hugeR)) (= (.p hugeL) (.p hugeR)) (= (.q hugeL) (.q hugeR)) (= (.r hugeL) (.r hugeR)) (= (.s hugeL) (.s hugeR)) (= (.t hugeL) (.t hugeR)) (= (.u hugeL) (.u hugeR)) (= (.v hugeL) (.v hugeR)) (= (.w hugeL) (.w hugeR)) (= (.x hugeL) (.x hugeR)) (= (.y hugeL) (.y hugeR)) (= (.z hugeL) (.z hugeR)))) (deftype TypeToTestFactory [a]) (defrecord TypeToTestHugeFactories [a b c d e f g h i j k l m n o p q r s t u v w x y z]) (deftest deftype-factory-fn (testing "that the ->T factory is gen'd for a deftype and that it works" (is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42)))) (is (compare-huge-types (TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)))) (testing "that the generated factory checks arity constraints" (is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25))) (is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27))))) (deftest test-ctor-literals (testing "that constructor calls to print-dup'able classes are supported as literals" (is (= "Hi" #java.lang.String["Hi"])) (is (= 42 #java.lang.Long[42])) (is (= 42 #java.lang.Long["42"])) (is (= [:a 42] #clojure.lang.MapEntry[:a 42]))) (testing "that constructor literals are embeddable" (is (= 42 #java.lang.Long[#java.lang.String["42"]]))) (testing "that constructor literals work for deftypes too" (is (= (.a (TypeToTestFactory. 42)) (.a #clojure.test_clojure.protocols.TypeToTestFactory[42]))) (is (compare-huge-types (TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) #clojure.test_clojure.protocols.TypeToTestHugeFactories[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26])))) (defrecord RecordToTestLiterals [a]) (defrecord TestNode [v l r]) (deftype TypeToTestLiterals [a]) (def lang-str "en") (deftest exercise-literals (testing "that ctor literals can be used in common 'places'" (is (= (RecordToTestLiterals. ()) #clojure.test_clojure.protocols.RecordToTestLiterals[()])) (is (= (.a (TypeToTestLiterals. ())) (.a #clojure.test_clojure.protocols.TypeToTestLiterals[()]))) (is (= (RecordToTestLiterals. 42) (into #clojure.test_clojure.protocols.RecordToTestLiterals[0] {:a 42}))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (RecordToTestLiterals. #clojure.test_clojure.protocols.RecordToTestLiterals[42]))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (->RecordToTestLiterals #clojure.test_clojure.protocols.RecordToTestLiterals[42]))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]])) (is (= (TestNode. 1 (TestNode. 2 (TestNode. 3 nil nil) nil) (TestNode. 4 (TestNode. 5 (TestNode. 6 nil nil) nil) (TestNode. 7 nil nil))) #clojure.test_clojure.protocols.TestNode{:v 1 :l #clojure.test_clojure.protocols.TestNode{:v 2 :l #clojure.test_clojure.protocols.TestNode{:v 3 :l nil :r nil} :r nil} :r #clojure.test_clojure.protocols.TestNode{:v 4 :l #clojure.test_clojure.protocols.TestNode{:v 5 :l #clojure.test_clojure.protocols.TestNode{:v 6 :l nil :r nil} :r nil} :r #clojure.test_clojure.protocols.TestNode{:v 7 :l nil :r nil}}}))) (testing "that records and types are evalable" (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[42]))) (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a 42}))) (is (= (RecordToTestLiterals. 42) (eval (RecordToTestLiterals. 42)))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]]))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals{:a 42}]))) (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a #clojure.test_clojure.protocols.RecordToTestLiterals[42]}))) (is (= 42 (.a (eval #clojure.test_clojure.protocols.TypeToTestLiterals[42]))))) (testing "that ctor literals only work with constants or statics" (is (thrown? Exception (read-string "#java.util.Locale[(str 'en)]"))) (is (thrown? Exception (read-string "(let [s \"en\"] #java.util.Locale[(str 'en)])"))) (is (thrown? Exception (read-string "#clojure.test_clojure.protocols.RecordToTestLiterals{(keyword \"a\") 42}")))) (testing "that ctors can have whitespace after class name but before {" (is (= (RecordToTestLiterals. 42) (read-string "#clojure.test_clojure.protocols.RecordToTestLiterals {:a 42}")))) (testing "that the correct errors are thrown with malformed literals" (is (thrown-with-msg? Exception #"Unreadable constructor form.*" (read-string "#java.util.Locale(\"en\")"))) (is (thrown-with-msg? Exception #"Unexpected number of constructor arguments.*" (read-string "#java.util.Locale[\"\" \"\" \"\" \"\"]"))) (is (thrown? Exception (read-string "#java.util.Nachos(\"en\")"))))) (defrecord RecordToTestPrinting [a b]) (deftest defrecord-printing (testing "that the default printer gives the proper representation" (let [r (RecordToTestPrinting. 1 2)] (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}" (pr-str r))) (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting[1, 2]" (binding [*print-dup* true] (pr-str r)))) (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}" (binding [*print-dup* true *verbose-defrecords* true] (pr-str r))))))) (defrecord RecordToTest__ [__a ___b]) (defrecord TypeToTest__ [__a ___b]) (deftest test-record-and-type-field-names (testing "that types and records allow names starting with double-underscore. This is a regression test for CLJ-837." (let [r (RecordToTest__. 1 2) t (TypeToTest__. 3 4)] (are [x y] (= x y) 1 (:__a r) 2 (:___b r) 3 (.__a t) 4 (.___b t))))) (defrecord RecordToTestLongHint [^long a]) (defrecord RecordToTestByteHint [^byte a]) (defrecord RecordToTestBoolHint [^boolean a]) (defrecord RecordToTestCovariantHint [^String a]) ;; same for arrays also (deftype TypeToTestLongHint [^long a]) (deftype TypeToTestByteHint [^byte a]) (deftest hinting-test (testing "that primitive hinting requiring no coercion works as expected" (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint{:a 42})) (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint[42])) (is (= (RecordToTestLongHint. 42) (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a 42}))) (is (= (RecordToTestLongHint. 42) (map->RecordToTestLongHint {:a 42}))) (is (= (RecordToTestLongHint. 42) (->RecordToTestLongHint 42))) (is (= (.a (TypeToTestLongHint. 42)) (.a (->TypeToTestLongHint (long 42))))) (testing "that invalid primitive types on hinted defrecord fields fails" (is (thrown? ClassCastException (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint{:a \"\"}"))) (is (thrown? IllegalArgumentException (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint[\"\"]"))) (is (thrown? IllegalArgumentException (read-string "#clojure.test_clojure.protocols.TypeToTestLongHint[\"\"]"))) (is (thrown? ClassCastException (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a ""}))) (is (thrown? ClassCastException (map->RecordToTestLongHint {:a ""}))) (is (thrown? ClassCastException (->RecordToTestLongHint ""))))) (testing "that primitive hinting requiring coercion works as expected" (is (= (RecordToTestByteHint. 42) (clojure.test_clojure.protocols.RecordToTestByteHint/create {:a (byte 42)}))) (is (= (RecordToTestByteHint. 42) (map->RecordToTestByteHint {:a (byte 42)}))) (is (= (RecordToTestByteHint. 42) (->RecordToTestByteHint (byte 42)))) (is (= (.a (TypeToTestByteHint. 42)) (.a (->TypeToTestByteHint (byte 42)))))) (testing "that primitive hinting for non-numerics works as expected" (is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint{:a true})) (is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint[true])) (is (= (RecordToTestBoolHint. true) (clojure.test_clojure.protocols.RecordToTestBoolHint/create {:a true}))) (is (= (RecordToTestBoolHint. true) (map->RecordToTestBoolHint {:a true}))) (is (= (RecordToTestBoolHint. true) (->RecordToTestBoolHint true)))) (testing "covariant hints -- deferred")) (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 (thrown? Exception (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 (thrown? Exception (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 (thrown? Exception (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"))))))) ; see CLJ-845 (defprotocol SyntaxQuoteTestProtocol (sqtp [p])) (defmacro try-extend-type [c] `(extend-type ~c SyntaxQuoteTestProtocol (sqtp [p#] p#))) (defmacro try-extend-protocol [c] `(extend-protocol SyntaxQuoteTestProtocol ~c (sqtp [p#] p#))) (try-extend-type String) (try-extend-protocol clojure.lang.Keyword) (deftest test-no-ns-capture (is (= "foo" (sqtp "foo"))) (is (= :foo (sqtp :foo)))) (defprotocol Dasherizer (-do-dashed [this])) (deftype Dashed [] Dasherizer (-do-dashed [this] 10)) (deftest test-leading-dashes (is (= 10 (-do-dashed (Dashed.)))) (is (= [10] (map -do-dashed [(Dashed.)])))) Other Java examples (source code examples)Here is a short list of links related to this Java protocols.clj source code file: |
... this post is sponsored by my books ... | |
#1 New Release! |
FP Best Seller |
Copyright 1998-2021 Alvin Alexander, alvinalexander.com
All Rights Reserved.
A percentage of advertising revenue from
pages under the /java/jwarehouse
URI on this website is
paid back to open source projects.