(WIP) QualifiedMethodExpression -- first draft -- does not run yet

Author: dmiller

Clojure/Clojure.Source/clojure/gvec.clj

@@ -87,7 +87,7 @@
       (.chunkedNext this)))
   (more [this]
     (let [s (.next this)]
-      (or s (clojure.lang.PersistentList/EMPTY))))
+      (or s clojure.lang.PersistentList/EMPTY)))
   (^clojure.lang.ISeq cons [this ^Object o]                          ;;; type hint added due to cons overload of ISeq vs IPersistentCollection
     (clojure.lang.Cons. o this))
   (count [this]
@@ -124,7 +124,7 @@
        (new VecSeq am vec (.arrayFor vec nexti) nexti 0 nil))))
   (chunkedMore [this]
     (let [s (.chunkedNext this)]
-      (or s (clojure.lang.PersistentList/EMPTY))))
+      (or s clojure.lang.PersistentList/EMPTY)))
 
   clojure.lang.IMeta
   (meta [_]

Clojure/Clojure.Tests/Clojure.Tests.csproj

@@ -136,6 +136,9 @@
     <None Update="clojure\test_clojure\metadata.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
+    <None Update="clojure\test_clojure\method_thunks.clj">
+      <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
+    </None>
     <None Update="clojure\test_clojure\multimethods.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
@@ -154,6 +157,9 @@
     <None Update="clojure\test_clojure\parallel.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
+    <None Update="clojure\test_clojure\param_tags.clj">
+      <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
+    </None>
     <None Update="clojure\test_clojure\parse.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>

Clojure/Clojure.Tests/clojure/test_clojure/java_interop.clj

@@ -409,7 +409,7 @@
       (to-array [1 2 3]) ))
 
 (defn queue [& contents]
-  (apply conj (clojure.lang.PersistentQueue/EMPTY) contents))
+  (apply conj clojure.lang.PersistentQueue/EMPTY contents))
 
 #_(defn array-typed-equals [expected actual]
   (and (= (class expected) (class actual))

Clojure/Clojure.Tests/clojure/test_clojure/method_thunks.clj

@@ -0,0 +1,62 @@
+;   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.
+; Authors: Fogus
+
+(ns clojure.test-clojure.method-thunks
+  (:use clojure.test)
+  (:require [clojure.java.io :as jio])
+  (:import (clojure.lang Compiler Tuple)
+           (java.util Arrays UUID Locale)
+           (java.io File FileFilter)
+           clojure.lang.IFn$LL))
+
+(set! *warn-on-reflection* true)
+
+(deftest method-arity-selection
+  (is (= '([] [] [])
+         (take 3 (repeatedly ^[] Tuple/create))))
+  (is (= '([1] [2] [3])
+         (map ^[_] Tuple/create [1 2 3])))
+  (is (= '([1 4] [2 5] [3 6])
+         (map ^[_ _] Tuple/create [1 2 3] [4 5 6]))))
+
+(deftest method-signature-selection
+  (is (= [1.23 3.14]
+         (map ^[double] Math/abs [1.23 -3.14])))
+  (is (= [(float 1.23)  (float 3.14)]
+         (map ^[float] Math/abs [1.23 -3.14])))
+  (is (= [1 2 3]
+         (map ^[long] Math/abs [1 2 -3])))
+  (is (= [#uuid "00000000-0000-0001-0000-000000000002"]
+         (map ^[long long] UUID/new [1] [2])))
+  (is (= '("a" "12")
+         (map ^[Object] String/valueOf ["a" 12])))
+  (is (= ["A" "B" "C"]
+         (map ^[java.util.Locale] String/.toUpperCase ["a" "b" "c"] (repeat java.util.Locale/ENGLISH))))
+  (is (thrown? ClassCastException
+               (doall (map ^[long] String/valueOf [12 "a"]))))
+  (testing "bad method names"
+    (is (thrown-with-msg? Exception #"static method" (eval 'java.lang.String/foo)))
+    (is (thrown-with-msg? Exception #"instance method" (eval 'java.lang.String/.foo)))
+    (is (thrown-with-msg? Exception #"constructor" (eval 'Math/new)))))
+
+(def mt ^[_] Tuple/create)
+(def mts {:fromString ^[_] UUID/fromString})
+(def gbs ^[] String/.getBytes)
+
+(deftest method-thunks-in-structs
+  (is (= #uuid "00000000-0000-0001-0000-000000000002"
+         ((:fromString mts) "00000000-0000-0001-0000-000000000002")))
+  (is (= [1] (mt 1)))
+  (is (= 97 (first (seq (gbs "a"))))))
+
+(deftest hinted-method-values
+  (is (thrown? Exception (eval '(.listFiles (jio/file ".") #(File/.isDirectory %)))))
+  (is (seq (.listFiles (jio/file ".") ^FileFilter File/.isDirectory)))
+  (is (seq (File/.listFiles (jio/file ".") ^FileFilter File/.isDirectory)))
+  (is (seq (^[FileFilter] File/.listFiles (jio/file ".") ^FileFilter File/.isDirectory))))

Clojure/Clojure.Tests/clojure/test_clojure/param_tags.clj

@@ -0,0 +1,196 @@
+;   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.
+; Authors: Fogus
+
+(ns clojure.test-clojure.param-tags
+  (:use clojure.test)
+  (:require
+    [clojure.string :as str]
+    [clojure.reflect :as r]
+    [clojure.test-helper :refer [should-not-reflect]])
+  (:import
+    (clojure.test SwissArmy ConcreteClass)
+    (clojure.lang Tuple Compiler Compiler$CompilerException)
+    (java.util Arrays UUID Locale)))
+
+(set! *warn-on-reflection* true)
+
+(deftest no-hints-with-param-tags
+  (should-not-reflect
+   (defn touc-no-reflect [s]
+     (^[] String/.toUpperCase s)))
+  (should-not-reflect
+   (defn touc-no-reflectq [s]
+     (^[] java.lang.String/.toUpperCase s)))
+  (should-not-reflect
+   (defn touc-no-reflect-arg-tags [s]
+     (^[java.util.Locale] String/.toUpperCase s java.util.Locale/ENGLISH)))
+  (should-not-reflect
+   (defn no-overloads-no-reflect [v]
+     (java.time.OffsetDateTime/.getYear v))))
+
+(deftest no-param-tags-use-qualifier
+  ;; both Date and OffsetDateTime have .getYear - want to show here the qualifier is used
+  (let [f (fn [^java.util.Date d] (java.time.OffsetDateTime/.getYear d))
+        date (java.util.Date. 1714495523100)]
+    ;; works when passed OffsetDateTime
+    (is (= 2024 (f (-> date .toInstant (.atOffset java.time.ZoneOffset/UTC)))))
+
+    ;; fails when passed Date, expects OffsetDateTime
+    (is (thrown? ClassCastException
+          (f date)))))
+
+(deftest param-tags-in-invocation-positions
+  (testing "qualified static method invocation"
+    (is (= 3 (^[long] Math/abs -3)))
+    (is (= [1 2] (^[_ _] Tuple/create 1 2)))
+    (is (= "42" (Long/toString 42))))
+  (testing "qualified ctor invocation"
+    (is (= (^[long long] UUID/new 1 2) #uuid "00000000-0000-0001-0000-000000000002"))
+    (is (= (^[long long] java.util.UUID/new 1 2) #uuid "00000000-0000-0001-0000-000000000002"))
+    (is (= "a" (^[String] String/new "a"))))
+  (testing "qualified instance method invocation"
+    (is (= \A (String/.charAt "A" 0)))
+    (is (= "A" (^[java.util.Locale] String/.toUpperCase "a" java.util.Locale/ENGLISH)))
+    (is (= "A" (^[Locale] String/.toUpperCase "a" java.util.Locale/ENGLISH)))
+    (is (= 65 (aget (^[String] String/.getBytes "A" "US-ASCII") 0)))
+    (is (= "42" (^[] Long/.toString 42))))
+  (testing "string repr array type resolutions"
+     (let [lary (long-array [1 2 3 4 99 100])
+           oary (into-array [1 2 3 4 99 100])
+           sary (into-array String ["a" "b" "c"])]
+       (is (= 4 (^[longs long] Arrays/binarySearch lary (long 99))))
+       (is (= 4 (^[objects _] Arrays/binarySearch oary 99)))
+       (is (= 4 (^["[Ljava.lang.Object;" _] Arrays/binarySearch oary 99)))
+       (is (= 1 (^["[Ljava.lang.Object;" _] Arrays/binarySearch sary "b")))))
+  (testing "bad method names"
+    (is (thrown? Exception (eval '(^[] java.lang.String/foo "a"))))
+    (is (thrown? Exception (eval '(^[] java.lang.String/.foo "a"))))
+    (is (thrown? Exception (eval '(^[] Math/new "a"))))))
+
+
+;; Mapping of symbols returned from reflect call to :parameter-type used as arguments to .getDeclaredMethod,
+;; :arg-type used as arguments to the methods and constructors being tested, :arg-tag used as arg-tags
+;; to the methods and constructors being tested.
+(def reflected-parameter-types {'int {:parameter-type Integer/TYPE
+                                      :arg-type "(int 42)"
+                                      :arg-tag "int"}
+                                'boolean {:parameter-type Boolean/TYPE
+                                          :arg-type "true"
+                                          :arg-tag "boolean"}
+                                'long {:parameter-type Long/TYPE
+                                       :arg-type "42"
+                                       :arg-tag "long"}
+                                'long<> {:parameter-type (Class/forName "[J")
+                                         :arg-type "(long-array [1 2])"
+                                         :arg-tag "long*"}
+                                'int<><> {:parameter-type (Class/forName "[[I")
+                                          :arg-type "(make-array Integer/TYPE 1 2)"
+                                          :arg-tag "int**"}
+                                'java.lang.Object<> {:parameter-type (Class/forName "[Ljava.lang.Object;")
+                                                     :arg-type "(into-array [1 2])"
+                                                     :arg-tag "\"[Ljava.lang.Object;\""}
+                                'java.lang.String<> {:parameter-type (Class/forName "[Ljava.lang.String;")
+                                                     :arg-type "(into-array [\"a\" \"b\"])"
+                                                     :arg-tag "\"[Ljava.lang.String;\""}})
+
+(defn is-static-method? [class method-name params]
+  (let [method (.getDeclaredMethod ^Class class ^String (name method-name) ^"[Ljava.lang.Object;" params)]
+    (java.lang.reflect.Modifier/isStatic (.getModifiers method))))
+
+(defn get-methods
+  "Reflect the class located at `path`, filter out the public members, add a :type
+   of :constructor, :static, or :instance to each."
+  [path]
+  (let [reflected-class (r/reflect (resolve path))
+        public (filter #(contains? (:flags %) :public) (:members reflected-class))]
+    (reduce (fn [res m]
+              (let [class (-> m :declaring-class resolve)
+                    params (into-array Class (map #(-> % reflected-parameter-types :parameter-type) (:parameter-types m)))]
+                (cond
+                  (not (contains? m :return-type)) (conj res (assoc m :type :constructor))
+                  (is-static-method? class (:name m) params) (conj res (assoc m :type :static))
+                  :else (conj res (assoc m :type :instance)))))
+            [] public)))
+
+(defn exercise-constructor
+  "Provided a map of data returned from a call to reflect representing a constructor.
+   Construct a new instance of the class providing the appropriate arg-tags and return
+   a map containing the new instance and expected target class"
+  [{:keys [declaring-class parameter-types] :as m}]
+  (let [target-class (-> declaring-class str Class/forName)
+        args (str/join " " (map #(-> % reflected-parameter-types :arg-type) parameter-types))
+        arg-tags (str/join " " (map #(-> % reflected-parameter-types :arg-tag) parameter-types))
+        fun-call-str (read-string (str "(^[" arg-tags "] " declaring-class ". " args ")"))
+        _ (should-not-reflect #(eval 'fun-call-str))
+        new-instance (eval fun-call-str)]
+    {:expected target-class :actual new-instance}))
+
+(defn exercise-static-method
+  "Provided a map of data returned from a call to reflect representing a static class method.
+   Call the static method providing the appropriate arg-tags and return a map containing
+   the actual and expected response."
+  [{:keys [name declaring-class parameter-types]}]
+  (let [class (str declaring-class)
+        method (str name)
+        args (str/join " " (map #(-> % reflected-parameter-types :arg-type) parameter-types))
+        arg-tags (str/join " " (map #(-> % reflected-parameter-types :arg-tag) parameter-types))
+        expected-response (str/join "-" parameter-types)
+        fun-call-str (read-string (str "(^[" arg-tags "] " class "/" method " " args ")"))
+        _ (should-not-reflect #(eval 'fun-call-str))
+        response (eval fun-call-str)]
+    {:expected expected-response :actual response}))
+
+(defn exercise-instance-method
+  "Provided a map of data returned from a call to reflect representing a class instance method.
+   Call the method providing the appropriate arg-tags and return a map containing
+   the actual and expected response."
+  [{:keys [name declaring-class parameter-types]}]
+  (let [method (str "." name)
+        args (str/join " " (map #(-> % reflected-parameter-types :arg-type) parameter-types))
+        arg-tags (str/join " " (map #(-> % reflected-parameter-types :arg-tag) parameter-types))
+        expected-response (str/join "-" parameter-types)
+        fun-call-str (read-string (str "(^[" arg-tags "] " declaring-class "/" method " " "(" declaring-class ".)" " " args ")"))
+        _ (should-not-reflect #(eval 'fun-call-str))
+        response (eval fun-call-str)]
+    {:expected expected-response :actual response}))
+
+(deftest arg-tags-in-constructors-and-static-and-instance-methods
+  (doseq [m (get-methods 'clojure.test.SwissArmy)]
+    (case (:type m)
+      :constructor (let [{:keys [expected actual]} (exercise-constructor m)]
+                     (is (instance? expected actual)))
+      :static (let [{:keys [expected actual]} (exercise-static-method m)]
+                (is (= expected actual)))
+      :instance (let [{:keys [expected actual]} (exercise-instance-method m)]
+                  (is (= expected actual))))))
+
+(defmacro arg-tags-called-in-macro
+  [a-type b-type a b]
+  `(^[~a-type ~b-type] SwissArmy/staticArityOverloadMethod ~a ~b))
+
+(deftest arg-tags-in-macro
+  (is (= "int-int" (arg-tags-called-in-macro int int 1 2))))
+
+(deftest bridge-methods
+  (testing "Allows correct intended usage."
+    (let [concrete (ConcreteClass.)]
+     (is (= 42 (^[Integer] ConcreteClass/.stampWidgets concrete (int 99))))))
+  (testing "Will not call bridge method."
+    (is (thrown? Compiler$CompilerException
+                 (eval '(let [concrete (clojure.test.ConcreteClass.)]
+                          (^[Object] ConcreteClass/.stampWidgets concrete (int 99))))))))
+
+
+(deftest incorrect-arity-invocation-error-messages
+
+  (testing "Invocation with param-tags having incorrect number of args"
+    (let [e (try
+              (eval '(^[long] Math/abs -1 -2 -3))
+              (catch Compiler$CompilerException e (str "-> " (.getMessage (.getCause e)))))]
+      (is (not (nil? (re-find #"expected 1.*received 3" e))) "Error message was expected to indicate 1 argument was expected but 2 were provided"))))

Clojure/Clojure/CljCompiler/Ast/HostExpr.cs

@@ -104,7 +104,7 @@ public Expr Parse(ParserContext pcon, object form)
                         if ((pinfo = Reflector.GetProperty(instanceType, fieldName, false)) != null)
                             return new InstancePropertyExpr(source, spanMap, tag, instance, fieldName, pinfo);
                         if (!isPropName && Reflector.GetArityZeroMethod(instanceType, fieldName, false) != null)
-                            return new InstanceMethodExpr(source, spanMap, tag, instance, fieldName, null, new List<HostArg>(), tailPosition);
+                            return new InstanceMethodExpr(source, spanMap, tag, instance, instanceType, fieldName, null, new List<HostArg>(), tailPosition);
                         if (pcon.IsAssignContext)
                             return new InstanceFieldExpr(source, spanMap, tag, instance, fieldName, null); // same as InstancePropertyExpr when last arg is null
                         else
@@ -153,7 +153,7 @@ public Expr Parse(ParserContext pcon, object form)
 
                 return t != null
                     ? (MethodExpr)(new StaticMethodExpr(source, spanMap, tag, t, methodName, typeArgs, args, tailPosition))
-                    : (MethodExpr)(new InstanceMethodExpr(source, spanMap, tag, instance, methodName, typeArgs, args, tailPosition));
+                    : (MethodExpr)(new InstanceMethodExpr(source, spanMap, tag, instance, t, methodName, typeArgs, args, tailPosition));
             }
         }