From 82d5d764dc5c4f35368d83e39143d2a3ac31dfbf Mon Sep 17 00:00:00 2001 From: Andrea Richiardi Date: Wed, 17 Jun 2020 10:33:15 -0700 Subject: [PATCH 1/4] WIP [Fix #86] Avoid clojure.core resolution for non-existing symbols --- test/orchard/info_test.clj | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/test/orchard/info_test.clj b/test/orchard/info_test.clj index 19d5ef32..a94decdc 100644 --- a/test/orchard/info_test.clj +++ b/test/orchard/info_test.clj @@ -23,7 +23,10 @@ (is (nil? (info/info* {:ns 'clojure.core :sym (gensym "non-existing")})))) (testing "Non existing symbol in user - issue #86" - (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")}))))) + (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")})))) + + (testing "Non existing symbol with namespace - issue #86" + (is (nil? (info/info* {:ns 'user :sym 'non-existing-ns/get}))))) (deftest info-deftype-test (testing "deftype" From 22533cda06b82fee4c048d8071cfb72616db841a Mon Sep 17 00:00:00 2001 From: Andrea Richiardi Date: Fri, 19 Jun 2020 18:40:43 -0700 Subject: [PATCH 2/4] WIP - [Fix #86] Retrieve java classes with resolve --- project.clj | 3 +- src/orchard/info.clj | 22 +- src/orchard/java.clj | 48 ++-- src/orchard/java/legacy_parser.clj | 368 ++++++++++++++--------------- src/orchard/meta.clj | 9 +- src/orchard/misc.clj | 10 + test/orchard/info_test.clj | 44 ++-- test/orchard/java_test.clj | 14 +- 8 files changed, 270 insertions(+), 248 deletions(-) diff --git a/project.clj b/project.clj index c001c839..b08343c8 100644 --- a/project.clj +++ b/project.clj @@ -40,7 +40,8 @@ :test {:resource-paths ["test-resources"]} ;; Development tools - :dev {:dependencies [[pjstadig/humane-test-output "0.10.0"]] + :dev {:dependencies [[pjstadig/humane-test-output "0.10.0"] + [org.clojure/tools.trace "0.7.10"]] :resource-paths ["test-resources"] :plugins [[com.jakemccrary/lein-test-refresh "0.23.0"]] :injections [(require 'pjstadig.humane-test-output) diff --git a/src/orchard/info.clj b/src/orchard/info.clj index b0980a8f..11de79d0 100644 --- a/src/orchard/info.clj +++ b/src/orchard/info.clj @@ -21,15 +21,6 @@ [ns sym] (when sym (symbol (some-> ns str) (str sym)))) -(defn qualified-symbol? - "Return true if `x` is a symbol with a namespace - - This is only available from Clojure 1.9 so we backport it until we - drop support for Clojure 1.8." - {:added "0.5"} - [x] - (boolean (and (symbol? x) (namespace x) true))) - (defn normalize-params "Normalize the info params. @@ -47,26 +38,29 @@ ;; If :sym is qualified, we have to use (name), cause: ;; (namespace 'mount.core) ;;=> nil ;; (name 'mount.core) ;;=> "mount.core - (qualified-symbol? sym) + (misc/qualified-symbol? sym) (assoc :qualified-sym sym :unqualified-sym (misc/name-sym sym) :computed-ns (misc/namespace-sym sym)) - (and sym (not (qualified-symbol? sym))) + (and sym (not (misc/qualified-symbol? sym))) (assoc :unqualified-sym (-> sym name symbol)) ;; if :sym is missing we still assoc :unqualified-sym from :ns (and (not sym) ns) (assoc :unqualified-sym ns) - (and sym (not (qualified-symbol? sym)) (or ns context-ns)) + (and sym (not (misc/qualified-symbol? sym)) (or ns context-ns)) (assoc :qualified-sym (qualify-sym (or ns context-ns) sym))))) (defn clj-meta {:added "0.5"} - [{:keys [dialect ns sym computed-ns unqualified-sym]}] + [{:keys [dialect ns sym computed-ns unqualified-sym] :as params}] {:pre [(= dialect :clj)]} (let [ns (or ns computed-ns)] + (println "###") + (println params) + (println "###") (or ;; it's a special (special-symbol?) (m/special-sym-meta sym) @@ -75,7 +69,7 @@ ;; it's a Java constructor/static member symbol (some-> ns (java/resolve-symbol sym)) ;; it's an unqualified sym maybe referred - (some-> ns (m/resolve-var unqualified-sym) (m/var-meta)) + ;; (some-> ns (m/resolve-var unqualified-sym) (m/var-meta)) ;; it's a Java class/record type symbol (some-> ns (java/resolve-type unqualified-sym)) ;; it's an alias for another ns diff --git a/src/orchard/java.clj b/src/orchard/java.clj index a3d9ca2c..b5de7bd8 100644 --- a/src/orchard/java.clj +++ b/src/orchard/java.clj @@ -1,6 +1,7 @@ (ns orchard.java "Info for Java classes and members" {:author "Jeff Valk"} + (:refer-clojure :exclude [qualified-symbol?]) (:require [clojure.java.io :as io] [clojure.java.javadoc :as javadoc] @@ -8,7 +9,8 @@ [clojure.string :as str] [orchard.java.classpath :as cp] [orchard.misc :as misc] - [orchard.java.resource :as resource]) + [orchard.java.resource :as resource] + [clojure.tools.trace :as trace]) (:import (clojure.lang IPersistentMap) (clojure.reflect Constructor Field JavaReflector Method) @@ -112,7 +114,7 @@ (do (require '[orchard.java.parser :as src]) (resolve 'src/source-info)) (if jdk-tools - (do (require '[orchard.java.legacy-parser :as src]) + (do #_(require '[orchard.java.legacy-parser :as src]) (resolve 'src/source-info)) (constantly nil)))) @@ -265,7 +267,7 @@ (merge (dissoc info :members) (select-keys ctor [:line :column])))) -(defn member-info +(trace/deftrace 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. If the member's definition is in a superclass, info returned will be for the @@ -301,7 +303,7 @@ ;; by considering arity, and narrowed further *if* we could consider argument ;; types...) -(defn resolve-class +(defn resolve-imported-class "Given namespace and class symbols, search the imported classes and return class info. If not found, search all classes on the classpath (requires a qualified name)." @@ -313,7 +315,14 @@ (class-info (-> ^Class c .getName symbol)) (class-info sym))))) -(defn resolve-member +(defn resolve-qualified-class + "Try to resolve symbol within Clojure default classes and return info." + [qualified-sym] + (when-let [c (resolve qualified-sym)] + (when (class? c) + (class-info (-> ^Class c .getName symbol))))) + +(trace/deftrace resolve-member "Given namespace and member symbols, search the imported classes and return a list of each matching member's info." [ns sym] @@ -323,11 +332,18 @@ (filter identity) (distinct)))) -(defn trim-one-dot +(defn- trim-one-dot [s] (str/replace s #"^\.|\.$" "")) -(defn resolve-symbol +(defn- split-out-class-and-member + "Split (qualified) sym and return a tuple of symbols [class member]." + [qualified-sym] + {:pre [misc/qualified-symbol? qualified-sym]} + (->> (str/split qualified-sym #"/" 2) + (map #(when % (symbol %))))) + +(trace/deftrace resolve-symbol "Return the info map for a Java member symbol. Constructors and static calls are resolved to the class @@ -336,12 +352,11 @@ by that name, a map of class names to member info is returned as `:candidates`." [ns sym] - {:pre [(every? symbol? [ns sym])]} + {:pre [(every? symbol? [ns sym]) (misc/qualified-symbol? sym)]} (let [sym (-> sym str trim-one-dot) sym* (symbol sym) - [class static-member] (->> (str/split sym #"/" 2) - (map #(when % (symbol %))))] - (if-let [c (resolve-class ns class)] + [class static-member] (split-out-class-and-member sym)] + (if-let [c (resolve-imported-class ns class)] (when static-member (member-info (:class c) static-member)) ; SomeClass/methodCall (when-let [ms (seq (resolve-member ns sym*))] ; methodCall @@ -349,14 +364,13 @@ (first ms) {:candidates (zipmap (map :class ms) ms)}))))) -(defn resolve-type +(trace/deftrace resolve-type "Return type info, for a Java class, interface or record." [ns sym] - (let [sym (-> sym str trim-one-dot) - sym-split (->> (str/split sym #"/" 2) - (map #(when % (symbol %))))] - (some->> (first sym-split) - (resolve-class ns) + {:pre [(every? symbol? [ns sym]) (not (misc/qualified-symbol? sym))]} + (let [sym (-> sym str trim-one-dot)] + (some->> (first class) + (resolve-imported-class ns) :class type-info))) diff --git a/src/orchard/java/legacy_parser.clj b/src/orchard/java/legacy_parser.clj index 7b2d3f32..61c032d7 100644 --- a/src/orchard/java/legacy_parser.clj +++ b/src/orchard/java/legacy_parser.clj @@ -1,22 +1,22 @@ -(ns orchard.java.legacy-parser - "Source and docstring info for Java classes and members" - {:author "Jeff Valk"} - (:require - [clojure.java.io :as io] - [clojure.string :as str]) - (:import - (com.sun.javadoc ClassDoc ConstructorDoc Doc FieldDoc MethodDoc - Parameter Tag Type) - (com.sun.source.tree ClassTree) - (com.sun.tools.javac.util Abort Context List Options) - (com.sun.tools.javadoc DocEnv JavadocEnter JavadocTool Messager - ModifierFilter RootDocImpl) - (java.io StringReader) - (java.net URI) - (java.util Locale) - (javax.swing.text.html HTML$Tag HTMLEditorKit$ParserCallback) - (javax.swing.text.html.parser ParserDelegator) - (javax.tools JavaFileObject$Kind SimpleJavaFileObject))) +#_(ns orchard.java.legacy-parser + "Source and docstring info for Java classes and members" + {:author "Jeff Valk"} + (:require + [clojure.java.io :as io] + [clojure.string :as str]) + (:import + (com.sun.javadoc ClassDoc ConstructorDoc Doc FieldDoc MethodDoc + Parameter Tag Type) + (com.sun.source.tree ClassTree) + (com.sun.tools.javac.util Abort Context List Options) + (com.sun.tools.javadoc DocEnv JavadocEnter JavadocTool Messager + ModifierFilter RootDocImpl) + (java.io StringReader) + (java.net URI) + (java.util Locale) + (javax.swing.text.html HTML$Tag HTMLEditorKit$ParserCallback) + (javax.swing.text.html.parser ParserDelegator) + (javax.tools JavaFileObject$Kind SimpleJavaFileObject))) ;;; ## JDK Compatibility ;; This namespace is compatible with JDK8 and below. It requires that @@ -56,34 +56,34 @@ ;; [1]: http://hg.openjdk.java.net/jdk8/tl/langtools/rev/b0909f992710 ;; [2]: http://stackoverflow.com/questions/4065401/using-internal-sun-classes-with-javac -(defn set-field! - [obj field val] - (let [f (.getDeclaredField (class obj) field)] - (.setAccessible f true) - (.set f obj val))) +#_(defn set-field! + [obj field val] + (let [f (.getDeclaredField (class obj) field)] + (.setAccessible f true) + (.set f obj val))) -(defn parse-java - "Load and parse the resource path, returning a `RootDoc` object." - [path] - (when-let [res (io/resource path)] - (let [access (ModifierFilter. ModifierFilter/ALL_ACCESS) - context (doto (Context.) (Messager/preRegister "orchard-javadoc")) - options (doto (Options/instance context) (.put "ignore.symbol.file" "y")) - compiler (JavadocTool/make0 context) - enter (JavadocEnter/instance0 context) - docenv (doto (DocEnv/instance context) - (.setEncoding "utf-8") - (.setSilent true) - (set-field! "showAccess" access)) - source (proxy [SimpleJavaFileObject] [(URI. path) JavaFileObject$Kind/SOURCE] - (getCharContent [_] (slurp res))) - tree (.parse compiler source) - classes (->> (.defs tree) - (filter #(= (-> % .getKind .asInterface) ClassTree)) - (into-array) - (List/from))] - (.main enter (List/of tree)) - (RootDocImpl. docenv classes (List/nil) (List/nil))))) +#_(defn parse-java + "Load and parse the resource path, returning a `RootDoc` object." + [path] + (when-let [res (io/resource path)] + (let [access (ModifierFilter. ModifierFilter/ALL_ACCESS) + context (doto (Context.) (Messager/preRegister "orchard-javadoc")) + options (doto (Options/instance context) (.put "ignore.symbol.file" "y")) + compiler (JavadocTool/make0 context) + enter (JavadocEnter/instance0 context) + docenv (doto (DocEnv/instance context) + (.setEncoding "utf-8") + (.setSilent true) + (set-field! "showAccess" access)) + source (proxy [SimpleJavaFileObject] [(URI. path) JavaFileObject$Kind/SOURCE] + (getCharContent [_] (slurp res))) + tree (.parse compiler source) + classes (->> (.defs tree) + (filter #(= (-> % .getKind .asInterface) ClassTree)) + (into-array) + (List/from))] + (.main enter (List/of tree)) + (RootDocImpl. docenv classes (List/nil) (List/nil))))) ;;; ## Docstring Parsing ;; Unlike source metadata (line, position, etc) that's available directly from @@ -94,39 +94,39 @@ ;; This way it can either be rendered or displayed as text. ;; Use GFM extensions for multiline code blocks and tables. -(def markdown - "Syntax map from html tag to a tuple of tag type key, start, and end chars" - (let [char-map {:p ["\n\n"] :code ["`" "`"] - :br ["\n"] :code* ["\n\n```\n" "```\n\n"] - :em ["*" "*"] :table ["\n|--" "\n|--"] - :str ["**" "**"] :thead ["" "|--\n"] - :list ["\n"] :tr ["\n" "|"] - :li ["- "] :td ["|"] - :dd [": "] :th ["|"]} - tags {HTML$Tag/P :p HTML$Tag/TT :code - HTML$Tag/BR :br HTML$Tag/CODE :code - HTML$Tag/I :em HTML$Tag/VAR :code - HTML$Tag/EM :em HTML$Tag/KBD :code - HTML$Tag/B :str HTML$Tag/PRE :code* - HTML$Tag/STRONG :str HTML$Tag/BLOCKQUOTE :code* - HTML$Tag/UL :list HTML$Tag/TABLE :table - HTML$Tag/OL :list HTML$Tag/TR :tr - HTML$Tag/DL :list HTML$Tag/TD :td - HTML$Tag/LI :li HTML$Tag/TH :th - HTML$Tag/DT :li - HTML$Tag/DD :dd}] - (-> (reduce (fn [tags [tag k]] - (assoc tags tag (cons k (char-map k)))) - {} tags) - (with-meta char-map)))) +#_(def markdown + "Syntax map from html tag to a tuple of tag type key, start, and end chars" + (let [char-map {:p ["\n\n"] :code ["`" "`"] + :br ["\n"] :code* ["\n\n```\n" "```\n\n"] + :em ["*" "*"] :table ["\n|--" "\n|--"] + :str ["**" "**"] :thead ["" "|--\n"] + :list ["\n"] :tr ["\n" "|"] + :li ["- "] :td ["|"] + :dd [": "] :th ["|"]} + tags {HTML$Tag/P :p HTML$Tag/TT :code + HTML$Tag/BR :br HTML$Tag/CODE :code + HTML$Tag/I :em HTML$Tag/VAR :code + HTML$Tag/EM :em HTML$Tag/KBD :code + HTML$Tag/B :str HTML$Tag/PRE :code* + HTML$Tag/STRONG :str HTML$Tag/BLOCKQUOTE :code* + HTML$Tag/UL :list HTML$Tag/TABLE :table + HTML$Tag/OL :list HTML$Tag/TR :tr + HTML$Tag/DL :list HTML$Tag/TD :td + HTML$Tag/LI :li HTML$Tag/TH :th + HTML$Tag/DT :li + HTML$Tag/DD :dd}] + (-> (reduce (fn [tags [tag k]] + (assoc tags tag (cons k (char-map k)))) + {} tags) + (with-meta char-map)))) ;; The HTML parser and DTD classes are in the `javax.swing` package, and have ;; internal references to the `sun.awt.AppContext` class. On Mac OS X, any use ;; of this class causes a stray GUI window to pop up. Setting the system ;; property below prevents this. We only set the property if it ;; hasn't already been explicitly set. -(when (nil? (System/getProperty "apple.awt.UIElement")) - (System/setProperty "apple.awt.UIElement" "true")) +#_(when (nil? (System/getProperty "apple.awt.UIElement")) + (System/setProperty "apple.awt.UIElement" "true")) ;; We parse html and emit text in a single pass -- there's no need to build a ;; tree. The syntax map defines most of the output format, but a few stateful @@ -137,61 +137,61 @@ ;; of `
` is common, for instance). ;; 3. A border row is inserted between `` and `` table rows. Since ;; `` and `` are optional, we look for the th/td transition. -(defn parse-html - "Parse html to markdown text." - [html] - (let [sb (StringBuilder.) - sr (StringReader. html) - parser (ParserDelegator.) - stack (atom nil) - flags (atom #{}) - handler (proxy [HTMLEditorKit$ParserCallback] [] - (handleText [^chars chars _] - (.append sb (String. chars))) +#_(defn parse-html + "Parse html to markdown text." + [html] + (let [sb (StringBuilder.) + sr (StringReader. html) + parser (ParserDelegator.) + stack (atom nil) + flags (atom #{}) + handler (proxy [HTMLEditorKit$ParserCallback] [] + (handleText [^chars chars _] + (.append sb (String. chars))) - (handleStartTag [tag _ _] - (let [[k start] (markdown tag)] - (when (and k (not= k (peek @stack))) - (swap! stack conj k) + (handleStartTag [tag _ _] + (let [[k start] (markdown tag)] + (when (and k (not= k (peek @stack))) + (swap! stack conj k) - ;; Indent list items at the current depth. - (when (#{:li} k) - (let [depth (count (filter #{:list} @stack))] - (.append sb "\n") - (dotimes [_ (dec depth)] - (.append sb " ")))) + ;; Indent list items at the current depth. + (when (#{:li} k) + (let [depth (count (filter #{:list} @stack))] + (.append sb "\n") + (dotimes [_ (dec depth)] + (.append sb " ")))) - ;; Keep th/td state; emit border between th and td rows. - (when (#{:th} k) (swap! flags conj :th)) - (when (and (#{:td} k) (@flags :th)) - (.append sb (-> markdown meta :thead last))) + ;; Keep th/td state; emit border between th and td rows. + (when (#{:th} k) (swap! flags conj :th)) + (when (and (#{:td} k) (@flags :th)) + (.append sb (-> markdown meta :thead last))) - (when start (.append sb start))))) + (when start (.append sb start))))) - (handleEndTag [tag _] - (let [[k _ end] (markdown tag)] - (when (and k (= k (peek @stack))) - (swap! stack pop) - (when (#{:table :td} k) (swap! flags disj :th)) - (when end (.append sb end))))))] + (handleEndTag [tag _] + (let [[k _ end] (markdown tag)] + (when (and k (= k (peek @stack))) + (swap! stack pop) + (when (#{:table :td} k) (swap! flags disj :th)) + (when end (.append sb end))))))] - (.parse parser sr handler false) - (-> (str sb) - (str/replace #"\n{3,}" "\n\n") ; normalize whitespace - (str/replace #" +```" "```")))) + (.parse parser sr handler false) + (-> (str sb) + (str/replace #"\n{3,}" "\n\n") ; normalize whitespace + (str/replace #" +```" "```")))) ;; Note that @link and @linkplain are also of 'kind' @see. -(defn docstring - "Given a Java parse tree `Doc` instance, return its parsed docstring text." - [^Doc doc] - (->> (.inlineTags doc) - (map (fn [^Tag t] - (case (.kind t) - "@see" (format " `%s` " (.text t)) ; TODO use .referencedClassName ...? - "@code" (format " `%s` " (-> t .inlineTags ^Tag first .text)) - "@literal" (format " `%s` " (-> t .inlineTags ^Tag first .text)) - (parse-html (.text t))))) - (apply str))) +#_(defn docstring + "Given a Java parse tree `Doc` instance, return its parsed docstring text." + [^Doc doc] + (->> (.inlineTags doc) + (map (fn [^Tag t] + (case (.kind t) + "@see" (format " `%s` " (.text t)) ; TODO use .referencedClassName ...? + "@code" (format " `%s` " (-> t .inlineTags ^Tag first .text)) + "@literal" (format " `%s` " (-> t .inlineTags ^Tag first .text)) + (parse-html (.text t))))) + (apply str))) ;;; ## Java Parse Tree Traversal ;; @@ -199,78 +199,78 @@ ;; as produced by `orchard.java/reflect-info`: class members ;; are indexed first by name, then argument types. -(defn typesym - "Using parse tree info, return the type's name equivalently to the `typesym` +#_(defn typesym + "Using parse tree info, return the type's name equivalently to the `typesym` function in `orchard.java`." - [^Type t] - (symbol - (str (when-let [c (.asClassDoc t)] ; when not a primitive - (str (-> c .containingPackage .name) ".")) - (-> t .typeName (str/replace "." "$")) - (.dimension t)))) + [^Type t] + (symbol + (str (when-let [c (.asClassDoc t)] ; when not a primitive + (str (-> c .containingPackage .name) ".")) + (-> t .typeName (str/replace "." "$")) + (.dimension t)))) -(defprotocol Parsed - (parse-info [o])) +#_(defprotocol Parsed + (parse-info [o])) -(extend-protocol Parsed - ConstructorDoc - (parse-info [c] - {:name (-> c .qualifiedName symbol) - :argtypes (mapv #(-> ^Parameter % .type typesym) (.parameters c)) - :argnames (mapv #(-> ^Parameter % .name symbol) (.parameters c))}) +#_(extend-protocol Parsed + ConstructorDoc + (parse-info [c] + {:name (-> c .qualifiedName symbol) + :argtypes (mapv #(-> ^Parameter % .type typesym) (.parameters c)) + :argnames (mapv #(-> ^Parameter % .name symbol) (.parameters c))}) - MethodDoc - (parse-info [m] - {:argtypes (mapv #(-> ^Parameter % .type typesym) (.parameters m)) - :argnames (mapv #(-> ^Parameter % .name symbol) (.parameters m)) - :type (str (.returnType m))}) + MethodDoc + (parse-info [m] + {:argtypes (mapv #(-> ^Parameter % .type typesym) (.parameters m)) + :argnames (mapv #(-> ^Parameter % .name symbol) (.parameters m)) + :type (str (.returnType m))}) - FieldDoc - (parse-info [f] - {:type (str (.type f))}) + FieldDoc + (parse-info [f] + {:type (str (.type f))}) - ClassDoc - (parse-info [c] - {:class (typesym c) - :doc (docstring c) - :line (-> c .position .line) - :column (-> c .position .column) - :members (->> (concat (.constructors c) (.methods c) (.fields c)) - ;; Merge type-specific attributes with common ones. - (map (fn [^Doc m] - (merge {:name (-> m .name symbol) - :line (-> m .position .line) - :column (-> m .position .column) - :doc (docstring m)} - (parse-info m)))) - ;; Index by name, argtypes. Args for fields are nil. - (group-by :name) - (reduce (fn [ret [n ms]] - (assoc ret n (zipmap (map :argtypes ms) ms))) - {}))})) + ClassDoc + (parse-info [c] + {:class (typesym c) + :doc (docstring c) + :line (-> c .position .line) + :column (-> c .position .column) + :members (->> (concat (.constructors c) (.methods c) (.fields c)) + ;; Merge type-specific attributes with common ones. + (map (fn [^Doc m] + (merge {:name (-> m .name symbol) + :line (-> m .position .line) + :column (-> m .position .column) + :doc (docstring m)} + (parse-info m)))) + ;; Index by name, argtypes. Args for fields are nil. + (group-by :name) + (reduce (fn [ret [n ms]] + (assoc ret n (zipmap (map :argtypes ms) ms))) + {}))})) -(defn source-path - "Return the relative `.java` source path for the top-level class." - [klass] - (-> (str klass) - (str/replace #"^class " "") - (str/replace #"\$.*" "") - (str/replace "." "/") - (str ".java"))) +#_(defn source-path + "Return the relative `.java` source path for the top-level class." + [klass] + (-> (str klass) + (str/replace #"^class " "") + (str/replace #"\$.*" "") + (str/replace "." "/") + (str ".java"))) -(defn source-info - "If the source for the Java class is available on the classpath, parse it +#_(defn source-info + "If the source for the Java class is available on the classpath, parse it and return info to supplement reflection. Specifically, this includes source file and position, docstring, and argument name info. Info returned has the same structure as that of `orchard.java/reflect-info`." - [klass] - {:pre [(symbol? klass)]} - (try - (let [path (source-path klass)] - (when-let [root (parse-java path)] - (assoc (->> (map parse-info (.classes root)) - (filter #(= klass (:class %))) - (first)) - :file path - :path (. (io/resource path) getPath)))) - (catch Abort _))) + [klass] + {:pre [(symbol? klass)]} + (try + (let [path (source-path klass)] + (when-let [root (parse-java path)] + (assoc (->> (map parse-info (.classes root)) + (filter #(= klass (:class %))) + (first)) + :file path + :path (. (io/resource path) getPath)))) + (catch Abort _))) diff --git a/src/orchard/meta.clj b/src/orchard/meta.clj index 48b6af14..b0d649e9 100644 --- a/src/orchard/meta.clj +++ b/src/orchard/meta.clj @@ -9,7 +9,8 @@ [orchard.namespace :as ns] [orchard.misc :as misc] [orchard.spec :as spec] - [orchard.cljs.meta :as cljs-meta]) + [orchard.cljs.meta :as cljs-meta] + [clojure.tools.trace :as trace]) (:import [clojure.lang LineNumberingPushbackReader])) @@ -92,7 +93,7 @@ x nil)) -(defn resolve-var +(trace/deftrace resolve-var "Resolve `ns` and `sym` to a var. The function is a simple wrapper around `clojure.core/ns-resolve`." [ns sym] @@ -106,7 +107,7 @@ (catch Exception _ nil)))) -(defn resolve-aliases +(trace/deftrace resolve-aliases "Retrieve the ns aliases for `ns`. The function is a simple wrapper around `clojure.core/ns-alias`." [ns] @@ -272,7 +273,7 @@ (some-> (ns/canonical-source ns) .getPath))) -(defn ns-meta +(trace/deftrace ns-meta [ns] (when ns (merge diff --git a/src/orchard/misc.clj b/src/orchard/misc.clj index aa130daa..268f6329 100644 --- a/src/orchard/misc.clj +++ b/src/orchard/misc.clj @@ -1,4 +1,5 @@ (ns orchard.misc + (:refer-clojure :exclude [qualified-symbol?]) (:require [clojure.java.io :as io] [clojure.string :as str])) @@ -151,3 +152,12 @@ (require ns) (catch Exception _ nil))) (some-> sym find-var var-get))) + +(defn qualified-symbol? + "Return true if `x` is a symbol with a namespace + + This is only available from Clojure 1.9 so we backport it until we + drop support for Clojure 1.8." + {:added "0.5"} + [x] + (boolean (and (symbol? x) (namespace x) true))) diff --git a/test/orchard/info_test.clj b/test/orchard/info_test.clj index a94decdc..a49b944d 100644 --- a/test/orchard/info_test.clj +++ b/test/orchard/info_test.clj @@ -18,14 +18,29 @@ (use-fixtures :once wrap-info-params) -(deftest info-non-existing-test - (testing "Non existing symbol in clojure.core" - (is (nil? (info/info* {:ns 'clojure.core :sym (gensym "non-existing")})))) - - (testing "Non existing symbol in user - issue #86" - (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")})))) - - (testing "Non existing symbol with namespace - issue #86" +(deftest ^:test-refresh/focus info-non-existing-test + #_(testing "nil for non existing symbol in clojure.core" + (is (nil? (info/info* {:ns 'clojure.core :sym (gensym "non-existing")})))) + + #_(testing "nil for random non existing symbol in user - issue #86" + (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")})))) + + #_(testing "Non imported Java static function - issue #86" + (let [i (info/info* {:ns 'user :sym 'Integer/max})] + (is (= (select-keys i [:class :member :modifiers :throws :argtypes :arglists :returns]) + '{:throws () + :argtypes [int int] + :member max + :modifiers #{:public :static} + :class java.lang.Integer + :arglists ([a b]) + :returns int})) + (is (re-find #"Returns the greater of two" (:doc i))))) + + #_(testing "nil for non imported Java static function - issue #86" + (is (nil? (info/info* {:ns 'user :sym 'Integer/shift})))) + + (testing "nil for non existing symbol with clojure.core name - issue #86" (is (nil? (info/info* {:ns 'user :sym 'non-existing-ns/get}))))) (deftest info-deftype-test @@ -432,19 +447,6 @@ (deftest info-java-test (is (info/info-java 'clojure.lang.Atom 'swap))) -(deftest info-java-member-precendence-test - (testing "Integer/max - issue #86" - (let [i (info/info* {:ns 'user :sym 'Integer/max})] - (is (= (select-keys i [:class :member :modifiers :throws :argtypes :arglists :returns]) - '{:throws () - :argtypes [int int] - :member max - :modifiers #{:public :static} - :class java.lang.Integer - :arglists ([a b]) - :returns int})) - (is (re-find #"Returns the greater of two" (:doc i)))))) - (deftest javadoc-info-unit-test (testing "Get an HTTP URL for a Sun/Oracle Javadoc" (testing "Javadoc 1.7 format" diff --git a/test/orchard/java_test.clj b/test/orchard/java_test.clj index f93511ef..df0869f1 100644 --- a/test/orchard/java_test.clj +++ b/test/orchard/java_test.clj @@ -304,16 +304,16 @@ (deftest class-resolution-test (let [ns (ns-name *ns*)] - (testing "Class resolution" + (testing "Java default imports class resolution" (testing "of resolvable classes" - (is (= 'java.lang.String (:class (resolve-class ns 'String)))) - (is (= 'java.lang.String (:class (resolve-class ns 'java.lang.String))))) + (is (= 'java.lang.String (:class (resolve-imported-class ns 'String)))) + (is (= 'java.lang.String (:class (resolve-imported-class ns 'java.lang.String))))) (testing "of non-resolvable 'classes'" - (is (nil? (resolve-class ns 'NothingHere))) - (is (nil? (resolve-class ns 'not.actually.AClass)))) + (is (nil? (resolve-imported-class ns 'NothingHere))) + (is (nil? (resolve-imported-class ns 'not.actually.AClass)))) (testing "of things that aren't classes" - (is (nil? (resolve-class ns 'assoc))) - (is (nil? (resolve-class ns 'clojure.core))))))) + (is (nil? (resolve-imported-class ns 'assoc))) + (is (nil? (resolve-imported-class ns 'clojure.core))))))) (deftest member-resolution-test (let [ns (ns-name *ns*)] From a03a4c9c8347d5c7689154082df280bc9cfedb70 Mon Sep 17 00:00:00 2001 From: Andrea Richiardi Date: Sun, 21 Jun 2020 14:34:25 -0700 Subject: [PATCH 3/4] [Unfix #86] Improve doc and comment and java resolution This patch unfixes #86. It basically tries to restore a more linear flow in clj-info and orchard.java, distinguishing a bit more between qualified and unqualified patterns. --- src/orchard/info.clj | 107 ++++++++++++++++---------------- src/orchard/java.clj | 104 ++++++++++++++++--------------- src/orchard/meta.clj | 12 +++- test/orchard/info_test.clj | 123 +++++++++++++------------------------ test/orchard/java_test.clj | 19 ++---- 5 files changed, 167 insertions(+), 198 deletions(-) diff --git a/src/orchard/info.clj b/src/orchard/info.clj index 11de79d0..cc4a61f7 100644 --- a/src/orchard/info.clj +++ b/src/orchard/info.clj @@ -10,78 +10,80 @@ [orchard.java.classpath :as cp] [orchard.meta :as m] [orchard.misc :as misc] - [orchard.java.resource :as resource])) - -(defn qualify-sym - "Qualify a symbol, if any in `sym`, with `ns`. - - Return nil if `sym` is nil, attempting to generate a valid symbol even - in case some `ns` is missing." - {:added "0.5"} - [ns sym] - (when sym (symbol (some-> ns str) (str sym)))) + [orchard.java.resource :as resource] + [clojure.tools.trace :as trace])) (defn normalize-params "Normalize the info params. - If :sym is unqualified we assoc a :qualified-sym key with it. The - namespace used is :ns first and then :context-ns. - - If :sym is already qualified with assoc a :computed-ns key - and :unqualified-sym key. + If :sym is qualified we compute :sym-ns and :unqualified-sym. - If :dialect is nil, we assoc :clj, our default." + We always assoc :unqualified-sym by calling name on :sym. + We always assoc :dialect defaulting to :clj." {:added "0.5"} [params] (let [{:keys [sym ns context-ns]} params] - (cond-> (update params :dialect #(or % :clj)) + (cond-> params ;; If :sym is qualified, we have to use (name), cause: ;; (namespace 'mount.core) ;;=> nil ;; (name 'mount.core) ;;=> "mount.core (misc/qualified-symbol? sym) - (assoc :qualified-sym sym - :unqualified-sym (misc/name-sym sym) - :computed-ns (misc/namespace-sym sym)) + (assoc :sym-ns (misc/namespace-sym sym) + :qualified-symbol? true) - (and sym (not (misc/qualified-symbol? sym))) - (assoc :unqualified-sym (-> sym name symbol)) + true + (update :dialect #(or % :clj)) - ;; if :sym is missing we still assoc :unqualified-sym from :ns - (and (not sym) ns) - (assoc :unqualified-sym ns) + true + (assoc :unqualified-sym (misc/name-sym sym))))) - (and sym (not (misc/qualified-symbol? sym)) (or ns context-ns)) - (assoc :qualified-sym (qualify-sym (or ns context-ns) sym))))) +;; (defn referred-meta +;; [{:keys [ns sym-ns qualified-symbol? unqualified-sym]}] + +;; (let [refer-meta (some-> ns +;; (m/resolve-refer unqualified-sym) +;; (m/var-meta))] +;; (println "----" sym-ns unqualified-sym qualified-symbol? (:ns refer-meta)) +;; (cond +;; (and refer-meta qualified-symbol? (= sym-ns (:ns refer-meta))) +;; refer-meta + +;; (and refer-meta (not qualified-symbol?)) +;; refer-meta + +;; :else nil))) (defn clj-meta {:added "0.5"} - [{:keys [dialect ns sym computed-ns unqualified-sym] :as params}] + [{:keys [dialect ns sym sym-ns qualified-symbol? unqualified-sym] :as params}] {:pre [(= dialect :clj)]} - (let [ns (or ns computed-ns)] - (println "###") - (println params) - (println "###") + (let [ns (or ns sym-ns)] + (println "####" ns sym sym-ns unqualified-sym) (or ;; it's a special (special-symbol?) - (m/special-sym-meta sym) - ;; it's a var - (some-> ns (m/resolve-var sym) (m/var-meta)) - ;; it's a Java constructor/static member symbol - (some-> ns (java/resolve-symbol sym)) - ;; it's an unqualified sym maybe referred - ;; (some-> ns (m/resolve-var unqualified-sym) (m/var-meta)) - ;; it's a Java class/record type symbol - (some-> ns (java/resolve-type unqualified-sym)) + (trace/trace "special" (m/special-sym-meta sym)) + + ;; it's a referred symbol + ;; (!) refer should never resolve qualified symbols - we let m/resolve-var do that + (trace/trace "refer" (some-> ns (m/resolve-refer sym) (m/var-meta))) + ;; 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 - ;; too ambiguous. - ;; - ;; Observe the incorrect behavior (should return nil, there is a test): - ;; - ;; (info '{:ns clojure.core :sym non-existing}) ;;=> {:author "Rich Hickey" :ns clojure.core ...} + (trace/trace "alias" (some-> ns (m/resolve-aliases) (get unqualified-sym) (m/ns-meta))) + + ;; it's a namespace symbol + ;; (!) We use :unqualified-sym *exclusively* here because because our :ns is + ;; too ambiguous. ;; - (some-> (find-ns unqualified-sym) (m/ns-meta))))) + ;; Observe the following incorrect behavior (should return nil, there is a test): + ;; (info '{:ns clojure.core :sym non-existing}) ;;=> {:author "Rich Hickey" :ns clojure.core ...} + (trace/trace "namespace" (some-> (find-ns unqualified-sym) (m/ns-meta))) + + ;; it's a var + ;; (!) has to come before Java resolution - see Integer/max test + (trace/trace "var" (some-> ns (m/resolve-var sym) (m/var-meta))) + + ;; it's a Java class/member symbol + (trace/trace "java" (some-> ns (java/resolve-symbol sym)))))) (defn cljs-meta {:added "0.5"} @@ -136,10 +138,9 @@ in as :env key in params." [params] (let [params (normalize-params params) - dialect (:dialect params) - meta (cond - (= dialect :clj) (clj-meta params) - (= dialect :cljs) (cljs-meta params))] + meta (condp = (:dialect params) + :clj (clj-meta params) + :cljs (cljs-meta params))] ;; TODO: Split the responsibility of finding meta and normalizing the meta map. (some-> diff --git a/src/orchard/java.clj b/src/orchard/java.clj index b5de7bd8..77e65000 100644 --- a/src/orchard/java.clj +++ b/src/orchard/java.clj @@ -253,21 +253,21 @@ ;; specific query: type information for a class name, and member information for ;; a class/member combination. -(defn type-info +(trace/deftrace type-info "For the class or interface symbol, return Java type info. If the type has defined contructors, 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])))) - -(trace/deftrace member-info + (when-let [info (class-info class)] + (let [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. If the member's definition is in a superclass, info returned will be for the @@ -303,7 +303,7 @@ ;; by considering arity, and narrowed further *if* we could consider argument ;; types...) -(defn resolve-imported-class +(defn resolve-class "Given namespace and class symbols, search the imported classes and return class info. If not found, search all classes on the classpath (requires a qualified name)." @@ -315,14 +315,7 @@ (class-info (-> ^Class c .getName symbol)) (class-info sym))))) -(defn resolve-qualified-class - "Try to resolve symbol within Clojure default classes and return info." - [qualified-sym] - (when-let [c (resolve qualified-sym)] - (when (class? c) - (class-info (-> ^Class c .getName symbol))))) - -(trace/deftrace resolve-member +(defn resolve-member "Given namespace and member symbols, search the imported classes and return a list of each matching member's info." [ns sym] @@ -330,21 +323,53 @@ (->> (vals (ns-imports ns)) (map #(member-info (-> ^Class % .getName symbol) sym)) (filter identity) - (distinct)))) + (distinct) + (not-empty)))) (defn- trim-one-dot + "Trim leading/trailing (one only) dot." [s] (str/replace s #"^\.|\.$" "")) -(defn- split-out-class-and-member +(defn- split-class+member "Split (qualified) sym and return a tuple of symbols [class member]." - [qualified-sym] - {:pre [misc/qualified-symbol? qualified-sym]} - (->> (str/split qualified-sym #"/" 2) + [sym] + (->> (str/split sym #"/" 2) (map #(when % (symbol %))))) -(trace/deftrace resolve-symbol - "Return the info map for a Java member symbol. +(trace/deftrace resolve-qualified + [ns sym] + {:pre [(every? symbol? [ns sym]) + (misc/qualified-symbol? sym)]} + (let [qualified-sym (-> sym str trim-one-dot) + [class static-member] (split-class+member qualified-sym)] + (if-let [c (resolve-class ns class)] + (if static-member + (member-info (:class c) static-member) ;; SomeClass/methodCall + (type-info (:class c)))))) ;; SomeClass + +(defn resolve-type + "Return type info, for a Java class, interface or record." + [ns sym] + {:pre [(every? symbol? [ns sym]) + (not (misc/qualified-symbol? sym))]} + (some->> (resolve-class ns sym) + :class + type-info)) + +(defn resolve-unqualified + [ns sym] + {:pre [(every? symbol? [ns sym]) + (not (misc/qualified-symbol? sym))]} + (let [unqualified-sym (-> sym str trim-one-dot symbol)] + (or (resolve-type ns unqualified-sym) ;; defrecord/deftype + (when-let [ms (seq (resolve-member ns unqualified-sym))] ;; methodCall + (if (= 1 (count ms)) + (first ms) + {:candidates (zipmap (map :class ms) ms)}))))) + +(defn resolve-symbol + "Return the info map for a Java member symbol (qualified or unqualified). Constructors and static calls are resolved to the class unambiguously. Instance members are resolved unambiguously if defined @@ -352,27 +377,10 @@ by that name, a map of class names to member info is returned as `:candidates`." [ns sym] - {:pre [(every? symbol? [ns sym]) (misc/qualified-symbol? sym)]} - (let [sym (-> sym str trim-one-dot) - sym* (symbol sym) - [class static-member] (split-out-class-and-member sym)] - (if-let [c (resolve-imported-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)}))))) - -(trace/deftrace resolve-type - "Return type info, for a Java class, interface or record." - [ns sym] - {:pre [(every? symbol? [ns sym]) (not (misc/qualified-symbol? sym))]} - (let [sym (-> sym str trim-one-dot)] - (some->> (first class) - (resolve-imported-class ns) - :class - type-info))) + {:pre [(every? symbol? [ns sym])]} + (if (misc/qualified-symbol? sym) + (resolve-qualified ns sym) + (resolve-unqualified ns sym))) (def javadoc-base-urls "Copied from clojure.java.javadoc. These are the base urls for diff --git a/src/orchard/meta.clj b/src/orchard/meta.clj index b0d649e9..79fbd5d2 100644 --- a/src/orchard/meta.clj +++ b/src/orchard/meta.clj @@ -93,7 +93,7 @@ x nil)) -(trace/deftrace resolve-var +(defn resolve-var "Resolve `ns` and `sym` to a var. The function is a simple wrapper around `clojure.core/ns-resolve`." [ns sym] @@ -107,7 +107,7 @@ (catch Exception _ nil)))) -(trace/deftrace resolve-aliases +(defn resolve-aliases "Retrieve the ns aliases for `ns`. The function is a simple wrapper around `clojure.core/ns-alias`." [ns] @@ -115,6 +115,14 @@ (when-let [ns (find-ns ns)] (ns-aliases ns))) +(trace/deftrace resolve-refer + "Resolve `ns` and a referred an unqualified `sym` to a var. + The function is a simple wrapper around `clojure.core/ns-refers`." + [ns sym] + {:pre [(every? symbol? [ns sym])]} + (when-let [ns (find-ns ns)] + (get (ns-refers ns) sym))) + ;; 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. diff --git a/test/orchard/info_test.clj b/test/orchard/info_test.clj index a49b944d..3bd73235 100644 --- a/test/orchard/info_test.clj +++ b/test/orchard/info_test.clj @@ -18,29 +18,20 @@ (use-fixtures :once wrap-info-params) -(deftest ^:test-refresh/focus info-non-existing-test - #_(testing "nil for non existing symbol in clojure.core" - (is (nil? (info/info* {:ns 'clojure.core :sym (gensym "non-existing")})))) - - #_(testing "nil for random non existing symbol in user - issue #86" - (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")})))) - - #_(testing "Non imported Java static function - issue #86" - (let [i (info/info* {:ns 'user :sym 'Integer/max})] - (is (= (select-keys i [:class :member :modifiers :throws :argtypes :arglists :returns]) - '{:throws () - :argtypes [int int] - :member max - :modifiers #{:public :static} - :class java.lang.Integer - :arglists ([a b]) - :returns int})) - (is (re-find #"Returns the greater of two" (:doc i))))) - - #_(testing "nil for non imported Java static function - issue #86" - (is (nil? (info/info* {:ns 'user :sym 'Integer/shift})))) - - (testing "nil for non existing symbol with clojure.core name - issue #86" +(deftest info-non-existing-test + (testing "nil for random non-existing unqualified symbol in clojure.core" + (is (nil? (info/info* {:ns 'clojure.core :sym (gensym "non-existing")})))) + + (testing "nil for random non-existing qualified symbol in clojure.core" + (is (nil? (info/info* {:ns 'user :sym (symbol "clojure.core" (str (gensym "non-existing")))})))) + + (testing "nil for random non-existing symbol in user - issue #86" + (is (nil? (info/info* {:ns 'user :sym (gensym "non-existing")})))) + + (testing "nil for non imported Java static function - issue #86" + (is (nil? (info/info* {:ns 'user :sym 'Integer/shift})))) + + (testing "nil for qualified get symbol (theoretically in clojure.core) in wrong namespace - issue #86" (is (nil? (info/info* {:ns 'user :sym 'non-existing-ns/get}))))) (deftest info-deftype-test @@ -209,7 +200,7 @@ (is (str/includes? (:file i) "orchard/test_ns"))))) (deftest info-ns-as-sym-test - (testing "Only namespace as qualified symbol" + (testing "Resolution from :sym (and not :ns) as namespace symbol should work" (let [params '{:sym orchard.test-ns} expected '{:ns orchard.test-ns :name orchard.test-ns @@ -264,7 +255,7 @@ (is (str/includes? (:file i) "orchard/test_ns_dep"))))))) (deftest info-cljs-core-namespace-test - (testing "Namespace itself but cljs.core" + (testing "Resolution of cljs.core for Clojurescript works" (testing "- :cljs" (is (= 'cljs.core (:ns (info/info* (merge *cljs-params* '{:sym cljs.core})))))) (testing "- :clj" @@ -336,7 +327,7 @@ (map #(info/info* (merge *cljs-params* %)) params))))))) (deftest info-macros-var-test - (testing "Macro" + (testing "Macro is resolved directly as var" (testing "- :cljs" (let [params '[{:sym orchard.test-macros/my-add} {:ns orchard.test-macros @@ -365,9 +356,10 @@ (map #(info/info* %)) (map #(select-keys % [:ns :name :arglists :macro :file]))))))))) -(deftest info-macros-referred-var-test - (testing "Macro - referred" - (let [params '[{:sym orchard.test-ns/my-add} +(deftest ^:test-refresh/focus info-macros-referred-var-test + (testing "Macro is resolved as referred symbol in containing namespace" + (let [params '[{:ns orchard.test-ns + :sym orchard.test-ns/my-add} {:ns orchard.test-ns :sym my-add}] expected '{:name my-add @@ -440,9 +432,21 @@ :see-also)))))) (deftest info-jvm-test - (is (info/info* {:ns 'orchard.info :sym 'java.lang.Class})) - (is (info/info* {:ns 'orchard.info :sym 'Class/forName})) - (is (info/info* {:ns 'orchard.info :sym '.toString}))) + (testing "some happy path - the bulk of these are in orchard.java-test" + (is (info/info* {:ns 'orchard.info :sym 'java.lang.Class})) + (is (info/info* {:ns 'orchard.info :sym 'Class/forName})) + (is (info/info* {:ns 'orchard.info :sym '.toString}))) + + (testing "Integer/max static function should not resolve to clojure.core/max - issue #86" + (let [i (info/info* {:ns 'user :sym 'Integer/max})] + (is (= (select-keys i [:class :member :modifiers :throws :argtypes :arglists :returns]) + '{:throws () + :argtypes [int int] + :member max + :modifiers #{:public :static} + :class java.lang.Integer + :arglists ([a b]) + :returns int}))))) (deftest info-java-test (is (info/info-java 'clojure.lang.Atom 'swap))) @@ -519,59 +523,14 @@ (is (relative "clojure/core.clj")) (is (nil? (relative "notclojure/core.clj")))) -(deftest qualify-sym-test - (is (= '+ (info/qualify-sym nil '+))) - (is (nil? (info/qualify-sym 'cljs.core nil))) - (is (nil? (info/qualify-sym nil nil))) - (is (= 'cljs.core/+ (info/qualify-sym 'cljs.core '+)))) - (deftest normalize-params-test - (testing ":qualified-sym namespace coming from :ns" - (is (= 'cljs.core/+ (-> '{:ns cljs.core - :sym + - :context-ns orchard.info} - info/normalize-params - :qualified-sym)))) - - (testing ":qualified-sym namespace coming from :context-ns if :ns is missing" - (is (= 'orchard.info/+ (-> '{:sym + :context-ns orchard.info} - info/normalize-params - :qualified-sym)))) - - (testing "adding :qualified-sym if :sym is qualified" - (is (= '{:sym orchard.info/+ - :qualified-sym orchard.info/+} - (-> '{:sym orchard.info/+} - (info/normalize-params) - (select-keys [:sym :qualified-sym]))))) - - (testing "adding :computed-ns if :sym is qualified" + (testing "adding :sym-ns if :sym is qualified" (is (= '{:sym orchard.info/+ - :computed-ns orchard.info} - (-> '{:sym orchard.info/+} - (info/normalize-params) - (select-keys [:sym :computed-ns]))))) + :sym-ns orchard.info} + (-> '{:sym orchard.info/+} (info/normalize-params) (select-keys [:sym :sym-ns]))))) - (testing "adding :unqualified-sym if :sym is qualified" - (is (= '{:sym orchard.info/+ - :unqualified-sym +} - (-> '{:sym orchard.info/+} - (info/normalize-params) - (select-keys [:sym :unqualified-sym]))))) - - (testing "adding :unqualified-sym if :sym is unqualified" - (is (= '{:sym + - :unqualified-sym +} - (-> '{:sym +} - (info/normalize-params) - (select-keys [:sym :unqualified-sym]))))) - - (testing "in case of :ns only it should always assoc :unqualified-sym" - (is (= '{:ns orchard.info - :unqualified-sym orchard.info} - (-> '{:ns orchard.info} - (info/normalize-params) - (select-keys [:ns :unqualified-sym])))))) + (testing "default to :clj dialect if missing" + (is (= :clj (-> '{:sym orchard.info/+} (info/normalize-params) :dialect))))) (deftest boot-file-resolution-test ;; this checks the files on the classpath soo you need the test-resources diff --git a/test/orchard/java_test.clj b/test/orchard/java_test.clj index df0869f1..4cc741c3 100644 --- a/test/orchard/java_test.clj +++ b/test/orchard/java_test.clj @@ -306,14 +306,14 @@ (let [ns (ns-name *ns*)] (testing "Java default imports class resolution" (testing "of resolvable classes" - (is (= 'java.lang.String (:class (resolve-imported-class ns 'String)))) - (is (= 'java.lang.String (:class (resolve-imported-class ns 'java.lang.String))))) + (is (= 'java.lang.String (:class (resolve-class ns 'String)))) + (is (= 'java.lang.String (:class (resolve-class ns 'java.lang.String))))) (testing "of non-resolvable 'classes'" - (is (nil? (resolve-imported-class ns 'NothingHere))) - (is (nil? (resolve-imported-class ns 'not.actually.AClass)))) + (is (nil? (resolve-class ns 'NothingHere))) + (is (nil? (resolve-class ns 'not.actually.AClass)))) (testing "of things that aren't classes" - (is (nil? (resolve-imported-class ns 'assoc))) - (is (nil? (resolve-imported-class ns 'clojure.core))))))) + (is (nil? (resolve-class ns 'assoc))) + (is (nil? (resolve-class ns 'clojure.core))))))) (deftest member-resolution-test (let [ns (ns-name *ns*)] @@ -370,10 +370,3 @@ (is (nil? (resolve-symbol ns 'missingMethod))) (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))))))) From 37ca25ff03617b98f5d24c9bc4640e49baf2d842 Mon Sep 17 00:00:00 2001 From: Andrea Richiardi Date: Sun, 12 Jul 2020 19:26:06 -0700 Subject: [PATCH 4/4] WIP --- project.clj | 3 +-- src/orchard/info.clj | 40 ++++++++++++++++++------------------- src/orchard/java.clj | 7 +++---- src/orchard/meta.clj | 8 ++++---- test/orchard/info_test.clj | 32 +++++++++++++++++++++++------ test/orchard/util/trace.clj | 22 ++++++++++++++++++++ 6 files changed, 75 insertions(+), 37 deletions(-) create mode 100644 test/orchard/util/trace.clj diff --git a/project.clj b/project.clj index b08343c8..c001c839 100644 --- a/project.clj +++ b/project.clj @@ -40,8 +40,7 @@ :test {:resource-paths ["test-resources"]} ;; Development tools - :dev {:dependencies [[pjstadig/humane-test-output "0.10.0"] - [org.clojure/tools.trace "0.7.10"]] + :dev {:dependencies [[pjstadig/humane-test-output "0.10.0"]] :resource-paths ["test-resources"] :plugins [[com.jakemccrary/lein-test-refresh "0.23.0"]] :injections [(require 'pjstadig.humane-test-output) diff --git a/src/orchard/info.clj b/src/orchard/info.clj index cc4a61f7..bc53d7da 100644 --- a/src/orchard/info.clj +++ b/src/orchard/info.clj @@ -10,8 +10,7 @@ [orchard.java.classpath :as cp] [orchard.meta :as m] [orchard.misc :as misc] - [orchard.java.resource :as resource] - [clojure.tools.trace :as trace])) + [orchard.java.resource :as resource])) (defn normalize-params "Normalize the info params. @@ -37,38 +36,37 @@ true (assoc :unqualified-sym (misc/name-sym sym))))) -;; (defn referred-meta -;; [{:keys [ns sym-ns qualified-symbol? unqualified-sym]}] +(defn referred-meta + [{:keys [ns sym-ns qualified-symbol? unqualified-sym]}] -;; (let [refer-meta (some-> ns -;; (m/resolve-refer unqualified-sym) -;; (m/var-meta))] -;; (println "----" sym-ns unqualified-sym qualified-symbol? (:ns refer-meta)) -;; (cond -;; (and refer-meta qualified-symbol? (= sym-ns (:ns refer-meta))) -;; refer-meta + (let [refer-meta (some-> ns + (m/resolve-refer unqualified-sym) + (m/var-meta))] + (println "----" sym-ns unqualified-sym qualified-symbol? (:ns refer-meta)) + (cond + (and refer-meta qualified-symbol? (= sym-ns (:ns refer-meta))) + refer-meta -;; (and refer-meta (not qualified-symbol?)) -;; refer-meta + (and refer-meta (not qualified-symbol?)) + refer-meta -;; :else nil))) + :else nil))) (defn clj-meta {:added "0.5"} [{:keys [dialect ns sym sym-ns qualified-symbol? unqualified-sym] :as params}] {:pre [(= dialect :clj)]} (let [ns (or ns sym-ns)] - (println "####" ns sym sym-ns unqualified-sym) (or ;; it's a special (special-symbol?) - (trace/trace "special" (m/special-sym-meta sym)) + (m/special-sym-meta sym) ;; it's a referred symbol ;; (!) refer should never resolve qualified symbols - we let m/resolve-var do that - (trace/trace "refer" (some-> ns (m/resolve-refer sym) (m/var-meta))) + (some-> ns (m/resolve-refer sym) (m/var-meta)) ;; it's an alias for another ns - (trace/trace "alias" (some-> ns (m/resolve-aliases) (get unqualified-sym) (m/ns-meta))) + (some-> ns (m/resolve-aliases) (get unqualified-sym) (m/ns-meta)) ;; it's a namespace symbol ;; (!) We use :unqualified-sym *exclusively* here because because our :ns is @@ -76,14 +74,14 @@ ;; ;; Observe the following incorrect behavior (should return nil, there is a test): ;; (info '{:ns clojure.core :sym non-existing}) ;;=> {:author "Rich Hickey" :ns clojure.core ...} - (trace/trace "namespace" (some-> (find-ns unqualified-sym) (m/ns-meta))) + (some-> (find-ns unqualified-sym) (m/ns-meta)) ;; it's a var ;; (!) has to come before Java resolution - see Integer/max test - (trace/trace "var" (some-> ns (m/resolve-var sym) (m/var-meta))) + (some-> ns (m/resolve-var sym) (m/var-meta)) ;; it's a Java class/member symbol - (trace/trace "java" (some-> ns (java/resolve-symbol sym)))))) + (some-> ns (java/resolve-symbol sym))))) (defn cljs-meta {:added "0.5"} diff --git a/src/orchard/java.clj b/src/orchard/java.clj index 77e65000..59c61465 100644 --- a/src/orchard/java.clj +++ b/src/orchard/java.clj @@ -9,8 +9,7 @@ [clojure.string :as str] [orchard.java.classpath :as cp] [orchard.misc :as misc] - [orchard.java.resource :as resource] - [clojure.tools.trace :as trace]) + [orchard.java.resource :as resource]) (:import (clojure.lang IPersistentMap) (clojure.reflect Constructor Field JavaReflector Method) @@ -253,7 +252,7 @@ ;; specific query: type information for a class name, and member information for ;; a class/member combination. -(trace/deftrace type-info +(defn type-info "For the class or interface symbol, return Java type info. If the type has defined contructors, the line and column returned will be for the first of these for more convenient `jump` navigation." @@ -337,7 +336,7 @@ (->> (str/split sym #"/" 2) (map #(when % (symbol %))))) -(trace/deftrace resolve-qualified +(defn resolve-qualified [ns sym] {:pre [(every? symbol? [ns sym]) (misc/qualified-symbol? sym)]} diff --git a/src/orchard/meta.clj b/src/orchard/meta.clj index 79fbd5d2..263fac34 100644 --- a/src/orchard/meta.clj +++ b/src/orchard/meta.clj @@ -9,8 +9,7 @@ [orchard.namespace :as ns] [orchard.misc :as misc] [orchard.spec :as spec] - [orchard.cljs.meta :as cljs-meta] - [clojure.tools.trace :as trace]) + [orchard.cljs.meta :as cljs-meta]) (:import [clojure.lang LineNumberingPushbackReader])) @@ -115,11 +114,12 @@ (when-let [ns (find-ns ns)] (ns-aliases ns))) -(trace/deftrace resolve-refer +(defn resolve-refer "Resolve `ns` and a referred an unqualified `sym` to a var. The function is a simple wrapper around `clojure.core/ns-refers`." [ns sym] {:pre [(every? symbol? [ns sym])]} + (when-let [ns (find-ns ns)] (get (ns-refers ns) sym))) @@ -281,7 +281,7 @@ (some-> (ns/canonical-source ns) .getPath))) -(trace/deftrace ns-meta +(defn ns-meta [ns] (when ns (merge diff --git a/test/orchard/info_test.clj b/test/orchard/info_test.clj index 3bd73235..df70bd21 100644 --- a/test/orchard/info_test.clj +++ b/test/orchard/info_test.clj @@ -6,8 +6,17 @@ [orchard.misc :as misc] [orchard.cljs.test-env :as test-env] [orchard.meta :as meta] + [orchard.util.trace :as trace] [orchard.test-ns])) +(trace/trace! #'orchard.info/info*) +(trace/trace! #'orchard.meta/special-sym-meta) +(trace/trace! #'orchard.meta/resolve-refer) +(trace/trace! #'orchard.meta/resolve-aliases) +(trace/trace! #'orchard.meta/resolve-var) +(trace/trace! #'clojure.core/find-ns) +(trace/trace! #'orchard.java/resolve-symbol) + (def ^:dynamic *cljs-params*) (defn wrap-info-params @@ -32,7 +41,10 @@ (is (nil? (info/info* {:ns 'user :sym 'Integer/shift})))) (testing "nil for qualified get symbol (theoretically in clojure.core) in wrong namespace - issue #86" - (is (nil? (info/info* {:ns 'user :sym 'non-existing-ns/get}))))) + (is (nil? (info/info* {:ns 'user :sym 'non-existing-ns/get})))) + + (testing "nil for Java symbol without a dot - issue #92" + (is (nil? (info/info 'user 'shift))))) (deftest info-deftype-test (testing "deftype" @@ -368,11 +380,11 @@ :file "orchard/test_macros.clj" :macro true}] - (testing "- :cljs" - (is (= (take 2 (repeat expected)) - (->> params - (map #(info/info* (merge *cljs-params* %))) - (map #(select-keys % [:ns :name :arglists :macro :file])))))) + #_(testing "- :cljs" + (is (= (take 2 (repeat expected)) + (->> params + (map #(info/info* (merge *cljs-params* %))) + (map #(select-keys % [:ns :name :arglists :macro :file])))))) (testing "- :clj" (is (= (take 2 (repeat expected)) @@ -544,3 +556,11 @@ (-> (merge *cljs-params* '{:ns orchard.test-ns :sym x}) (info/info*) (select-keys [:ns :name :file])))))) + +;; (trace/untrace! #'orchard.info/info) +;; (trace/untrace! #'orchard.meta/special-sym-meta) +;; (trace/untrace! #'orchard.meta/resolve-refer) +;; (trace/untrace! #'orchard.meta/resolve-aliases) +;; (trace/untrace! #'orchard.meta/resolve-var) +;; (trace/untrace! #'clojure.core/find-ns) +;; (trace/untrace! #'orchard.java/resolve-symbol) diff --git a/test/orchard/util/trace.clj b/test/orchard/util/trace.clj new file mode 100644 index 00000000..d4b9f201 --- /dev/null +++ b/test/orchard/util/trace.clj @@ -0,0 +1,22 @@ +(ns orchard.util.trace) + +;; (set! clojure.core/*print-length* 3) + +(defn trace! + "Given a function var, trace its result." + [v] + (let [m (meta v) + n (symbol (str (ns-name (:ns m))) (str (:name m))) + orig (::original-var m @v)] + (alter-var-root v (constantly (fn [& args] + (binding [clojure.core/*print-length* 3] + (let [result (apply orig args)] + (prn (cons n args)) + (println "=>" result) + result))))) + (alter-meta! v assoc ::original-var orig))) + +(defn untrace! [v] + (when-let [orig (::original-var (meta v))] + (alter-var-root v (constantly orig)) + (alter-meta! v dissoc ::original-var)))