Mercurial > lasercutter

     1 ;   Copyright (c) Rich Hickey. All rights reserved.

     2 ;   The use and distribution terms for this software are covered by the

     3 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     4 ;   which can be found in the file epl-v10.html at the root of this distribution.

     5 ;   By using this software in any fashion, you are agreeing to be bound by

     6 ;   the terms of this license.

     7 ;   You must not remove this notice, or any other, from this software.

     8 

     9 ; Author: Stuart Halloway

    10 

    11 (ns clojure.test-clojure.protocols

    12   (:use clojure.test clojure.test-clojure.protocols.examples)

    13   (:require [clojure.test-clojure.protocols.more-examples :as other]

    14             [clojure.set :as set]

    15             clojure.test-clojure.helpers)

    16   (:import [clojure.test_clojure.protocols.examples ExampleInterface]))

    17 

    18 ;; temporary hack until I decide how to cleanly reload protocol

    19 (defn reload-example-protocols

    20   []

    21   (alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol

    22                   assoc :impls {})

    23   (alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol

    24                   assoc :impls {})

    25   (require :reload

    26            'clojure.test-clojure.protocols.examples

    27            'clojure.test-clojure.protocols.more-examples))

    28 

    29 (defn method-names

    30   "return sorted list of method names on a class"

    31   [c]

    32   (->> (.getMethods c)

    33      (map #(.getName %))

    34      (sort)))

    35 

    36 (defrecord EmptyRecord [])

    37 (defrecord TestRecord [a b])

    38 (defn r

    39   ([a b] (TestRecord. a b))

    40   ([a b meta ext] (TestRecord. a b meta ext)))

    41 (defrecord MapEntry [k v]

    42   java.util.Map$Entry

    43   (getKey [_] k)

    44   (getValue [_] v))

    45 

    46 (deftest protocols-test

    47   (testing "protocol fns have useful metadata"

    48     (let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)

    49                        :protocol #'ExampleProtocol}]

    50       (are [m f] (= (merge (quote m) common-meta)

    51                     (meta (var f)))

    52            {:name foo :arglists ([a]) :doc "method with one arg"} foo

    53            {:name bar :arglists ([a b]) :doc "method with two args"} bar

    54            {:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz

    55            {:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux)))

    56   (testing "protocol fns throw IllegalArgumentException if no impl matches"

    57     (is (thrown-with-msg?

    58           IllegalArgumentException

    59           #"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Integer"

    60           (foo 10))))

    61   (testing "protocols generate a corresponding interface using _ instead of - for method names"

    62     (is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))

    63   (testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"

    64     (let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []

    65                 (foo [] "foo!"))]

    66       (is (= "foo!" (.foo obj)) "call through interface")

    67       (is (= "foo!" (foo obj)) "call through protocol")))

    68   (testing "you can implement just part of a protocol if you want"

    69     (let [obj (reify ExampleProtocol

    70                      (baz [a b] "two-arg baz!"))]

    71       (is (= "two-arg baz!" (baz obj nil)))

    72       (is (thrown? AbstractMethodError (baz obj)))))

    73   (testing "you can redefine a protocol with different methods"

    74     (eval '(defprotocol Elusive (old-method [x])))

    75     (eval '(defprotocol Elusive (new-method [x])))

    76     (is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))

    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\.\)"

    78           (eval '(old-method (reify Elusive (new-method [x] :new-method))))))))

    79 

    80 (deftype ExtendTestWidget [name])

    81 (deftype HasProtocolInline []

    82   ExampleProtocol

    83   (foo [this] :inline))

    84 (deftest extend-test

    85   (testing "you can extend a protocol to a class"

    86     (extend String ExampleProtocol

    87             {:foo identity})

    88     (is (= "pow" (foo "pow"))))

    89   (testing "you can have two methods with the same name. Just use namespaces!"

    90     (extend String other/SimpleProtocol

    91      {:foo (fn [s] (.toUpperCase s))})

    92     (is (= "POW" (other/foo "pow"))))

    93   (testing "you can extend deftype types"

    94     (extend

    95      ExtendTestWidget

    96      ExampleProtocol

    97      {:foo (fn [this] (str "widget " (.name this)))})

    98     (is (= "widget z" (foo (ExtendTestWidget. "z"))))))

    99 

   100 (deftest illegal-extending

   101   (testing "you cannot extend a protocol to a type that implements the protocol inline"

   102     (is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"

   103           (eval '(extend clojure.test-clojure.protocols.HasProtocolInline

   104                          clojure.test-clojure.protocols.examples/ExampleProtocol

   105                          {:foo (fn [_] :extended)})))))

   106   (testing "you cannot extend to an interface"

   107     (is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"

   108           (eval '(extend clojure.test-clojure.protocols.HasProtocolInline

   109                          clojure.test_clojure.protocols.examples.ExampleProtocol

   110                          {:foo (fn [_] :extended)}))))))

   111 

   112 (deftype ExtendsTestWidget []

   113   ExampleProtocol)

   114 (deftest extends?-test

   115   (reload-example-protocols)

   116   (testing "returns false if a type does not implement the protocol at all"

   117     (is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))

   118   (testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010

   119     (is (true? (extends? ExampleProtocol ExtendsTestWidget))))

   120   (testing "returns true if a type explicitly extends protocol"

   121     (extend

   122      ExtendsTestWidget

   123      other/SimpleProtocol

   124      {:foo identity})

   125     (is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))

   126 

   127 (deftype ExtendersTestWidget [])

   128 (deftest extenders-test

   129   (reload-example-protocols)

   130   (testing "a fresh protocol has no extenders"

   131     (is (nil? (extenders ExampleProtocol))))

   132   (testing "extending with no methods doesn't count!"

   133     (deftype Something [])

   134     (extend ::Something ExampleProtocol)

   135     (is (nil? (extenders ExampleProtocol))))

   136   (testing "extending a protocol (and including an impl) adds an entry to extenders"

   137     (extend ExtendersTestWidget ExampleProtocol {:foo identity})

   138     (is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))

   139 

   140 (deftype SatisfiesTestWidget []

   141   ExampleProtocol)

   142 (deftest satisifies?-test

   143   (reload-example-protocols)

   144   (let [whatzit (SatisfiesTestWidget.)]

   145     (testing "returns false if a type does not implement the protocol at all"

   146       (is (false? (satisfies? other/SimpleProtocol whatzit))))

   147     (testing "returns true if a type implements the protocol directly"

   148       (is (true? (satisfies? ExampleProtocol whatzit))))

   149     (testing "returns true if a type explicitly extends protocol"

   150       (extend

   151        SatisfiesTestWidget

   152        other/SimpleProtocol

   153        {:foo identity})

   154       (is (true? (satisfies? other/SimpleProtocol whatzit)))))  )

   155 

   156 (deftype ReExtendingTestWidget [])

   157 (deftest re-extending-test

   158   (reload-example-protocols)

   159   (extend

   160    ReExtendingTestWidget

   161    ExampleProtocol

   162    {:foo (fn [_] "first foo")

   163     :baz (fn [_] "first baz")})

   164   (testing "if you re-extend, the old implementation is replaced (not merged!)"

   165     (extend

   166      ReExtendingTestWidget

   167      ExampleProtocol

   168      {:baz (fn [_] "second baz")

   169       :bar (fn [_ _] "second bar")})

   170     (let [whatzit (ReExtendingTestWidget.)]

   171       (is (thrown? IllegalArgumentException (foo whatzit)))

   172       (is (= "second bar" (bar whatzit nil)))

   173       (is (= "second baz" (baz whatzit))))))

   174 

   175 (defrecord DefrecordObjectMethodsWidgetA [a])

   176 (defrecord DefrecordObjectMethodsWidgetB [a])

   177 (deftest defrecord-object-methods-test

   178   (testing "= depends on fields and type"

   179     (is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))

   180     (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))

   181     (is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))

   182 

   183 (deftest defrecord-acts-like-a-map

   184   (let [rec (r 1 2)]

   185     (is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))

   186     (is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))

   187     (is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))

   188 

   189 (deftest degenerate-defrecord-test

   190   (let [empty (EmptyRecord.)]

   191     (is (nil? (seq empty)))

   192     (is (not (.containsValue empty :a)))))

   193 

   194 (deftest defrecord-interfaces-test

   195   (testing "java.util.Map"

   196     (let [rec (r 1 2)]

   197       (is (= 2 (.size rec)))

   198       (is (= 3 (.size (assoc rec :c 3))))

   199       (is (not (.isEmpty rec)))

   200       (is (.isEmpty (EmptyRecord.)))

   201       (is (.containsKey rec :a))

   202       (is (not (.containsKey rec :c)))

   203       (is (.containsValue rec 1))

   204       (is (not (.containsValue rec 3)))

   205       (is (= 1 (.get rec :a)))

   206       (is (thrown? UnsupportedOperationException (.put rec :a 1)))

   207       (is (thrown? UnsupportedOperationException (.remove rec :a)))

   208       (is (thrown? UnsupportedOperationException (.putAll rec {})))

   209       (is (thrown? UnsupportedOperationException (.clear rec)))

   210       (is (= #{:a :b} (.keySet rec)))

   211       (is (= #{1 2} (set (.values rec))))

   212       (is (= #{[:a 1] [:b 2]} (.entrySet rec)))

   213       

   214       ))

   215   (testing "IPersistentCollection"

   216     (testing ".cons"

   217       (let [rec (r 1 2)]

   218         (are [x] (= rec (.cons rec x))

   219              nil {})

   220         (is (= (r 1 3) (.cons rec {:b 3})))

   221         (is (= (r 1 4) (.cons rec [:b 4])))

   222         (is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))

   223 

   224 (defrecord RecordWithSpecificFieldNames [this that k m o])

   225 (deftest defrecord-with-specific-field-names

   226   (let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]

   227     (is (= rec rec))

   228     (is (= 1 (:this (with-meta rec {:foo :bar}))))

   229     (is (= 3 (get rec :k)))

   230     (is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))

   231     (is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))

   232 

   233 (deftest reify-test

   234   (testing "of an interface"

   235     (let [s :foo

   236           r (reify

   237              java.util.List

   238              (contains [_ o] (= s o)))]

   239       (testing "implemented methods"

   240         (is (true? (.contains r :foo)))

   241         (is (false? (.contains r :bar))))

   242       (testing "unimplemented methods"

   243         (is (thrown? AbstractMethodError (.add r :baz))))))

   244   (testing "of two interfaces"

   245     (let [r (reify

   246              java.util.List

   247              (contains [_ o] (= :foo o))

   248              java.util.Collection

   249              (isEmpty [_] false))]

   250       (is (true? (.contains r :foo)))

   251       (is (false? (.contains r :bar)))

   252       (is (false? (.isEmpty r)))))

   253   (testing "you can't define a method twice"

   254     (is (fails-with-cause?

   255          java.lang.ClassFormatError #"^(Repetitive|Duplicate) method name"

   256          (eval '(reify

   257                  java.util.List

   258                  (size [_] 10)

   259                  java.util.Collection

   260                  (size [_] 20))))))

   261   (testing "you can't define a method not on an interface/protocol/j.l.Object"

   262     (is (fails-with-cause? 

   263          IllegalArgumentException #"^Can't define method not in interfaces: foo"

   264          (eval '(reify java.util.List (foo [_]))))))

   265   (testing "of a protocol"

   266     (let [r (reify

   267              ExampleProtocol

   268              (bar [this o] o)

   269              (baz [this] 1)

   270              (baz [this o] 2))]

   271       (= :foo (.bar r :foo))

   272       (= 1 (.baz r))

   273       (= 2 (.baz r nil))))

   274   (testing "destructuring in method def"

   275     (let [r (reify

   276              ExampleProtocol

   277              (bar [this [_ _ item]] item))]

   278       (= :c (.bar r [:a :b :c]))))

   279   (testing "methods can recur"

   280     (let [r (reify

   281              java.util.List

   282              (get [_ index]

   283                   (if (zero? index)

   284                     :done

   285                     (recur (dec index)))))]

   286       (is (= :done (.get r 0)))

   287       (is (= :done (.get r 1)))))

   288   (testing "disambiguating with type hints"

   289     (testing "you must hint an overloaded method"

   290       (is (fails-with-cause?

   291             IllegalArgumentException #"Must hint overloaded method: hinted"

   292             (eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))

   293     (testing "hinting"

   294       (let [r (reify

   295                ExampleInterface

   296                (hinted [_ ^int i] (inc i))

   297                (hinted [_ ^String s] (str s s)))]

   298         (is (= 2 (.hinted r 1)))

   299         (is (= "xoxo" (.hinted r "xo")))))))

   300
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children