diff --git a/CHANGELOG.md b/CHANGELOG.md index a6bc742..3b43ce8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ * It represents exceptions that happen at runtime (and therefore never include a `:phase`) which however, represent code that cannot possibly work, and therefore are a "compile-like" exception (i.e. a linter could have caught them). * The set of conditions which are considered a 'compile-like' exception is private and subject to change. * Use Orchard [0.15.1](https://github.com/clojure-emacs/orchard/blob/v0.15.1/CHANGELOG.md#0151-2023-09-21). +* [#13](https://github.com/clojure-emacs/haystack/issues/13): Expand the set of frames considered as `:tooling`. ## 0.2.0 (2023-08-20) diff --git a/src/haystack/analyzer.clj b/src/haystack/analyzer.clj index b314da5..36b7958 100644 --- a/src/haystack/analyzer.clj +++ b/src/haystack/analyzer.clj @@ -121,7 +121,7 @@ frame)) (def ^:private tooling-frame-re - #"^clojure\.lang\.AFn|^clojure\.lang\.RestFn|^clojure\.lang\.RT|clojure\.lang\.Compiler|^nrepl\.|^cider\.|^clojure\.core/eval|^clojure\.core/apply|^clojure\.core/with-bindings|^clojure\.core/binding-conveyor-fn|^clojure\.main/repl") + #"^clojure\.lang\.LazySeq|^clojure\.lang\.Var|^clojure\.lang\.MultiFn|^clojure\.lang\.AFn|^clojure\.lang\.RestFn|^clojure\.lang\.RT|clojure\.lang\.Compiler|^nrepl\.|^cider\.|^refactor-nrepl\.|^shadow.cljs\.|^clojure\.core/eval|^clojure\.core/apply|^clojure\.core/with-bindings|^clojure\.core\.protocols|^clojure\.core\.map/fn|^clojure\.core/binding-conveyor-fn|^clojure\.main/repl") (defn- tooling-frame-name? [frame-name last?] (let [demunged (repl/demunge frame-name)] @@ -129,7 +129,7 @@ (and last? ;; Everything runs from a Thread, so this frame, if at root, is irrelevant. ;; However one can invoke this method 'by hand', which is why we also observe `last?`. - (re-find #"^java\.lang\.Thread/run" demunged)))))) + (re-find #"^java\.lang\.Thread/run|^java\.util\.concurrent" demunged)))))) (defn- flag-tooling "Given a collection of stack `frames`, marks the 'tooling' ones as such. @@ -137,13 +137,22 @@ A 'tooling' frame is one that generally represents Clojure, JVM, nREPL or CIDER internals, and that is therefore not relevant to application-level code." [frames] - (let [last-index (dec (count frames))] - (into [] - (map-indexed (fn [i {frame-name :name :as frame}] - (cond-> frame - (some-> frame-name (tooling-frame-name? (= i last-index))) - (flag-frame :tooling)))) - frames))) + (let [results (volatile! {})] + (->> frames + reverse + (into [] + (map-indexed (fn [^long i {frame-name :name :as frame}] + (let [;; A frame is considered the last if it's literally the last one, + ;; or if the previous element was marked as tooling. + last? (or (zero? i) + (some-> @results (get (dec i)))) + tooling? (some-> frame-name (tooling-frame-name? last?))] + (vswap! results assoc i tooling?) + (cond-> frame + tooling? + (flag-frame :tooling)))))) + reverse + vec))) (defn directory-namespaces "Looks for all namespaces inside of directories on the class diff --git a/test/haystack/analyzer_test.clj b/test/haystack/analyzer_test.clj index 71b9f51..66ba5f3 100644 --- a/test/haystack/analyzer_test.clj +++ b/test/haystack/analyzer_test.clj @@ -656,14 +656,20 @@ (#'sut/tooling-frame-name? frame-name false))) true) "cider.foo" true + "refactor-nrepl.middleware/wrap-refactor" true + "shadow.cljs.devtools.server.nrepl/shadow-inint" true "acider.foo" false ;; `+` is "application" level, should not be hidden: "clojure.core/+" false ;; `apply` typically is internal, should be hidden: "clojure.core/apply" true "clojure.core/binding-conveyor-fn/fn" true + "clojure.core.protocols/iter-reduce" true "clojure.core/eval" true "clojure.core/with-bindings*" true + "clojure.lang.MultiFn/invoke" true + "clojure.lang.LazySeq/sval" true + "clojure.lang.Var/invoke" true "clojure.lang.AFn/applyTo" true "clojure.lang.AFn/applyToHelper" true "clojure.lang.RestFn/invoke" true @@ -685,7 +691,7 @@ {:name "nrepl.foo", :flags #{:tooling}} {:name "clojure.lang.RestFn/invoke", :flags #{:tooling}} {:name "don't touch me 2"} - ;; gets the flag because it's not the root frame: + ;; gets the flag because it's the root frame: {:name "java.lang.Thread/run", :flags #{:tooling}}] (#'sut/flag-tooling [{:name "cider.foo"} {:name "java.lang.Thread/run"} @@ -694,4 +700,22 @@ {:name "clojure.lang.RestFn/invoke"} {:name "don't touch me 2"} {:name "java.lang.Thread/run"}])) - "Adds the flag when appropiate, leaving other entries untouched")) + "Adds the flag when appropiate, leaving other entries untouched") + + (let [frames [{:name "don't touch me"} + {:name "java.util.concurrent.FutureTask/run"} + {:name "java.util.concurrent.ThreadPoolExecutor/runWorker"} + {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run"}]] + (is (= [{:name "don't touch me"} + {:name "java.util.concurrent.FutureTask/run", :flags #{:tooling}} + {:name "java.util.concurrent.ThreadPoolExecutor/runWorker", :flags #{:tooling}} + {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run", :flags #{:tooling}}] + (#'sut/flag-tooling frames)) + "Three j.u.concurrent frames get the flag if they're at the bottom") + (is (= [{:name "don't touch me"} + {:name "java.util.concurrent.FutureTask/run"} + {:name "java.util.concurrent.ThreadPoolExecutor/runWorker"} + {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run"} + {:name "x"}] + (#'sut/flag-tooling (conj frames {:name "x"}))) + "The j.u.concurrent frames don't get the flag if they're not at the bottom")))