diff --git a/CHANGELOG.md b/CHANGELOG.md index b4bee262..bb71ad3a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ Changelog ======================================== Since tools.analyzer.jvm version are usually cut simultaneously with a tools.analyzer version, check also the tools.analyzer [CHANGELOG](https://github.com/clojure/tools.analyzer/blob/master/CHANGELOG.md) for changes on the corresponding version, since changes in that library will reflect on this one. - - - +* Release 1.4.0 on TODO + * Added support for Clojure 1.12 qualified methods (Class/.method, Class/method, Class/new) + * Added :method-value AST node for method values in value position + * Added :param-tags support for overload disambiguation in method values and host calls * Release 1.3.3 on 5 Jan 2026 * Bumped parent pom and dep versions * Release 1.3.2 on 17 Jan 2025 diff --git a/build.clj b/build.clj new file mode 100644 index 00000000..544a9df1 --- /dev/null +++ b/build.clj @@ -0,0 +1,11 @@ +(ns build + (:require + [clojure.tools.build.api :as b])) + +(def basis + (b/create-basis {:project "deps.edn"})) + +(defn compile-test-java [_] + (b/javac {:src-dirs ["src/test/java"] + :class-dir "target/test-classes" + :basis basis})) diff --git a/deps.edn b/deps.edn index 1c88934f..cae28ed4 100644 --- a/deps.edn +++ b/deps.edn @@ -1,6 +1,8 @@ {:deps {org.clojure/clojure {:mvn/version "1.12.4"} - org.clojure/tools.analyzer {:mvn/version "1.2.1"} + org.clojure/tools.analyzer {:mvn/version "1.2.2"} org.clojure/tools.reader {:mvn/version "1.6.0"} org.clojure/core.memoize {:mvn/version "1.2.273"} org.ow2.asm/asm {:mvn/version "9.9.1"}} - :paths ["src/main/clojure"]} + :paths ["src/main/clojure" "src/test/clojure" "target/test-classes"] + :aliases {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.6"}} + :ns-default build}}} diff --git a/pom.xml b/pom.xml index 6afaf300..18b99c56 100644 --- a/pom.xml +++ b/pom.xml @@ -27,7 +27,7 @@ org.clojure tools.analyzer - 1.2.1 + 1.2.2 org.clojure @@ -46,6 +46,10 @@ + + src/test/java + + scm:git:git://github.com/clojure/tools.analyzer.jvm.git scm:git:git://github.com/clojure/tools.analyzer.jvm.git diff --git a/spec/ast-ref.edn b/spec/ast-ref.edn index f267ab11..b084e221 100644 --- a/spec/ast-ref.edn +++ b/spec/ast-ref.edn @@ -176,7 +176,9 @@ ^:optional [:validated? "`true` if the method call could be resolved at compile time"] ^:optional - [:class "If :validated? the class or interface the method belongs to"]]} + [:class "If :validated? the class or interface the method belongs to"] + ^:optional + [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata on the invocation form"]]} {:op :instance-field :doc "Node for an instance field access" :keys [[:form "`(.-field instance)`"] @@ -266,6 +268,19 @@ [:fixed-arity "The number of args this method takes"] ^:children [:body "Synthetic :do node (with :body? `true`) representing the body of this method"]]} + {:op :method-value + :doc "Node for a qualified method reference in value position (Clojure 1.12+)" + :keys [[:form "The original qualified method symbol, e.g. `String/valueOf`, `File/.getName`, `File/new`"] + [:class "The resolved Class the method belongs to"] + [:method "Symbol naming the method"] + [:kind "One of :static, :instance, or :ctor"] + ^:optional + [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata"] + [:methods "A vector of matching method/constructor reflective info maps"] + ^:optional + [:field-overload "When :kind is :static and a static field of the same name exists, the field info map"] + ^:optional + [:validated? "`true` if the method value could be resolved at compile time"]]} {:op :monitor-enter :doc "Node for a monitor-enter special-form statement" :keys [[:form "`(monitor-enter target)`"] @@ -349,7 +364,9 @@ ^:children [:args "A vector of AST nodes representing the args to the method call"] ^:optional - [:validated? "`true` if the static method could be resolved at compile time"]]} + [:validated? "`true` if the static method could be resolved at compile time"] + ^:optional + [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata on the invocation form"]]} {:op :static-field :doc "Node for a static field access" :keys [[:form "`Class/field`"] diff --git a/src/main/clojure/clojure/tools/analyzer/jvm.clj b/src/main/clojure/clojure/tools/analyzer/jvm.clj index a63eb785..19fce459 100644 --- a/src/main/clojure/clojure/tools/analyzer/jvm.clj +++ b/src/main/clojure/clojure/tools/analyzer/jvm.clj @@ -34,6 +34,7 @@ [box :refer [box]] [constant-lifter :refer [constant-lift]] [classify-invoke :refer [classify-invoke]] + [process-method-value :refer [process-method-value]] [validate :refer [validate]] [infer-tag :refer [infer-tag]] [validate-loop-locals :refer [validate-loop-locals]] @@ -90,8 +91,7 @@ #'clojure.core/when-not #'clojure.core/while #'clojure.core/with-open - #'clojure.core/with-out-str - }) + #'clojure.core/with-out-str}) (def specials "Set of the special forms for clojure in the JVM" @@ -127,13 +127,31 @@ (let [sym-ns (namespace form)] (if-let [target (and sym-ns (not (resolve-ns (symbol sym-ns) env)) - (maybe-class-literal sym-ns))] ;; Class/field - (let [opname (name form)] - (if (and (= (count opname) 1) - (Character/isDigit (char (first opname)))) - form ;; Array/ - (with-meta (list '. target (symbol (str "-" opname))) ;; transform to (. Class -field) - (meta form)))) + (maybe-class-literal sym-ns))] + (let [opname (name form) + opsym (symbol opname)] + (cond + ;; Array/, leave as is + (and (= (count opname) 1) + (Character/isDigit (char (first opname)))) + form + + ;; Class/.method or Class/new, leave as is to be parsed as :maybe-host-form -> :method-value + (or (.startsWith ^String opname ".") + (= "new" opname)) + form + + ;; Class/name where name is a static field, desugar to (. Class -name) as before + ;; But if :param-tags are present and methods with the same name exist, then leave as is to go through + ;; :method-value path + (static-field target opsym) + (if (and (param-tags-of form) + (seq (filter :return-type (static-members target opsym)))) + form + (with-meta (list '. target (symbol (str "-" opname))) + (meta form))) + + :else form)) form))) (defn desugar-host-expr [form env] @@ -143,13 +161,23 @@ opns (namespace op)] (if-let [target (and opns (not (resolve-ns (symbol opns) env)) - (maybe-class-literal opns))] ; (class/field ..) + (maybe-class-literal opns))] - (let [op (symbol opname)] - (with-meta (list '. target (if (zero? (count expr)) - op - (list* op expr))) - (meta form))) + (cond + ;; (Class/new args), (Class/.method target args), (^[pt] Class/method args) + ;; -> leave as-is, will be analyzed as invoke of method-value + (or (= "new" opname) + (.startsWith ^String opname ".") + (param-tags-of op)) + form + + ;; (Class/method args) -> (. Class (method args)) + :else + (let [op-sym (symbol opname)] + (with-meta (list '. target (if (seq expr) + (list* op-sym expr) + op-sym)) + (meta form)))) (cond (.startsWith opname ".") ; (.foo bar ..) @@ -456,6 +484,7 @@ #'box #'analyze-host-expr + #'process-method-value #'validate-loop-locals #'validate #'infer-tag diff --git a/src/main/clojure/clojure/tools/analyzer/jvm/utils.clj b/src/main/clojure/clojure/tools/analyzer/jvm/utils.clj index a159c4e3..d699faa6 100644 --- a/src/main/clojure/clojure/tools/analyzer/jvm/utils.clj +++ b/src/main/clojure/clojure/tools/analyzer/jvm/utils.clj @@ -390,6 +390,44 @@ (conj p next)))) [] methods) methods))) +(defn param-tags-of [sym] + (-> sym meta :param-tags)) + +(defn- tags-to-maybe-classes + [tags] + (mapv (fn [tag] + (when-not (= '_ tag) + (maybe-class tag))) + tags)) + +(defn- signature-matches? + [param-classes method] + (let [method-params (:parameter-types method)] + (and (= (count param-classes) (count method-params)) + (every? (fn [[pc mp]] + (or (nil? pc) ;; nil is a wildcard + (= pc (maybe-class mp)))) + (map vector param-classes method-params))))) + +(defn- most-specific + [methods] + (map (fn [ms] + (reduce (fn [a b] + (if (.isAssignableFrom (maybe-class (:declaring-class a)) + (maybe-class (:declaring-class b))) + b a)) + ms)) + (vals (group-by #(mapv maybe-class (:parameter-types %)) methods)))) + +(defn resolve-hinted-method + "Given a class, method name and param-tags, resolves to the unique matching method. + Returns nil if no match or if ambiguous." + [methods param-tags] + (let [param-classes (tags-to-maybe-classes param-tags) + matching (most-specific (filter #(signature-matches? param-classes %) methods))] + (when (= 1 (count matching)) + (first matching)))) + (defn ns->relpath [s] (-> s str (s/replace \. \/) (s/replace \- \_) (str ".clj"))) diff --git a/src/main/clojure/clojure/tools/analyzer/passes/jvm/analyze_host_expr.clj b/src/main/clojure/clojure/tools/analyzer/passes/jvm/analyze_host_expr.clj index edc566a0..edb19250 100644 --- a/src/main/clojure/clojure/tools/analyzer/passes/jvm/analyze_host_expr.clj +++ b/src/main/clojure/clojure/tools/analyzer/passes/jvm/analyze_host_expr.clj @@ -9,7 +9,8 @@ (ns clojure.tools.analyzer.passes.jvm.analyze-host-expr (:require [clojure.tools.analyzer :as ana] [clojure.tools.analyzer.utils :refer [ctx source-info merge']] - [clojure.tools.analyzer.jvm.utils :refer :all])) + [clojure.tools.analyzer.jvm.utils :refer :all]) + (:import (clojure.lang AFunction))) (defn maybe-static-field [[_ class sym]] (when-let [{:keys [flags type name]} (static-field class sym)] @@ -142,8 +143,9 @@ (defn analyze-host-expr "Performing some reflection, transforms :host-interop/:host-call/:host-field nodes in either: :static-field, :static-call, :instance-call, :instance-field - or :host-interop nodes, and a :var/:maybe-class/:maybe-host-form node in a - :const :class node, if necessary (class literals shadow Vars). + or :host-interop nodes, a :var/:maybe-class/:maybe-host-form node in a + :const :class node if necessary (class literals shadow Vars), and a + :maybe-host-form node in a :method-value node for qualified methods. A :host-interop node represents either an instance-field or a no-arg instance-method. " {:pass-info {:walk :post :depends #{}}} @@ -190,9 +192,47 @@ ast) :maybe-host-form - (if-let [the-class (maybe-array-class-sym (symbol (str (:class ast)) - (str (:field ast))))] - (assoc (ana/analyze-const the-class env :class) :form form) - ast) - + (let [class-sym (:class ast) + field-sym (:field ast) + field-name (name field-sym)] + (if-let [array-class (maybe-array-class-sym (symbol (str class-sym) field-name))] + (assoc (ana/analyze-const array-class env :class) :form form) + (if-let [the-class (maybe-class-literal class-sym)] + (let [param-tags (param-tags-of form) + kind (cond (.startsWith field-name ".") :instance + (= "new" field-name) :ctor + :else :static) + method-name (if (= :instance kind) + (symbol (subs field-name 1)) + field-sym) + methods (case kind + :ctor + (members the-class (symbol (.getName ^Class the-class))) + + :static + (filter :return-type (static-members the-class method-name)) + + :instance + (filter :return-type (instance-members the-class method-name))) + field-info (when (= :static kind) + (static-field the-class method-name))] + ;; field info but no methods shouldn't be possible, as we'd have desugared + ;; to a field syntax directly + (assert (if field-info methods true)) + (if (seq methods) + (merge + {:op :method-value + :form form + :env env + :class the-class + :method method-name + :kind kind + :param-tags param-tags + :methods (vec methods) + :o-tag AFunction + :tag (or tag AFunction)} + (when field-info + {:field-overload field-info})) + ast)) + ast))) ast)) diff --git a/src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj b/src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj index 3bacb9b4..713f12a8 100644 --- a/src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj +++ b/src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj @@ -113,23 +113,38 @@ tests thens)) ~switch-type ~test-type ~skip-check?)) +(defmethod -emit-form :new + [{:keys [class args param-tags]} opts] + (if param-tags + (let [sym (symbol (class->str (:val class)) "new") + sym (vary-meta sym assoc :param-tags param-tags)] + `(~sym ~@(mapv #(-emit-form* % opts) args))) + `(new ~(-emit-form* class opts) ~@(mapv #(-emit-form* % opts) args)))) + (defmethod -emit-form :static-field - [{:keys [class field]} opts] - (symbol (class->str class) (name field))) + [{:keys [class field overloaded-field?]} opts] + (if overloaded-field? + `(. ~(class->sym class) ~(symbol (str "-" (name field)))) + (list (symbol (class->str class) (name field))))) (defmethod -emit-form :static-call - [{:keys [class method args]} opts] - `(~(symbol (class->str class) (name method)) - ~@(mapv #(-emit-form* % opts) args))) + [{:keys [class method args param-tags]} opts] + (let [sym (symbol (class->str class) (name method)) + sym (if param-tags (vary-meta sym assoc :param-tags param-tags) sym)] + `(~sym ~@(mapv #(-emit-form* % opts) args)))) (defmethod -emit-form :instance-field [{:keys [instance field]} opts] `(~(symbol (str ".-" (name field))) ~(-emit-form* instance opts))) (defmethod -emit-form :instance-call - [{:keys [instance method args]} opts] - `(~(symbol (str "." (name method))) ~(-emit-form* instance opts) - ~@(mapv #(-emit-form* % opts) args))) + [{:keys [instance method args class param-tags]} opts] + (if param-tags + (let [sym (symbol (class->str class) (str "." (name method))) + sym (vary-meta sym assoc :param-tags param-tags)] + `(~sym ~(-emit-form* instance opts) ~@(mapv #(-emit-form* % opts) args))) + `(~(symbol (str "." (name method))) ~(-emit-form* instance opts) + ~@(mapv #(-emit-form* % opts) args)))) (defmethod -emit-form :prim-invoke [{:keys [fn args]} opts] @@ -147,6 +162,17 @@ (list (-emit-form* keyword opts) (-emit-form* target opts))) +(defmethod -emit-form :method-value + [{:keys [class method kind param-tags]} opts] + (let [class-name (if (symbol? class) (name class) (.getName ^Class class)) + sym (case kind + :static (symbol class-name (str method)) + :instance (symbol class-name (str "." method)) + :ctor (symbol class-name "new"))] + (if param-tags + (vary-meta sym assoc :param-tags param-tags) + sym))) + (defmethod -emit-form :instance? [{:keys [class target]} opts] `(instance? ~class ~(-emit-form* target opts))) diff --git a/src/main/clojure/clojure/tools/analyzer/passes/jvm/infer_tag.clj b/src/main/clojure/clojure/tools/analyzer/passes/jvm/infer_tag.clj index cb601d41..ef8253c8 100644 --- a/src/main/clojure/clojure/tools/analyzer/passes/jvm/infer_tag.clj +++ b/src/main/clojure/clojure/tools/analyzer/passes/jvm/infer_tag.clj @@ -16,7 +16,8 @@ [annotate-tag :refer [annotate-tag]] [annotate-host-info :refer [annotate-host-info]] [analyze-host-expr :refer [analyze-host-expr]] - [fix-case-test :refer [fix-case-test]]])) + [fix-case-test :refer [fix-case-test]] + [process-method-value :refer [process-method-value]]])) (defmulti -infer-tag :op) (defmethod -infer-tag :default [ast] ast) @@ -269,7 +270,7 @@ Passes opts: * :infer-tag/level If :global, infer-tag will perform Var tag inference" - {:pass-info {:walk :post :depends #{#'annotate-tag #'annotate-host-info #'fix-case-test #'analyze-host-expr} :after #{#'trim}}} + {:pass-info {:walk :post :depends #{#'annotate-tag #'annotate-host-info #'fix-case-test #'analyze-host-expr #'process-method-value} :after #{#'trim}}} [{:keys [tag form] :as ast}] (let [tag (or tag (:tag (meta form))) ast (-infer-tag ast)] diff --git a/src/main/clojure/clojure/tools/analyzer/passes/jvm/process_method_value.clj b/src/main/clojure/clojure/tools/analyzer/passes/jvm/process_method_value.clj new file mode 100644 index 00000000..3ceb8575 --- /dev/null +++ b/src/main/clojure/clojure/tools/analyzer/passes/jvm/process_method_value.clj @@ -0,0 +1,74 @@ +;; Copyright (c) Nicola Mometto, Rich Hickey & contributors. +;; 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 clojure.tools.analyzer.passes.jvm.process-method-value + (:require [clojure.tools.analyzer.utils :refer [source-info]] + [clojure.tools.analyzer.passes.jvm.analyze-host-expr :refer [analyze-host-expr]])) + +(defn process-method-value + "Transforms :invoke nodes whose :fn is a :method-value into the + corresponding :instance-call, :static-call, or :new node. + Also converts value-position :method-value nodes with a + :field-overload (and no :param-tags) into :static-field nodes." + {:pass-info {:walk :post :depends #{#'analyze-host-expr}}} + [{:keys [op args env] :as ast}] + (cond + (and (= :invoke op) + (= :method-value (:op (:fn ast)))) + (let [{:keys [class method kind param-tags methods]} (:fn ast) + instance? (= :instance kind) + call-args (if instance? (vec (rest args)) args) + argc (count call-args) + methods (seq (filter #(= argc (count (:parameter-types %))) methods))] + (when (and instance? (empty? args)) + (throw (ex-info (str "Qualified instance method " (.getName ^Class class) "/." method + " must have a target") + (merge {:class class :method method} + (source-info env))))) + (merge (dissoc ast :fn :args) + (case kind + :instance + {:op :instance-call + :method method + :class class + :instance (first args) + :args call-args + :children [:instance :args]} + + :static + {:op :static-call + :method method + :class class + :args call-args + :children [:args]} + + :ctor + {:op :new + :class {:op :const :type :class :val class + :form class :env env} + :args call-args + :children [:class :args]}) + (when param-tags + {:param-tags param-tags}) + (when methods + {:methods (vec methods)}))) + + (and (= :method-value op) + (:field-overload ast) + (not (:param-tags ast))) + (let [{:keys [flags type name]} (:field-overload ast)] + {:op :static-field + :assignable? (not (:final flags)) + :class (:class ast) + :field name + :form (:form ast) + :env env + :o-tag type + :tag (or (:tag ast) type)}) + + :else ast)) diff --git a/src/main/clojure/clojure/tools/analyzer/passes/jvm/validate.clj b/src/main/clojure/clojure/tools/analyzer/passes/jvm/validate.clj index 0e939a89..6ce35bc0 100644 --- a/src/main/clojure/clojure/tools/analyzer/passes/jvm/validate.clj +++ b/src/main/clojure/clojure/tools/analyzer/passes/jvm/validate.clj @@ -15,7 +15,7 @@ [infer-tag :refer [infer-tag]] [analyze-host-expr :refer [analyze-host-expr]]] [clojure.tools.analyzer.utils :refer [arglist-for-arity source-info resolve-sym resolve-ns merge']] - [clojure.tools.analyzer.jvm.utils :as u :refer [tag-match? try-best-match]]) + [clojure.tools.analyzer.jvm.utils :as u :refer [tag-match? try-best-match resolve-hinted-method]]) (:import (clojure.lang IFn ExceptionInfo))) (defmulti -validate :op) @@ -37,14 +37,60 @@ [{:keys [class field form env] :as ast}] (if-let [handle (-> (env/deref-env) :passes-opts :validate/unresolvable-symbol-handler)] (handle class field ast) - (if (resolve-ns class env) - (throw (ex-info (str "No such var: " class) - (merge {:form form} + (if-let [resolved-class (u/maybe-class-literal class)] + (throw (ex-info (str "Cannot find method or field " field " for class " + (.getName ^Class resolved-class)) + (merge {:class resolved-class + :field field + :form form} (source-info env)))) - (throw (ex-info (str "No such namespace: " class) - (merge {:ns class - :form form} - (source-info env))))))) + (if (resolve-ns class env) + (throw (ex-info (str "No such var: " class) + (merge {:form form} + (source-info env)))) + (throw (ex-info (str "No such namespace: " class) + (merge {:ns class + :form form} + (source-info env)))))))) + +(defn- resolve-method-by-param-tags [methods param-tags ^Class class desc env] + (or (resolve-hinted-method methods param-tags) + (throw (ex-info (str "param-tags " (pr-str param-tags) + " insufficient to resolve " desc + " in class " (.getName class)) + (merge {:class class :param-tags param-tags} + (source-info env)))))) + +(defn- tag-args-from-method [ast m] + (let [arg-tags (mapv u/maybe-class (:parameter-types m))] + (assoc ast + :args (mapv (fn [arg tag] (assoc arg :tag tag)) (:args ast) arg-tags) + :validated? true))) + +(defn- found-method [ast tag instance? m] + (let [ret-tag (:return-type m) + class (u/maybe-class (:declaring-class m))] + (merge' (-> ast (tag-args-from-method m)) + {:method (:name m) + :class class + :o-tag ret-tag + :tag (or tag ret-tag)} + (when instance? + {:instance (assoc (:instance ast) :tag class)})))) + +(defmethod -validate :method-value + [{:keys [class method kind param-tags methods env] :as ast}] + (let [class (u/maybe-class class)] + (if param-tags + (let [m (resolve-method-by-param-tags methods param-tags class + (str (name kind) " method " method) env)] + (assoc ast + :class class + :methods [m] + :validated? true)) + (assoc ast + :class class + :validated? true)))) (defmethod -validate :set! [{:keys [target form env] :as ast}] @@ -56,7 +102,7 @@ ast) (defmethod -validate :new - [{:keys [args] :as ast}] + [{:keys [args param-tags methods] :as ast}] (if (:validated? ast) ast (if-not (= :class (-> ast :class :type)) @@ -64,71 +110,63 @@ (merge {:class (:form (:class ast)) :ast ast} (source-info (:env ast))))) - (let [^Class class (-> ast :class :val) - c-name (symbol (.getName class)) - argc (count args) - tags (mapv :tag args)] - (let [[ctor & rest] (->> (filter #(= (count (:parameter-types %)) argc) - (u/members class c-name)) - (try-best-match tags))] - (if ctor - (if (empty? rest) - (let [arg-tags (mapv u/maybe-class (:parameter-types ctor)) - args (mapv (fn [arg tag] (assoc arg :tag tag)) args arg-tags)] - (assoc ast - :args args - :validated? true)) - ast) - (throw (ex-info (str "no ctor found for ctor of class: " class " and given signature") - (merge {:class class - :args (mapv (fn [a] (prewalk a cleanup)) args)} - (source-info (:env ast))))))))))) + (let [^Class class (-> ast :class :val)] + (if param-tags + (-> ast (tag-args-from-method (resolve-method-by-param-tags methods param-tags class "constructor" (:env ast)))) + (let [c-name (symbol (.getName class)) + argc (count args) + tags (mapv :tag args) + [ctor & rest] (->> (filter #(= (count (:parameter-types %)) argc) + (u/members class c-name)) + (try-best-match tags))] + (if ctor + (if (empty? rest) + (-> ast (tag-args-from-method ctor)) + ast) + (throw (ex-info (str "no ctor found for ctor of class: " class " and given signature") + (merge {:class class + :args (mapv (fn [a] (prewalk a cleanup)) args)} + (source-info (:env ast)))))))))))) -(defn validate-call [{:keys [class instance method args tag env op] :as ast}] +(defn validate-call [{:keys [class instance method args tag env op param-tags methods] :as ast}] (let [argc (count args) instance? (= :instance-call op) - f (if instance? u/instance-methods u/static-methods) tags (mapv :tag args)] - (if-let [matching-methods (seq (f class method argc))] - (let [[m & rest :as matching] (try-best-match tags matching-methods)] - (if m - (let [all-ret-equals? (apply = (mapv :return-type matching))] - (if (or (empty? rest) - (and all-ret-equals? ;; if the method signature is the same just pick the first one - (apply = (mapv #(mapv u/maybe-class (:parameter-types %)) matching)))) - (let [ret-tag (:return-type m) - arg-tags (mapv u/maybe-class (:parameter-types m)) - args (mapv (fn [arg tag] (assoc arg :tag tag)) args arg-tags) - class (u/maybe-class (:declaring-class m))] - (merge' ast - {:method (:name m) - :validated? true - :class class - :o-tag ret-tag - :tag (or tag ret-tag) - :args args} - (if instance? - {:instance (assoc instance :tag class)}))) - (if all-ret-equals? - (let [ret-tag (:return-type m)] - (assoc ast - :o-tag Object - :tag (or tag ret-tag))) - ast))) - (if instance? - (assoc (dissoc ast :class) :tag Object :o-tag Object) - (throw (ex-info (str "No matching method: " method " for class: " class " and given signature") - (merge {:method method - :class class - :args (mapv (fn [a] (prewalk a cleanup)) args)} - (source-info env))))))) - (if instance? - (assoc (dissoc ast :class) :tag Object :o-tag Object) - (throw (ex-info (str "No matching method: " method " for class: " class " and arity: " argc) - (merge {:method method - :class class - :argc argc} - (source-info env)))))))) + (if param-tags + (-> ast + (found-method tag instance? + (resolve-method-by-param-tags methods param-tags class + (str (if instance? "instance" "static") " method " method) + env))) + (if-let [matching-methods (seq ((if instance? u/instance-methods u/static-methods) + class method argc))] + (let [[m & rest :as matching] (try-best-match tags matching-methods)] + (if m + (let [all-ret-equals? (apply = (mapv :return-type matching))] + (if (or (empty? rest) + (and all-ret-equals? ;; if the method signature is the same just pick the first one + (apply = (mapv #(mapv u/maybe-class (:parameter-types %)) matching)))) + (-> ast (found-method tag instance? m)) + (if all-ret-equals? + (let [ret-tag (:return-type m)] + (assoc ast + :o-tag Object + :tag (or tag ret-tag))) + ast))) + (if instance? + (assoc (dissoc ast :class) :tag Object :o-tag Object) + (throw (ex-info (str "No matching method: " method " for class: " class " and given signature") + (merge {:method method + :class class + :args (mapv (fn [a] (prewalk a cleanup)) args)} + (source-info env))))))) + (if instance? + (assoc (dissoc ast :class) :tag Object :o-tag Object) + (throw (ex-info (str "No matching method: " method " for class: " class " and arity: " argc) + (merge {:method method + :class class + :argc argc} + (source-info env))))))))) (defmethod -validate :static-call [ast] @@ -137,10 +175,15 @@ (validate-call (assoc ast :class (u/maybe-class (:class ast)))))) (defmethod -validate :static-field - [ast] - (if (:validated? ast) + [{:keys [class validated? field] :as ast}] + (if validated? ast - (assoc ast :class (u/maybe-class (:class ast))))) + (let [class (u/maybe-class class) + overloaded-field? (boolean (some :return-type (u/static-members class field)))] + (assoc ast + :overloaded-field? overloaded-field? + :class class + :validated? true)))) (defmethod -validate :instance-call [{:keys [class validated? instance] :as ast}] diff --git a/src/test/clojure/clojure/tools/analyzer/jvm/core_test.clj b/src/test/clojure/clojure/tools/analyzer/jvm/core_test.clj index a0b88da5..d735e1c2 100644 --- a/src/test/clojure/clojure/tools/analyzer/jvm/core_test.clj +++ b/src/test/clojure/clojure/tools/analyzer/jvm/core_test.clj @@ -6,7 +6,8 @@ [clojure.tools.analyzer.passes.elide-meta :refer [elides elide-meta]] [clojure.tools.analyzer.ast :refer [postwalk]] [clojure.tools.reader :as r] - [clojure.test :refer [deftest is]])) + [clojure.test :refer [deftest is]]) + (:import (java.io File))) (defprotocol p (f [_])) (defn f1 [^long x]) @@ -96,9 +97,9 @@ (is (.startsWith (name (:name chunk)) "chunk")) (is (= clojure.lang.IChunk (:tag chunk))))) -(def ^:dynamic x) +(def ^:dynamic *test-dynamic*) (deftest set!-dynamic-var - (is (ast1 (set! x 1)))) + (is (ast1 (set! *test-dynamic* 1)))) (deftest analyze-proxy (is (ast1 (proxy [Object] [])))) @@ -115,3 +116,66 @@ (deftest array_class (is (ana (r/read-string "(fn [^{:tag int/2} x] (instance? int/2 x))")))) + +(deftest macroexpander-qualified-methods-test + (is (= (list '. Integer (symbol "-MAX_VALUE")) + (mexpand Integer/MAX_VALUE))) + + (is (= 'String/.length (mexpand String/.length))) + (is (= 'Integer/.intValue (mexpand Integer/.intValue))) + + (is (= 'String/new (mexpand String/new))) + + (is (= 'String/valueOf (mexpand String/valueOf))) + (is (= 'Integer/parseInt (mexpand Integer/parseInt))) + + (is (= '(String/new "hello") (mexpand (String/new "hello")))) + (is (= '(String/.substring "hello" 1 3) (mexpand (String/.substring "hello" 1 3)))) + (is (= '(String/.length "hello") (mexpand (String/.length "hello")))) + (is (= '(Integer/parseInt "2") (mexpand (^{:param-tags [String]} Integer/parseInt "2")))) + + (let [expanded (mexpand (Integer/parseInt "2"))] + (is (= '. (first expanded))) + (is (= java.lang.Integer (second expanded))))) + +(deftest analyzer-qualified-methods-test + (let [a (ast1 File/.getName)] + (is (= :method-value (:op a))) + (is (= :instance (:kind a))) + (is (= 'getName (:method a))) + (is (= java.io.File (:class a)))) + + (let [a (ast1 String/valueOf)] + (is (= :method-value (:op a))) + (is (= :static (:kind a))) + (is (= 'valueOf (:method a))) + (is (= String (:class a)))) + + (let [a (ast1 File/new)] + (is (= :method-value (:op a))) + (is (= :ctor (:kind a))) + (is (= java.io.File (:class a)))) + + (let [a (ast1 Integer/MAX_VALUE)] + (is (= :static-field (:op a))) + (is (= Integer (:class a)))) + + (let [a (ana (r/read-string "String/1"))] + (is (= :const (:op a))) + (is (= :class (:type a))) + (is (.isArray ^Class (:val a)))) + + (let [a (ast1 (File/new "."))] + (is (= :new (:op a)))) + + (let [a (ast1 (String/.length "hello"))] + (is (= :instance-call (:op a))) + (is (= 'length (:method a)))) + + (let [a (ast1 (String/.substring "hello" 1 3))] + (is (= :instance-call (:op a))) + (is (= 'substring (:method a)))) + + (let [a (ast1 (Integer/parseInt "7"))] + (is (= :static-call (:op a))) + (is (= 'parseInt (:method a))))) diff --git a/src/test/clojure/clojure/tools/analyzer/jvm/passes_test.clj b/src/test/clojure/clojure/tools/analyzer/jvm/passes_test.clj index a83d16c1..da195e4f 100644 --- a/src/test/clojure/clojure/tools/analyzer/jvm/passes_test.clj +++ b/src/test/clojure/clojure/tools/analyzer/jvm/passes_test.clj @@ -8,7 +8,8 @@ [clojure.set :as set] [clojure.tools.analyzer.passes.add-binding-atom :refer [add-binding-atom]] [clojure.tools.analyzer.passes.collect-closed-overs :refer [collect-closed-overs]] - [clojure.tools.analyzer.jvm.core-test :refer [ast ast1 e f f1]] + [clojure.tools.reader :as r] + [clojure.tools.analyzer.jvm.core-test :refer [ast ast1 ana e f f1]] [clojure.tools.analyzer.passes.jvm.emit-form :refer [emit-form emit-hygienic-form]] [clojure.tools.analyzer.passes.jvm.validate :as v] @@ -20,9 +21,12 @@ [clojure.tools.analyzer.passes.jvm.fix-case-test :refer [fix-case-test]] [clojure.tools.analyzer.passes.jvm.analyze-host-expr :refer [analyze-host-expr]] [clojure.tools.analyzer.passes.jvm.classify-invoke :refer [classify-invoke]]) - (:import (clojure.lang Keyword Var Symbol AFunction + (:import (clojure.lang Keyword Var Symbol AFunction ExceptionInfo PersistentVector PersistentArrayMap PersistentHashSet ISeq) - java.util.regex.Pattern)) + java.util.regex.Pattern + (java.io File) + (java.util UUID Arrays) + clojure.tools.analyzer.jvm.test.FieldMethodOverload)) (defn validate [ast] (env/with-env (ana.jvm/global-env) @@ -161,3 +165,268 @@ {:passes-opts (merge ana.jvm/default-passes-opts {:validate/wrong-tag-handler (fn [t ast] {t nil})})}))) + +(deftest method-value-emit-form-test + (is (= 'java.io.File/.getName (emit-form (ast1 File/.getName)))) + + (is (= 'java.lang.String/valueOf (emit-form (ast1 String/valueOf)))) + + (is (= 'java.io.File/new (emit-form (ast1 File/new)))) + + (let [emitted (emit-form (ana (r/read-string "^[long] String/valueOf")))] + (is (= 'java.lang.String/valueOf emitted)) + (is (= '[long] (:param-tags (meta emitted))))) + + (let [emitted (emit-form (ana (r/read-string "^[int int] String/.substring")))] + (is (= 'java.lang.String/.substring emitted)) + (is (= '[int int] (:param-tags (meta emitted)))))) + +(deftest method-value-validate-test + (let [a (ast1 File/.getName)] + (is (= :method-value (:op a))) + (is (:validated? a)) + (is (= java.io.File (:class a)))) + + (let [a (ast1 String/valueOf)] + (is (= :method-value (:op a))) + (is (:validated? a)) + (is (pos? (count (:methods a))))) + + (let [a (ast1 File/new)] + (is (= :method-value (:op a))) + (is (:validated? a)) + (is (= :ctor (:kind a)))) + + (let [a (ana (r/read-string "^[long] String/valueOf"))] + (is (= :method-value (:op a))) + (is (:validated? a)) + (is (= 1 (count (:methods a)))) + (is (= '[long] (-> a :methods first :parameter-types)))) + + (let [a (ana (r/read-string "^[int int] String/.substring"))] + (is (= :method-value (:op a))) + (is (:validated? a)) + (is (= 1 (count (:methods a)))) + (is (= '[int int] (-> a :methods first :parameter-types))))) + +(deftest method-value-kinds-test + (let [a (ast1 File/.isDirectory)] + (is (= :instance (:kind a))) + (is (= 'isDirectory (:method a)))) + + (let [a (ast1 Character/isDigit)] + (is (= :method-value (:op a))) + (is (= :static (:kind a))) + (is (= 'isDigit (:method a))) + (is (< 1 (count (:methods a))))) + + (let [a (ast1 String/new)] + (is (= :ctor (:kind a))) + (is (= String (:class a)))) + + (let [a (ast1 File/.getName)] + (is (= AFunction (:o-tag a))))) + +(deftest method-value-field-overload-test + (let [a (ast1 Integer/MAX_VALUE)] + (is (= :static-field (:op a)))) + + (let [a (ast1 Boolean/TRUE)] + (is (= :static-field (:op a))))) + +(deftest qualified-method-invocation-test + (let [a (ast1 (File/new "."))] + (is (= :new (:op a)))) + + (let [a (ast1 (String/.length "hello"))] + (is (= :instance-call (:op a))) + (is (= 'length (:method a))) + (is (:validated? a))) + + (let [a (ast1 (String/.substring "hello" 1 3))] + (is (= :instance-call (:op a))) + (is (= 'substring (:method a))) + (is (= 2 (count (:args a))))) + + (let [a (ast1 (Integer/parseInt "7"))] + (is (= :static-call (:op a))) + (is (= 'parseInt (:method a))) + (is (:validated? a))) + + (let [a (ast1 (File/.isDirectory (File. ".")))] + (is (= :instance-call (:op a))) + (is (= 'isDirectory (:method a))))) + +(deftest param-tags-invocation-test + (let [a (ana (r/read-string "(^[long] String/valueOf 42)"))] + (is (= :static-call (:op a))) + (is (:validated? a)) + (is (= '[long] (:param-tags a)))) + + (let [a (ana (r/read-string "(^[int int] String/.substring \"hello\" 1 3)"))] + (is (= :instance-call (:op a))) + (is (:validated? a)) + (is (= '[int int] (:param-tags a)))) + + (let [a (ana (r/read-string "(^[int _] String/.substring \"hello\" 1 3)"))] + (is (= :instance-call (:op a))) + (is (:validated? a)) + (is (= '[int _] (:param-tags a)))) + + (let [a (ana (r/read-string "^[int/1] java.util.Arrays/sort"))] + (is (= :method-value (:op a))) + (is (= :static (:kind a))) + (is (= 1 (count (:methods a)))))) + +(deftest existing-interop-unchanged-test + (let [a (ast1 (.length "hello"))] + (is (= :instance-call (:op a))) + (is (:validated? a))) + + (let [a (ast1 (String. "foo"))] + (is (= :new (:op a))) + (is (:validated? a))) + + (is (= Void/TYPE (:tag (ast1 (.println System/out "foo"))))) + + (let [a (ast1 (Integer/parseInt "7"))] + (is (= :static-call (:op a))) + (is (:validated? a))) + + (let [a (ast1 Integer/MAX_VALUE)] + (is (= :static-field (:op a)))) + + (let [a (ast1 Boolean/TYPE)] + (is (= :static-field (:op a))))) + +(deftest bad-method-names-test + (is (thrown? ExceptionInfo (ast1 String/foo))) + (is (thrown? ExceptionInfo (ast1 String/.foo))) + (is (thrown? ExceptionInfo (ast1 Math/new)))) + +(deftest param-tags-method-signature-selection-test + (let [a (ana (r/read-string "^[double] Math/abs"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[double] (-> a :methods first :parameter-types))) + (is (:validated? a))) + + (let [a (ana (r/read-string "^[float] Math/abs"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[float] (-> a :methods first :parameter-types))) + (is (:validated? a))) + + (let [a (ana (r/read-string "^[long] Math/abs"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[long] (-> a :methods first :parameter-types))) + (is (:validated? a))) + + (let [a (ana (r/read-string "^[int] Math/abs"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[int] (-> a :methods first :parameter-types))) + (is (:validated? a)))) + +(deftest param-tags-constructor-invocation-test + (let [a (ana (r/read-string "(^[long long] java.util.UUID/new 1 2)"))] + (is (= :new (:op a))) + (is (:validated? a)) + (is (= '[long long] (:param-tags a)))) + + (let [a (ana (r/read-string "(^[String] String/new \"a\")"))] + (is (= :new (:op a))) + (is (:validated? a)) + (is (= '[String] (:param-tags a))))) + +(deftest param-tags-no-arg-invocation-test + (let [a (ana (r/read-string "(^[] String/.toUpperCase \"hello\")"))] + (is (= :instance-call (:op a))) + (is (:validated? a)) + (is (= '[] (:param-tags a)))) + + (let [a (ana (r/read-string "(^[] Long/.toString 42)"))] + (is (= :instance-call (:op a))) + (is (:validated? a)) + (is (= '[] (:param-tags a))))) + +(deftest param-tags-wildcard-test + (let [a (ana (r/read-string "(^[_ _] String/.substring \"hello\" 1 3)"))] + (is (= :instance-call (:op a))) + (is (:validated? a)) + (is (= '[_ _] (:param-tags a))))) + +(deftest param-tags-array-types-test + (let [a (ana (r/read-string "^[long/1 long] java.util.Arrays/binarySearch"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[long<> long] (-> a :methods first :parameter-types))) + (is (:validated? a))) + + (let [a (ana (r/read-string "^[Object/1 _] java.util.Arrays/binarySearch"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[java.lang.Object<> java.lang.Object] (-> a :methods first :parameter-types))) + (is (:validated? a)))) + +(deftest bad-param-tags-test + (is (thrown? ExceptionInfo (ana (r/read-string "^[String String] Math/abs")))) + (is (thrown? ExceptionInfo (ana (r/read-string "(^[] String/foo \"a\")")))) + (is (thrown? ExceptionInfo (ana (r/read-string "(^[] String/.foo \"a\")")))) + (is (thrown? ExceptionInfo (ana (r/read-string "(^[String String String] java.util.UUID/new 1 2 3)"))))) + +(deftest field-method-overload-test + (let [a (ast1 clojure.tools.analyzer.jvm.test.FieldMethodOverload/doppelganger)] + (is (= :static-field (:op a)))) + + (let [a (ana (r/read-string "^[] clojure.tools.analyzer.jvm.test.FieldMethodOverload/doppelganger"))] + (is (= :method-value (:op a))) + (is (= 1 (count (:methods a)))) + (is (= '[] (-> a :methods first :parameter-types)))) + + (let [a (ast1 (clojure.tools.analyzer.jvm.test.FieldMethodOverload/doppelganger))] + (is (= :static-call (:op a))) + (is (:validated? a))) + + (let [a (ast1 (clojure.tools.analyzer.jvm.test.FieldMethodOverload/doppelganger (int 1) (int 2)))] + (is (= :static-call (:op a))) + (is (:validated? a)))) + +(deftest static-field-method-bonanza + (doseq [x '[clojure.tools.analyzer.jvm.test.Foo/bar + (clojure.tools.analyzer.jvm.test.Foo/bar) + ((clojure.tools.analyzer.jvm.test.Foo/bar)) + (. clojure.tools.analyzer.jvm.test.Foo -bar) + ((. clojure.tools.analyzer.jvm.test.Foo -bar)) + (clojure.tools.analyzer.jvm.test.Foo/bar 1) + ((clojure.tools.analyzer.jvm.test.Foo/bar) 1) + (. clojure.tools.analyzer.jvm.test.Foo -bar 1) + ((. clojure.tools.analyzer.jvm.test.Foo -bar) 1) + (((. clojure.tools.analyzer.jvm.test.Foo -bar)) 1) + clojure.tools.analyzer.jvm.test.Foo/baz + (clojure.tools.analyzer.jvm.test.Foo/baz) + ((clojure.tools.analyzer.jvm.test.Foo/baz)) + (. clojure.tools.analyzer.jvm.test.Foo -baz) + ((. clojure.tools.analyzer.jvm.test.Foo -baz)) + (clojure.tools.analyzer.jvm.test.Foo/baz 1) + ((clojure.tools.analyzer.jvm.test.Foo/baz) 1) + (. clojure.tools.analyzer.jvm.test.Foo -baz 1) + ((. clojure.tools.analyzer.jvm.test.Foo -baz) 1) + clojure.tools.analyzer.jvm.test.Foo/qux + (clojure.tools.analyzer.jvm.test.Foo/qux) + ((clojure.tools.analyzer.jvm.test.Foo/qux)) + (. clojure.tools.analyzer.jvm.test.Foo -qux) + ((. clojure.tools.analyzer.jvm.test.Foo -qux)) + (clojure.tools.analyzer.jvm.test.Foo/qux 1) + ((clojure.tools.analyzer.jvm.test.Foo/qux) 1) + (. clojure.tools.analyzer.jvm.test.Foo -qux 1) + ((. clojure.tools.analyzer.jvm.test.Foo -qux) 1)]] + (let [=? (fn [a b] + (if (.contains (str (class a)) "invoke") + (= (a 1) (b 1)) + (= a b)))] + (is (=? (try (eval x) (catch Exception _ ::exception)) + (try (eval (emit-form (ana x))) + (catch Exception _ ::exception))) + (str "bad " x))))) diff --git a/src/test/java/clojure/tools/analyzer/jvm/test/FieldMethodOverload.java b/src/test/java/clojure/tools/analyzer/jvm/test/FieldMethodOverload.java new file mode 100644 index 00000000..c7097b78 --- /dev/null +++ b/src/test/java/clojure/tools/analyzer/jvm/test/FieldMethodOverload.java @@ -0,0 +1,13 @@ +package clojure.tools.analyzer.jvm.test; + +public class FieldMethodOverload { + public static final String doppelganger = "static-field"; + + public static String doppelganger() { + return ""; + } + + public static String doppelganger(int a, int b) { + return "int-int"; + } +} diff --git a/src/test/java/clojure/tools/analyzer/jvm/test/Foo.java b/src/test/java/clojure/tools/analyzer/jvm/test/Foo.java new file mode 100644 index 00000000..f54b4f85 --- /dev/null +++ b/src/test/java/clojure/tools/analyzer/jvm/test/Foo.java @@ -0,0 +1,41 @@ +package clojure.tools.analyzer.jvm.test; + +import clojure.lang.AFn; +import clojure.lang.IFn; + +public class Foo { + + public static final IFn bar = new AFn() { + public Object invoke() { + return "bar"; + } + public Object invoke(Object x) { + return "bar" + x.toString(); + } + }; + + public static final IFn baz = new AFn() { + public Object invoke() { + return "baz"; + } + public Object invoke(Object x) { + return "baz" + x.toString(); + } + }; + + public static String bar() { + return "bar()"; + } + public static String bar(Object x) { + return "bar()" + x.toString(); + } + + + public static String qux() { + return "qux()"; + } + public static String qux(Object x) { + return "qux()" + x.toString(); + } + +}