More permissive orchard.info parsing of stacktrace output

CHANGELOG.md

@@ -7,6 +7,7 @@
    - `orchard.meta/var-meta-whitelist`
    - `orchard.inspect/set-page-size`, `orchard.inspect/set-max-atom-length`, `orchard.inspect/set-max-value-length`, `orchard.inspect/set-max-coll-size`, `orchard.inspect/set-max-nested-depth`
 * [#318](https://github.com/clojure-emacs/orchard/pull/318): **BREAKING:** Remove no longer used functions: `orchard.misc/lazy-seq?`, `orchard.misc/safe-count`, `orchard.misc/normalize-subclass`, `orchard.misc/remove-type-param`.
+* [#320](https://github.com/clojure-emacs/orchard/pull/320): Info: recognize printed Java classes/methods and munged Clojure functions in stacktrace outputs.
 
 ## 0.30.1 (2025-02-24)
 

src/orchard/info.clj

@@ -63,10 +63,10 @@
      (m/special-sym-meta sym)
      ;; it's a var
      (some-> ns (m/resolve-var sym) (m/var-meta var-meta-allowlist))
-     ;; it's a Java constructor/static member symbol
+     ;; it's a munged printed var or .invoke method of a Clojure function
+     (some-> (m/resolve-munged-printed-var sym) (m/var-meta var-meta-allowlist))
+     ;; it's a Java class/constructor/member symbol
      (some-> ns (java/resolve-symbol sym))
-     ;; it's a Java class/record type symbol
-     (some-> ns (java/resolve-type unqualified-sym))
      ;; it's an alias for another ns
      (some-> ns (m/resolve-aliases) (get sym) (m/ns-meta))
      ;; We use :unqualified-sym *exclusively* here because because our :ns is
@@ -147,11 +147,10 @@
    only applies to `:clj` since for `:cljs` there's no allowlisting)."
   [params]
   (let [params  (normalize-params params)
-        dialect (:dialect params)
-        meta    (cond
-                  (= dialect :clj)  (clj-meta params)
-                  (= dialect :cljs) (cljs-meta params))]
-    meta))
+        dialect (:dialect params)]
+    (cond
+      (= dialect :clj)  (clj-meta params)
+      (= dialect :cljs) (cljs-meta params))))
 
 (defn info
   "Provide the info map for the input ns and sym.

src/orchard/java.clj

@@ -334,20 +334,6 @@
 ;; specific query: type information for a class name, and member information for
 ;; a class/member combination.
 
-(defn type-info
-  "For the class or interface symbol, return Java type info. If the type has
-  defined constructors, the line and column returned will be for the first of
-  these for more convenient `jump` navigation."
-  [class]
-  (let [info (class-info class)
-        ctor (->> (get-in info [:members class])
-                  (vals)
-                  (sort-by :line)
-                  (filter :line)
-                  (first))]
-    (merge (dissoc info :members)
-           (select-keys ctor [:line :column]))))
-
 (defn member-info
   "For the class and member symbols, return Java member info. If the member is
   overloaded, line number and javadoc signature are that of the first overload.
@@ -413,42 +399,63 @@
          (keep #(member-info (-> ^Class % .getName symbol) sym))
          (distinct))))
 
