From 1a5e6c70501533b2620b5cc2111ab4ca96b99479 Mon Sep 17 00:00:00 2001
From: Bronsa <brobronsa@gmail.com>
Date: Thu, 5 Apr 2012 14:03:36 +0200
Subject: [PATCH] Added support for marker protocols

---
 src/clj/clojure/core_deftype.clj                 |   36 +++++++++++----------
 test/clojure/test_clojure/protocols.clj          |    4 ++-
 test/clojure/test_clojure/protocols/examples.clj |    3 ++
 3 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index 0f7ea40..991fd88 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -581,22 +581,23 @@
             string? (recur (assoc opts :doc (first sigs)) (next sigs))
             keyword? (recur (assoc opts (first sigs) (second sigs)) (nnext sigs))
             [opts sigs]))
-        sigs (reduce1 (fn [m s]
-                       (let [name-meta (meta (first s))
-                             mname (with-meta (first s) nil)
-                             [arglists doc]
-                               (loop [as [] rs (rest s)]
-                                 (if (vector? (first rs))
-                                   (recur (conj as (first rs)) (next rs))
-                                   [(seq as) (first rs)]))]
-                         (when (some #{0} (map count arglists))
-                           (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
-                         (assoc m (keyword mname)
-                                (merge name-meta
-                                       {:name (vary-meta mname assoc :doc doc :arglists arglists)
-                                        :arglists arglists
-                                        :doc doc}))))
-                     {} sigs)
+        sigs (when sigs
+               (reduce1 (fn [m s]
+                          (let [name-meta (meta (first s))
+                                mname (with-meta (first s) nil)
+                                [arglists doc]
+                                (loop [as [] rs (rest s)]
+                                  (if (vector? (first rs))
+                                    (recur (conj as (first rs)) (next rs))
+                                    [(seq as) (first rs)]))]
+                            (when (some #{0} (map count arglists))
+                              (throw (IllegalArgumentException. (str "Protocol fn: " mname " must take at least one arg"))))
+                            (assoc m (keyword mname)
+                                   (merge name-meta
+                                          {:name (vary-meta mname assoc :doc doc :arglists arglists)
+                                           :arglists arglists
+                                           :doc doc}))))
+                        {} sigs))
         meths (mapcat (fn [sig]
                         (let [m (munge (:name sig))]
                           (map #(vector m (vec (repeat (dec (count %))'Object)) 'Object) 
@@ -606,7 +607,8 @@
      (defonce ~name {})
      (gen-interface :name ~iname :methods ~meths)
      (alter-meta! (var ~name) assoc :doc ~(:doc opts))
-     (#'assert-same-protocol (var ~name) '~(map :name (vals sigs)))
+     ~(when sigs
+        `(#'assert-same-protocol (var ~name) '~(map :name (vals sigs))))
      (alter-var-root (var ~name) merge 
                      (assoc ~opts 
                        :sigs '~sigs 
diff --git a/test/clojure/test_clojure/protocols.clj b/test/clojure/test_clojure/protocols.clj
index 1e7a199..f23c1a7 100644
--- a/test/clojure/test_clojure/protocols.clj
+++ b/test/clojure/test_clojure/protocols.clj
@@ -76,7 +76,9 @@
     (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))))))))
+          (eval '(old-method (reify Elusive (new-method [x] :new-method)))))))
+  (testing "you can define a marker protocol"
+    (is (= '() (method-names clojure.test_clojure.protocols.examples.MarkerProtocol)))))
 
 (deftype ExtendTestWidget [name])
 (deftype HasProtocolInline []
diff --git a/test/clojure/test_clojure/protocols/examples.clj b/test/clojure/test_clojure/protocols/examples.clj
index b964475..2b72037 100644
--- a/test/clojure/test_clojure/protocols/examples.clj
+++ b/test/clojure/test_clojure/protocols/examples.clj
@@ -8,6 +8,9 @@
   (^String baz [a] [a b] "method with multiple arities")
   (with-quux [a] "method name with a hyphen"))
 
+(defprotocol MarkerProtocol
+  "a protocol with no methods")
+
 (definterface ExampleInterface
   (hinted [^int i])
   (hinted [^String s]))
-- 
1.7.9