Add annotations support to gen-class, plus tests. See #318.

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>

3 files changed, 74 insertions, 8 deletions

diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj
index 35cbf21d..fbc7dfe8 100644
--- a/src/clj/clojure/genclass.clj
+++ b/src/clj/clojure/genclass.clj
@@ -95,6 +95,7 @@
         {:keys [name extends implements constructors methods main factory state init exposes 
                 exposes-methods prefix load-impl-ns impl-ns post-init]} 
           (merge default-options options-map)
+        name-meta (meta name)
         name (str name)
         super (if extends (the-class extends) Object)
         interfaces (map the-class implements)
@@ -157,8 +158,10 @@
                                                                impl-pkg-name "/" prefix (.getName m)
                                                                " not defined?)"))))
         emit-forwarding-method
-        (fn [mname pclasses rclass as-static else-gen]
-          (let [pclasses (map the-class pclasses)
+        (fn [name pclasses rclass as-static else-gen]
+          (let [mname (str name)
+                pmetas (map meta pclasses)
+                pclasses (map the-class pclasses)
                 rclass (the-class rclass)
                 ptypes (to-types pclasses)
                 rtype ^Type (totype rclass)
@@ -169,6 +172,9 @@
                 found-label (. gen (newLabel))
                 else-label (. gen (newLabel))
                 end-label (. gen (newLabel))]
+            (add-annotations gen (meta name))
+            (dotimes [i (count pmetas)]
+              (add-annotations gen (nth pmetas i) i))
             (. gen (visitCode))
             (if (> (count pclasses) 18)
               (else-gen gen m)
@@ -219,6 +225,9 @@
                  cname nil (iname super)
                  (when-let [ifc (seq interfaces)]
                    (into-array (map iname ifc)))))
+
+                                        ; class annotations
+    (add-annotations cv name-meta)
     
                                         ;static fields for vars
     (doseq [v var-fields]
@@ -381,7 +390,7 @@
               mm (mapcat #(.getMethods ^Class %) interfaces))
                                         ;extra methods
        (doseq [[mname pclasses rclass :as msig] methods]
-         (emit-forwarding-method (str mname) pclasses rclass (:static (meta msig))
+         (emit-forwarding-method mname pclasses rclass (:static (meta msig))
                                  emit-unsupported))
                                         ;expose specified overridden superclass methods
        (doseq [[local-mname ^java.lang.reflect.Method m] (reduce (fn [ms [[name _ _] m]]
diff --git a/test/clojure/test_clojure/genclass.clj b/test/clojure/test_clojure/genclass.clj
index e723572f..cab1f595 100644
--- a/test/clojure/test_clojure/genclass.clj
+++ b/test/clojure/test_clojure/genclass.clj
@@ -6,11 +6,16 @@
 ;   the terms of this license.
 ;   You must not remove this notice, or any other, from this software.
 
-; Author: Stuart Halloway
-
-(ns clojure.test-clojure.genclass
+(ns ^{:doc "Tests for clojure.core/gen-class"
+      :author "Stuart Halloway, Daniel Solano Gómez"}
+  clojure.test-clojure.genclass
   (:use clojure.test)
-  (:import clojure.test_clojure.genclass.examples.ExampleClass))
+  (:import [clojure.test_clojure.genclass.examples ExampleClass
+                                                   ExampleAnnotationClass]
+           [java.lang.annotation ElementType
+                                 Retention
+                                 RetentionPolicy
+                                 Target]))
 
 ;; pull this up to a suite-wide helper if you find other tests need it!
 (defn get-field
@@ -36,3 +41,32 @@
            (get-field ExampleClass 'foo_Object_int__var)))
     (is (= #'clojure.test-clojure.genclass.examples/-toString
            (get-field ExampleClass 'toString__var)))))
+
+(deftest test-annotations
+  (let [annot-class ExampleAnnotationClass
+        foo-method          (.getDeclaredMethod annot-class "foo" (into-array [String]))]
+    (testing "Class annotations:"
+      (is (= 2 (count (.getDeclaredAnnotations annot-class))))
+      (testing "@Deprecated"
+        (let [deprecated (.getAnnotation annot-class Deprecated)]
+          (is deprecated)))
+      (testing "@Target([])"
+        (let [resource (.getAnnotation annot-class Target)]
+          (is (= 0 (count (.value resource)))))))
+    (testing "Method annotations:"
+      (testing "@Deprecated void foo(String):"
+        (is (= 1 (count (.getDeclaredAnnotations foo-method))))
+        (is (.getAnnotation foo-method Deprecated))))
+    (testing "Parameter annotations:"
+      (let [param-annots (.getParameterAnnotations foo-method)]
+        (is (= 1 (alength param-annots)))
+        (let [first-param-annots (aget param-annots 0)]
+          (is (= 2 (alength first-param-annots)))
+          (testing "void foo(@Retention(…) String)"
+            (let [retention (aget first-param-annots 0)]
+              (is (instance? Retention retention))
+              (= RetentionPolicy/SOURCE (.value retention))))
+          (testing "void foo(@Target(…) String)"
+            (let [target (aget first-param-annots 1)]
+              (is (instance? Target target))
+              (is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target)))))))))))
diff --git a/test/clojure/test_clojure/genclass/examples.clj b/test/clojure/test_clojure/genclass/examples.clj
index f2ffb29a..1f28a55b 100644
--- a/test/clojure/test_clojure/genclass/examples.clj
+++ b/test/clojure/test_clojure/genclass/examples.clj
@@ -1,4 +1,15 @@
-(ns clojure.test-clojure.genclass.examples)
+;   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.
+
+(ns ^{:doc "Test classes that are AOT-compile for the tests in
+           clojure.test-clojure.genclass."
+      :author "Stuart Halloway, Daniel Solano Gómez"}
+  clojure.test-clojure.genclass.examples)
 
 (definterface ExampleInterface
   (foo [a])
@@ -17,3 +28,15 @@
 (defn -foo-Object-int
   [_ o i]
   "foo with o, i")
+
+(gen-class :name ^{Deprecated {}
+                   SuppressWarnings ["Warning1"] ; discarded
+                   java.lang.annotation.Target []}
+                 clojure.test_clojure.genclass.examples.ExampleAnnotationClass
+           :prefix "annot-"
+           :methods [[^{Deprecated {}
+                        Override {}} ;discarded
+                      foo [^{java.lang.annotation.Retention java.lang.annotation.RetentionPolicy/SOURCE
+                             java.lang.annotation.Target    [java.lang.annotation.ElementType/TYPE
+                                                             java.lang.annotation.ElementType/PARAMETER]}
+                           String] void]])