-(defn trim-one-dot
-  [s]
-  (string/replace s #"^\.|\.$" ""))
+(defn resolve-constructor
+  "Given namespace and classname symbols, search the first constructor for the
+  given class and return its info."
+  [ns class-sym]
+  (when-let [info (resolve-class ns class-sym)]
+    (when-let [ctors (->> (get-in info [:members (:class info)])
+                          vals
+                          (sort-by :line)
+                          seq)]
+      (merge (dissoc info :members)
+             (select-keys (some #(when (:line %) %) ctors)
+                          [:line :column])))))
 
 (defn resolve-symbol
-  "Return the info map for a Java member symbol.
-
-  Constructors and static calls are resolved to the class
-  unambiguously. Instance members are resolved unambiguously if defined
-  by only one imported class. If multiple imported classes have a member
-  by that name, a map of class names to member info is returned as
-  `:candidates`."
+  "Return the info map for a Java member symbol. The following Java symbols are
+  supported:
+  - Java classes (`Thread` and `java.lang.Thread`)
+  - Java classes with module prefix (`java.base/java.lang.Thread`)
+  - constructors (`Thread.` and `java.lang.Thread.`)
+  - static members (`Thread/currentThread`)
+  - instance members for classes imported into `ns` (`.start`)
+  - qualified instance members (`Thread/.start`)
+  - Java-style printed member references (`clojure.lang.AFn.run`)
+
+  If multiple imported classes have a non-qualified instance member by that
+  name, a map of class names to member info is returned as `:candidates`."
   [ns sym]
   {:pre [(every? symbol? [ns sym])]}
-  (let [sym (-> sym str trim-one-dot)
-        sym* (symbol sym)
-        [class static-member] (->> (string/split sym #"/" 2)
-                                   (map #(when % (symbol %))))]
-    (if-let [c (resolve-class ns class)]
-      (when static-member
-        (member-info (:class c) static-member))     ; SomeClass/methodCall
-      (when-let [ms (seq (resolve-member ns sym*))] ; methodCall
-        (if (= 1 (count ms))
-          (first ms)
-          {:candidates (zipmap (map :class ms) ms)})))))
-
-(defn resolve-type
-  "Return type info, for a Java class, interface or record."
-  [ns sym]
-  (let [sym (-> sym str trim-one-dot)
-        sym-split (->> (string/split sym #"/" 2)
-                       (map #(when % (symbol %))))]
-    (some->> (first sym-split)
-             (resolve-class ns)
-             :class
-             type-info)))
+  (let [s (str sym)]
+    (or (when-let [[_ klass] (re-matches #"(.+)\." s)]
+          (resolve-constructor ns (symbol klass)))
+
+        (resolve-class ns (symbol s)) ;; When s is a class symbol
+
+        (when-let [[_ instance-member] (re-matches #"\.(.+)" s)]
+          (let [ms (->> (resolve-member ns (symbol instance-member))
+                        (remove #(:static (:modifiers %))))]
+            (condp = (count ms)
+              0 nil
+              1 (first ms)
+              {:candidates (zipmap (map :class ms) ms)})))
+
+        (when-let [[_ klass member] (re-matches #"(.+)/\.?([^/]+)" s)]
+          (when-let [c (resolve-class ns (symbol klass))]
+            (member-info (:class c) (symbol member))))
+
+        ;; Special case: java classes with module prefix.
+        (when-let [[_ klass] (re-matches #"[^/]+/([^/]+)" s)]
+          (resolve-class ns (symbol klass)))
+
+        ;; Special case: java methods that are printed in stacktraces and look
+        ;; like this: clojure.lang.AFn.run or java.base/java.lang.Thread.run
+        (when-let [[_ klass member] (re-matches #"(?:[^/]+/)?(.+)\.([^\.]+)" s)]
+          (when-let [c (resolve-class ns (symbol klass))]
+            (member-info (:class c) (symbol member)))))))
+
+;;;; Online Javadoc
 
 (defn javadoc-base-url
   "Re-implementation of `clojure.java.javadoc/*core-java-api*` because it doesn't

src/orchard/java/parser_next.clj

@@ -405,9 +405,7 @@
                    (mapv #(parse-info % env))
                    ;; Index by name, argtypes. Args for fields are nil.
                    (group-by :name)
-                   (reduce (fn [ret [n ms]]
-                             (assoc ret n (zipmap (mapv :non-generic-argtypes ms) ms)))
-                           {}))})
+                   (misc/update-vals #(zipmap (mapv :non-generic-argtypes %) %)))})
 
   ExecutableElement ;; => method, constructor
   (parse-info* [o env]

src/orchard/meta.clj

@@ -11,7 +11,7 @@
    [orchard.namespace :as ns]
    [orchard.spec :as spec])
   (:import
-   (clojure.lang LineNumberingPushbackReader Namespace Var)))
+   (clojure.lang Compiler LineNumberingPushbackReader Namespace Var)))
 
 ;;; ## Extractors
 
@@ -119,6 +119,26 @@
   (when-let [ns (find-ns ns)]
     (ns-aliases ns)))
 
+(defn resolve-munged-printed-var
+  "Given a printed munged representation of Clojure function, try to resolve it as
+  a var. Supports the following representations:
+  - clojure.core$str
+  - clojure.core$str.invoke
+  - clojure.main$repl$fn__9119.invoke (resolves to named var, not internal lambda)
+  - some.ns$eval1234$closing_over_fn__12345.invoke"
+  [sym]
+  (let [demunged (-> (Compiler/demunge (str sym))
+                     (string/replace #"--\d+" ""))
+        [_ wo-method] (re-matches #"(.+?)(?:\.(?:invoke|invokeStatic|doInvoke))?"
+                                  demunged)
+        [ns-str name-str] (->> (string/split wo-method #"/")
+                               (remove #(re-matches #"eval\d+" %)))
+        ns (some-> ns-str symbol find-ns)
+        resolved (when (and ns name-str)
+                   (ns-resolve ns (symbol name-str)))]
+    (when (var? resolved)
+      resolved)))
+
 ;; Even if things like catch or finally aren't clojure special
 ;; symbols we want to be able to talk about them.
 ;; They just map to a special symbol.

test/orchard/info_test.clj

@@ -191,6 +191,24 @@
                             (select-keys [:ns :name :arglists :doc])
                             (update :ns ns-name))))))))
 
+(let [a 1]
+  (defn- closed-over [] a))
+(closed-over)
+
+(deftest info-munged-printed-var-test
+  (is (= 'str
+         (:name (info/info 'orchard.test-ns 'clojure.core$str))))
+  (is (= 'str
+         (:name (info/info 'orchard.test-ns 'clojure.core$str.invoke))))
+  (is (= 'str
+         (:name (info/info 'orchard.test-ns 'clojure.core$str$fn__12.doInvoke))))
+  (is (= 'str
+         (:name (info/info 'orchard.test-ns (symbol "clojure.core/str/fn--12")))))
+  (is (= 'closed-over
+         (:name (info/info 'orchard.test-ns 'orchard.info_test$eval17939$closed_over__17940.invokeStatic))))
+  (is (= 'closed-over
+         (:name (info/info 'orchard.test-ns (symbol "orchard.info-test/eval17939/closed_over--17940"))))))
+
 (deftest info-unqualified-sym-and-namespace-test
   (testing "Resolution from current namespace"
     (when cljs-available?
@@ -410,13 +428,13 @@
 
       (when cljs-available?
         (testing "- :cljs"
-          (is (= (take 3 (repeat expected))
+          (is (= (repeat 3 expected)
                  (->> params
                       (map #(info/info* (merge @*cljs-params* %)))
                       (map #(select-keys % [:ns :name :arglists :macro :file])))))))
 
       (testing "- :clj"
-        (is (= [{}, expected, {}]
+        (is (= (repeat 3 expected)
                (->> params
                     (map #(info/info* %))
                     (map #(select-keys % [:ns :name :arglists :macro :file])))))))))

test/orchard/java_test.clj

@@ -4,7 +4,7 @@
    [clojure.set :as set]
    [clojure.string :as string]
    [clojure.test :refer [are deftest is testing]]
-   [orchard.java :as sut :refer [cache class-info class-info* javadoc-url member-info resolve-class resolve-javadoc-path resolve-member resolve-symbol resolve-type source-info]]
+   [orchard.java :as sut :refer [cache class-info class-info* javadoc-url member-info resolve-class resolve-javadoc-path resolve-member resolve-symbol source-info]]
    [orchard.misc :as misc]
    [orchard.test.util :as util])
   (:import
@@ -406,16 +406,42 @@
 (deftest symbol-resolution-test
   (let [ns (ns-name *ns*)]
     (testing "Symbol resolution"
+      (testing "of classes"
+        (is (= 'java.lang.String (:class (resolve-symbol ns 'String)))))
+      (testing "of deftype in clojure.core"
+        (is (= 'clojure.core.Eduction (:class (resolve-symbol 'clojure.core 'Eduction)))))
+      (testing "of constructors"
+        (is (= 'java.lang.String (:class (resolve-symbol ns 'String.)))))
       (testing "of unambiguous instance members"
         (is (= 'java.lang.SecurityManager
-               (:class (resolve-symbol ns 'checkPackageDefinition)))))
+               (:class (resolve-symbol ns '.checkPackageDefinition))))
+        (is (nil? (:class (resolve-symbol ns '.currentThread)))
+            "Shouldn't resolve since Thread/currentThread is a static method"))
+      (testing "of qualified instance members"
+        (is (= 'java.lang.Thread
+               (:class (resolve-symbol ns 'Thread/.start)))))
       (testing "of candidate instance members"
         (is (every? #(= 'toString (:member %))
                     (vals (:candidates (resolve-symbol ns 'toString))))))
       (testing "of static methods"
         (is (= 'forName (:member (resolve-symbol ns 'Class/forName)))))
       (testing "of static fields"
         (is (= 'TYPE (:member (resolve-symbol ns 'Void/TYPE)))))
+      (testing "of java-style printed members"
+        (is (= (resolve-symbol ns 'Thread/.start)
+               (resolve-symbol ns 'Thread.start)))
+        (is (= (resolve-symbol ns 'Thread/currentThread)
+               (resolve-symbol ns 'Thread.currentThread)))
+        (is (= (resolve-symbol ns 'clojure.lang.Compiler$DefExpr/.eval)
+               (resolve-symbol ns 'clojure.lang.Compiler$DefExpr.eval)))
+        (is (= 'clojure.lang.Compiler$DefExpr
+               (:class (resolve-symbol ns 'clojure.lang.Compiler$DefExpr.eval)))))
+      (testing "of module-prefixed classes"
+        (is (= (resolve-symbol ns 'java.lang.Thread)
+               (resolve-symbol ns 'java.base/java.lang.Thread))))
+      (testing "of java-style printed members with module prefix"
+        (is (= (resolve-symbol ns 'java.lang.Thread/.run)
+               (resolve-symbol ns 'java.base/java.lang.Thread.run))))
 
       (testing "equality of qualified vs unqualified"
         (testing "classes"
@@ -429,15 +455,22 @@
                  (resolve-symbol ns 'Class/forName))))
         (testing "static fields"
           (is (= (resolve-symbol ns 'java.lang.Void/TYPE)
-                 (resolve-symbol ns 'Void/TYPE)))))
-
-      (testing "equality of dotted"
-        (testing "constructor syntax"
-          (is (= (resolve-symbol ns 'Exception)
-                 (resolve-symbol ns 'Exception.))))
-        (testing "method syntax"
-          (is (= (resolve-symbol ns 'toString)
-                 (resolve-symbol ns '.toString)))))
+                 (resolve-symbol ns 'Void/TYPE))))
+        (testing "qualified members"
+          (is (= (resolve-symbol ns 'Thread/.start)
+                 (resolve-symbol ns 'java.lang.Thread/.start))))
+        (testing "java-style printed members"
+          (is (= (resolve-symbol ns 'Thread.start)
+                 (resolve-symbol ns 'java.lang.Thread.start)))
+          (is (= (resolve-symbol ns 'Thread.currentThread)
+                 (resolve-symbol ns 'java.lang.Thread.currentThread)))))
+
+      (when util/jdk-sources-present?
+        (testing "class and constructor resolve to different lines"
+          (is (not= (:line (resolve-symbol ns 'java.lang.String))
+                    (:line (resolve-symbol ns 'java.lang.String.))))
+          (is (not= (:line (resolve-symbol ns 'Thread))
+                    (:line (resolve-symbol ns 'Thread.))))))
 
       (testing "of things that shouldn't resolve"
         (is (nil? (resolve-symbol ns 'MissingUnqualifiedClass)))
@@ -450,13 +483,6 @@
         (is (nil? (resolve-symbol ns '.missingDottedMethod)))
         (is (nil? (resolve-symbol ns '.random.bunch/of$junk)))))))
 
-(deftest type-resolution-test
-  (testing "Type resolution"
-    (testing "of Java classes/constructors in any namespace"
-      (is (= 'java.lang.String (:class (resolve-type (ns-name *ns*) 'String)))))
-    (testing "of deftype in clojure.core"
-      (is (= 'clojure.core.Eduction (:class (resolve-type 'clojure.core 'Eduction)))))))
-
 (defn- replace-last-dot [^String s]
   (if (re-find #"(.*\.)" s)
     (str (second (re-matches #"(.*)(\..*)" s))