From 01e64c299048b4b843bbd69eab5ce5fae7eba4a4 Mon Sep 17 00:00:00 2001 From: Oleksandr Yakushev Date: Fri, 11 Apr 2025 12:26:33 +0300 Subject: [PATCH] [track-state] Completely redesign track-state middleware Optimizes execution speed and allocation rate by ~100x. --- src/cider/nrepl/middleware/track_state.clj | 386 +++++++++--------- .../nrepl/middleware/track_state_test.clj | 259 ++++-------- 2 files changed, 281 insertions(+), 364 deletions(-) diff --git a/src/cider/nrepl/middleware/track_state.clj b/src/cider/nrepl/middleware/track_state.clj index 0070404f..9a7ed2b4 100644 --- a/src/cider/nrepl/middleware/track_state.clj +++ b/src/cider/nrepl/middleware/track_state.clj @@ -1,13 +1,13 @@ (ns cider.nrepl.middleware.track-state "State tracker for client sessions." - {:author "Artur Malabarba"} + {:author "Artur Malabarba, Oleksandr Yakushev"} (:require [cider.nrepl.middleware :as mw] [cider.nrepl.middleware.util :as util] [cider.nrepl.middleware.util.cljs :as cljs] [cider.nrepl.middleware.util.meta :as um] [clojure.java.io :as io] - [clojure.string :as string] + [clojure.string :as str] [clojure.tools.namespace.find :as ns-find] [nrepl.misc :refer [response-for]] [nrepl.transport :as transport] @@ -16,16 +16,13 @@ [orchard.java.classpath :as cp] [orchard.misc :as misc]) (:import - (clojure.lang MultiFn Namespace) + (clojure.lang MultiFn Namespace Var) (java.io File) - (java.net SocketException) + (java.util WeakHashMap) (java.util.jar JarFile) (nrepl.transport Transport))) -(def clojure-core (try (find-ns 'clojure.core) - (catch Exception _e nil))) - -;;; Auxiliary +;;; Shared part (defn- inferrable-indent? "Does metadata map `m` lack, need a `:style/indent` value, and is a suitable candidate for it?" @@ -52,34 +49,105 @@ ;; * The `orchard.indent` logic is not meant to operate on clojure.core stuff, ;; because it compares a given macro against a clojure.core counterpart ;; (which doesn't make sense for a macro which already belongs to clojure.core) - (not (or (string/starts-with? namespace-name "clojure.") - (string/starts-with? namespace-name "cljs."))) + (not (or (str/starts-with? namespace-name "clojure.") + (str/starts-with? namespace-name "cljs."))) true))) -(defn- enriched-meta - "Like `clojure.core/meta` but adds {:fn true} for functions, multimethods and macros, - and `:style/indent` when missing and inferrable. - - Should only be used for vars." - [the-var] - (let [m (meta the-var)] - (cond-> m - (or (fn? @the-var) - (instance? MultiFn @the-var)) - (assoc :fn true) - - (inferrable-indent? m) - indent/infer-style-indent))) - -(defn filter-core-and-get-meta - "Remove keys whose values are vars in the core namespace." - [refers] - (->> refers - (into {} (keep (fn [[sym the-var]] - (when (var? the-var) - (let [{the-ns :ns :as the-meta} (enriched-meta the-var)] - (when-not (identical? the-ns clojure-core) - [sym (um/relevant-meta the-meta)])))))))) +;;; Clojure part + +(def ^:private clojure-core (try (find-ns 'clojure.core) + (catch Exception _e nil))) + +;; A "real metadata cache" is a map {ns-symbol WHM{var-symbol meta}} of +;; actual (not filtered) var metadata. We keep this to know when to recompute +;; the filtered metadata for a var (if the real meta hasn't changed, no need to +;; recompute). WHM is used to avoid unnecessarily holding onto the metadata if +;; the Var has been removed somehow. +(def ^:dynamic *real-metadata-cache* nil) +(def ^:dynamic *old-project-state* nil) + +(defn- get-metadata-if-changed? + [^Var the-var, ^WeakHashMap real-metadata-ns-cache] + (let [var-name (.sym the-var) + ;; WHM is not thread-safe but we should only access this from a single + ;; (session) thread. + cached-meta (some-> real-metadata-ns-cache (.get var-name)) + current-meta (meta the-var)] + (when-not (identical? cached-meta current-meta) + (some-> real-metadata-ns-cache (.put var-name current-meta)) + current-meta))) + +;; Note that we aggressively cut down unnecessary keys in this mw as it triggers +;; on EACH evaluation, and the middleware retains (caches) this data for ALL +;; loaded project namespaces both on cider-nrepl and CIDER side. This list is +;; smaller than the one used by `ns-*` middleware. + +(def ^:private relevant-meta-keys + [:deprecated :macro :test :indent :style/indent :cider/instrumented + :orchard.trace/traced :orchard.profile/profiled]) + +(defn- compute-var-meta + "Return only metadata for a var that is relevant to track-state middleware. Add + `:fn true` for functions and multimethods. Infer `:style/indent` if missing. + This function accepts two caches - 'real' metadata WHM cache and the previous + computed ns-state. If the real metadata on a var hasn't changed, take the + computed metadata from the cache." + [^Var the-var, real-metadata-ns-cache old-ns-state] + (let [mta (get-metadata-if-changed? the-var real-metadata-ns-cache) + cached-computed-meta (when (nil? mta) + (get old-ns-state (.sym the-var)))] + (or cached-computed-meta + (let [mta (cond-> (or mta (meta the-var)) + (inferrable-indent? mta) indent/infer-style-indent) + ;; Most vars in the namespace are functions with no other relevant + ;; metadata, so having {:fn "true"} as shared literal improves + ;; both the computation speed and the occupied memory. + obj (var-get the-var) + start (if (and (or (fn? obj) (instance? MultiFn obj)) + (not (:macro mta))) + {:fn "true"} {})] + (reduce (fn [result k] + (let [val (k mta)] + (cond-> result val (assoc k (pr-str val))))) + start relevant-meta-keys))))) + +(defn- compute-var-metas-for-namespace + "Compute relevant metadata for all vars in the namespace." + [the-ns] + (let [ns-sym (ns-name the-ns) + old-project-ns-map (:interns (get *old-project-state* ns-sym)) + real-metadata-whm (when *real-metadata-cache* + (or (@*real-metadata-cache* ns-sym) + ((swap! *real-metadata-cache* assoc ns-sym + (WeakHashMap.)) ns-sym)))] + (reduce-kv (fn [acc sym the-var] + (if (and (var? the-var) + (not (identical? (.ns ^Var the-var) + clojure-core))) + (let [old-meta (get old-project-ns-map sym) + new-meta (compute-var-meta the-var real-metadata-whm + old-project-ns-map)] + (if (identical? old-meta new-meta) + acc + (assoc acc sym new-meta))) + acc)) + old-project-ns-map + (ns-map the-ns)))) + +(def clojure-core-map + (when clojure-core + {:aliases {} + :interns (into {} + (keep (fn [[k v]] + (when (var? v) + [k (compute-var-meta v nil {})]))) + (ns-map clojure-core))})) + +;;; Clojurescript part + +;; NB: must be bound for ClojureScript-related parts of the middleware to work! +(def ^:dynamic *cljs* nil) +(def ^:dynamic *all-cljs-namespaces* nil) (defn- cljs-meta-with-fn "Like (:meta m) but adds {:fn true} if (:fn-var m) is true, (:tag m) is @@ -91,24 +159,21 @@ (not (contains? m :tag))) (assoc :fn true))) -;;; Namespaces - (defn- remove-redundant-quote "Fixes double-quoted arglists coming from the ClojureScript analyzer." [{:keys [arglists] :as m}] (if (and (sequential? arglists) - (-> arglists first #{'quote})) + (= (first arglists) 'quote)) (assoc m :arglists (second arglists)) m)) (defn- uses-metadata - "Creates a var->metadata map for all the `:uses` of a given cljs ns. - - It accomplishes so by querying `all-cljs-namespaces`" - [all-cljs-namespaces uses] + "Creates a var->metadata map for all the `:uses` of a given cljs ns. It + accomplishes so by querying `*all-cljs-namespaces*`" + [uses] (into {} (map (fn [[var-name var-ns]] - (let [defs (some->> all-cljs-namespaces + (let [defs (some->> *all-cljs-namespaces* (filter (fn [x] (and (map? x) (= (:name x) @@ -133,12 +198,14 @@ [var-name {:arglists '([]) :macro true}]))) use-macros)) -(defn ns-as-map [object all-objects] +;;; Common part again + +(defn ns-state [object] (cond ;; Clojure Namespaces (instance? Namespace object) {:aliases (misc/update-vals ns-name (ns-aliases object)) - :interns (filter-core-and-get-meta (ns-map object))} + :interns (compute-var-metas-for-namespace object)} ;; ClojureScript Namespaces (associative? object) @@ -154,89 +221,17 @@ result))] {:aliases (merge require-macros requires) :interns (merge (post-process (misc/update-vals cljs-meta-with-fn defs)) - (post-process (uses-metadata all-objects uses)) + (post-process (uses-metadata uses)) (post-process (use-macros-metadata use-macros)) (post-process macros))}) - :else {})) + ;; Unresolved yet: resolve depending on the environment and recur. + (symbol? object) + (ns-state (if *cljs* + (cljs-ana/find-ns *cljs* object) + (find-ns object))) -(def clojure-core-map - (when clojure-core - {:aliases {} - :interns (into {} - (keep (fn [[k v]] - (when (var? v) - [k (um/relevant-meta (enriched-meta v))]))) - (ns-map clojure-core))})) - -(defn calculate-changed-ns-map - "Return a map of namespaces that changed between new-map and old-map. - new-map and old-map are maps from namespace names to namespace data, - which is the same format of map returned by this function. old-map - can also be nil, which is the same as an empty map." - [new-map old-map] - (into {} - (keep (fn [[the-ns-name data]] - (when-not (= (get old-map the-ns-name) data) - [the-ns-name data]))) - new-map)) - -;;; State management -(defn merge-used-aliases - "Return new-ns-map merged with all of its direct dependencies. - val-fn a function that returns namespace objects when called with - namespace names." - [^clojure.lang.PersistentHashMap new-ns-map - ^clojure.lang.PersistentHashMap old-ns-map - val-fn - all-namespaces] - (->> (vals new-ns-map) - (map :aliases) - (mapcat vals) - (reduce (fn [acc name] - (if (or (get acc name) - (get old-ns-map name)) - acc - (assoc acc name (ns-as-map (val-fn name) - all-namespaces)))) - new-ns-map))) - -(def ns-cache - "Cache of the namespace info that has been sent to each session. - Each key is a session. Each value is a map from namespace names to - data (as returned by `ns-as-map`)." - (agent {} - :error-handler - (fn [_ e] - (println "Exception updating the ns-cache" e)))) - -(defn fast-reduce - "Like (reduce f {} coll), but faster. - Inside f, use `assoc!` and `conj!` instead of `assoc` and `conj`." - [f coll] - (persistent! (reduce f (transient {}) coll))) - -(defn ensure-clojure-core-present - "Check if `old-ns-map` has clojure.core, else add it to - current-ns-map. If `cljs` we inject cljs.core instead. `cljs` is the - cljs environment grabbed from the message (if present)." - [old-ns-map project-ns-map cljs all-namespaces] - (cond - (and cljs (not (contains? old-ns-map 'cljs.core))) - (assoc project-ns-map 'cljs.core - (ns-as-map (cljs-ana/find-ns cljs 'cljs.core) - all-namespaces)) - - ;; we have cljs and the cljs core, nothing to do - cljs - project-ns-map - - ;; we've got core in old or new - (some #{clojure-core} (mapcat keys [old-ns-map project-ns-map])) - project-ns-map - - :else - (assoc project-ns-map clojure-core clojure-core-map))) + :else {})) (def ^:private jar-namespaces* (future @@ -252,70 +247,80 @@ (defn jar-namespaces [x] (contains? @jar-namespaces* x)) -(defn update-and-send-cache - "Send a reply to msg with state information assoc'ed. - old-data is the ns-cache that needs to be updated (the one - associated with `msg`'s session). Return the updated value for it. - This function has side-effects (sending the message)! - - Two extra entries are sent in the reply. One is the `:repl-type`, - which is either `:clj` or `:cljs`. - - The other is `:changed-namespaces`, which is a map from namespace - names to namespace data (as returned by `ns-as-map`). This contains - only namespaces which have changed since we last notified the - client. - - The 2-arity call is the intended way to use this function. - - The 4-arity call is provided for testing under mranderson. - Allows substitution of supporting fns in the implementation that - don't need to exposed otherwise. Be aware when the implementation - details change because this arity (and the tests) will need to - change also." - ([old-data msg] - (update-and-send-cache old-data msg - #'jar-namespaces - #'transport/send)) - ([old-data msg jar-ns-fn transport-send-fn] - (let [cljs (cljs/grab-cljs-env msg) - find-ns-fn (if cljs - #(cljs-ana/find-ns cljs %) - find-ns) - ;; See what has changed compared to the cache. If the cache - ;; was empty, everything is considered to have changed (and - ;; the cache will then be filled). - ns-name-fn (if cljs :name ns-name) - all-namespaces (if cljs - (vals (cljs-ana/all-ns cljs)) - (all-ns)) - project-ns-map (fast-reduce (fn [acc ns] - (let [name (ns-name-fn ns)] - (if (jar-ns-fn name) - acc ;; Remove all jar namespaces. - (assoc! acc name (ns-as-map ns all-namespaces))))) - all-namespaces) - project-ns-map (ensure-clojure-core-present old-data - project-ns-map - cljs - all-namespaces) - changed-ns-map (-> project-ns-map - ;; Add back namespaces that the project depends on. - (merge-used-aliases (or old-data {}) - find-ns-fn - all-namespaces) - (calculate-changed-ns-map old-data))] - (try - (->> (response-for - msg :status :state - :repl-type (if cljs :cljs :clj) - :changed-namespaces (util/transform-value changed-ns-map)) - (transport-send-fn (:transport msg))) - ;; We run async, so the connection might have been closed in - ;; the mean time. - (catch SocketException _ - nil)) - (merge old-data changed-ns-map)))) +(defn- initial-project-state [all-namespaces] + (let [cljs *cljs*] + (persistent! + (reduce (fn [acc ns] + (let [name (if cljs (:name ns) (ns-name ns))] + (if (jar-namespaces name) + acc ;; Remove all jar namespaces. + (assoc! acc name (ns-state ns))))) + (transient {}) + all-namespaces)))) + +(defn- add-core-namespace-vars [project-state] + (if *cljs* + (assoc project-state 'cljs.core (ns-state 'cljs.core)) + (assoc project-state 'clojure.core clojure-core-map))) + +(defn- merge-used-aliases + "Return project state merged with all of its direct dependencies." + [project-state] + (reduce-kv (fn [acc _ {:keys [aliases]}] + (reduce-kv (fn [acc _ ns-sym] + (if (contains? acc ns-sym) + acc + (assoc acc ns-sym (ns-state ns-sym)))) + acc aliases)) + project-state project-state)) + +(defn calculate-changed-project-state + "Return a map of namespaces that changed between new-project-state and + old-project-state. New and old state maps from namespace symbols to namespace + state, which is the same format of map returned by this function." + [new-project-state old-project-state] + (reduce-kv (fn [acc ns-sym ns-state] + (if-not (= ns-state (get old-project-state ns-sym)) + (assoc acc ns-sym ns-state) + acc)) + {} new-project-state)) + +;;; State management + +(defn- transport-send [transport msg] + ;; Only exists to be rebindable during testing. + (transport/send transport msg)) + +(defn calculate-changed-project-state-response + "Calculate changes in project state since we lasst notified the client. Response + is a map: + - `:repl-type` - either `:clj` or `:cljs` + - `:changed-namespaces` - a map of namespaces that have changed + + The previous value of project-state is taken from the session metadata. Once + the new value is computed, it has to be written into the session metadata. + Also take 'real metadata cache' from the session metadata (it is mutable)." + [{:keys [session] :as msg}] + (let [old-project-state (::project-state (meta session)) + real-metadata-cache (or (::metadata-cache (meta session)) + (::metadata-cache (alter-meta! session assoc ::metadata-cache (atom {})))) + cljs (cljs/grab-cljs-env msg) + all-namespaces (if cljs + (vals (cljs-ana/all-ns cljs)) + (all-ns))] + (binding [*cljs* cljs + *all-cljs-namespaces* (when cljs all-namespaces) + *old-project-state* old-project-state + *real-metadata-cache* real-metadata-cache] + (let [project-state (-> (initial-project-state all-namespaces) + add-core-namespace-vars + merge-used-aliases)] + (alter-meta! session assoc ::project-state project-state) + (let [delta (calculate-changed-project-state project-state old-project-state)] + (response-for msg + :status :state + :repl-type (if cljs :cljs :clj) + :changed-namespaces (util/transform-value delta))))))) ;;; Middleware (defn make-transport @@ -332,13 +337,12 @@ (send [_this {:keys [status] :as response}] (.send transport response) (when (contains? status :done) - (send ns-cache update-in [session] - update-and-send-cache msg))))) + (future + (transport-send transport (calculate-changed-project-state-response msg))))))) (defn handle-tracker [handler {:keys [op session] :as msg}] (cond - (= "cider/get-state" op) - (send ns-cache update-in [session] update-and-send-cache msg) + (= "cider/get-state" op) (calculate-changed-project-state-response msg) (mw/ops-that-can-eval op) (handler (assoc msg :transport (make-transport msg))) diff --git a/test/clj/cider/nrepl/middleware/track_state_test.clj b/test/clj/cider/nrepl/middleware/track_state_test.clj index 7bca2f44..f9695bf7 100644 --- a/test/clj/cider/nrepl/middleware/track_state_test.clj +++ b/test/clj/cider/nrepl/middleware/track_state_test.clj @@ -1,94 +1,23 @@ (ns cider.nrepl.middleware.track-state-test (:require [cider.nrepl.middleware.track-state :as sut] - [cider.nrepl.middleware.util.cljs :as cljs] - [cider.nrepl.middleware.util.meta :as um] - [clojure.test :refer :all]) - (:import - (nrepl.transport Transport))) - -(def some-ns-map {'cider.nrepl.middleware.track-state-test - (sut/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test) - (all-ns))}) - -;;; This is to prevent the agent from flooding test reports with -;;; irrelevant exceptions. -(set-error-handler! sut/ns-cache (constantly nil)) -(set-error-mode! sut/ns-cache :continue) - -(def msg {:session :dummy}) - -(deftest make-transport-test - (is (instance? Transport (sut/make-transport msg))) - (is (try (send (sut/make-transport msg) 10) - nil - (catch Exception e true)))) - -(defn update-and-send-cache-tester - "Use the other arity of sut/update-and-send-cache to evaluate - strictly in test mode." - [old-data msg sent-value] - (sut/update-and-send-cache old-data msg - #{} - (fn [t m] (reset! sent-value m)))) - -(deftest update-and-send-cache-test - (let [sent-value (atom nil)] - (let [new-data (update-and-send-cache-tester nil msg sent-value)] - (is (map? new-data)) - (is (< 100 (count new-data)))) - (let [{:keys [repl-type changed-namespaces]} @sent-value] - (is (= :clj repl-type)) - (is (map? changed-namespaces)) - (is (< 100 (count changed-namespaces)))) - (let [full-cache (update-and-send-cache-tester nil msg sent-value) - get-sent-value (fn [old] (update-and-send-cache-tester old msg sent-value) - @sent-value)] - ;; Return value depends only on the current state. - (is (= (update-and-send-cache-tester nil msg sent-value) - (update-and-send-cache-tester (into {} (take 5 full-cache)) msg sent-value) - (update-and-send-cache-tester full-cache msg sent-value))) - ;; Sent message depends on the first arg. - (is (= (get-sent-value full-cache) - (get-sent-value full-cache))) - (is (= (get-sent-value (into {} (drop 3 full-cache))) - (get-sent-value (into {} (drop 3 full-cache)))))) - ;; In particular, the sent message only contains the diff. - - (let [changed-again (:changed-namespaces @sent-value)] - (is (map? changed-again)) - (is (= 3 (count changed-again)))) - ;; Check repl-type :cljs - - (with-redefs [cljs/grab-cljs-env (constantly true)] - (update-and-send-cache-tester nil msg sent-value) - (let [{:keys [repl-type changed-namespaces]} @sent-value] - (is (= :cljs repl-type)) - (is (map? changed-namespaces)))))) + [cider.nrepl.test-session :as session] + [cider.test-helpers :refer :all] + [clojure.test :refer [deftest is testing]] + [matcher-combinators.matchers :as matchers] + [nrepl.core :as nrepl] + [nrepl.misc])) + +(def some-ns-map + (delay {'cider.nrepl.middleware.track-state-test + (with-bindings* {#'sut/*real-metadata-cache* (atom {})} ;; [@ (atom {})] + #(#'sut/ns-state (find-ns 'cider.nrepl.middleware.track-state-test)))})) (def ^:private fn-test-var nil) (def ^:private fn-test-def-fn (fn [])) (defn- fn-test-defn-fn []) (defmulti fn-test-multi (fn [x])) -(deftest filter-core-and-get-meta-test - (is (= (sut/filter-core-and-get-meta {'and #'and, 'b #'map, 'c #'deftest}) - '{c {:macro "true" - :arglists "([name & body])" - :fn "true" - :doc "\"Defines a test function with no arguments. Test functions may call\\n other tests, so tests may be composed. If you compose tests, you\\n should also define a function named test-ns-hook; run-tests will\\n call test-ns-hook instead of testing all vars.\\n\\n Note: Actually, the test body goes in the :test metadata on the var,\\n and the real function (the value of the var) calls test-var on\\n itself.\\n\\n When *load-tests* is false, deftest is ignored.\""}})) - (is (= [nil "true" "true" "true"] - (map (comp :fn - (sut/filter-core-and-get-meta - {'fn-test-var #'fn-test-var - 'fn-test-def-fn #'fn-test-def-fn - 'fn-test-defn-fn #'fn-test-defn-fn - 'fn-test-multi #'fn-test-multi})) - '[fn-test-var fn-test-def-fn fn-test-defn-fn fn-test-multi]))) - (is (-> (find-ns 'clojure.core) - ns-map sut/filter-core-and-get-meta - seq not))) - (defn- test-fn "docstring" ([a b] nil) ([a] nil) @@ -96,34 +25,22 @@ (defmacro test-macro [a & body]) -(deftest ns-as-map-test - (is (empty? (sut/ns-as-map nil (all-ns)))) - (let [m (meta #'make-transport-test)] - ;; #'make-transport refers to the deftest, and not the defn - (->> (interleave um/relevant-meta-keys (range)) - (apply hash-map) - (alter-meta! #'make-transport-test merge)) - ;; note: this test inspects the current namespace, so the - ;; test conditions below may change as the namespace declaration - ;; evolves. - (let [{:keys [interns aliases] :as ns} - (sut/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test) - (all-ns))] - (is (< 5 (count interns))) - (is (map? interns)) - (is (interns 'ns-as-map-test)) - (is (:test (interns 'ns-as-map-test))) - (is (= (into #{} (keys (interns 'make-transport-test))) - (into #{} um/relevant-meta-keys))) - (is (= 3 (count aliases))) - (is (= 'cider.nrepl.middleware.track-state (aliases 'sut)))) - (alter-meta! #'make-transport-test (fn [x y] y) m)) - (let [{:keys [interns aliases] :as ns} - (sut/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test) - (all-ns))] - (is interns))) - -(deftest ns-as-map-cljs-test +(deftest ns-state-clj-test + (is+ '{:aliases {sut cider.nrepl.middleware.track-state + matchers matcher-combinators.matchers} + :interns {test-fn {:fn "true"} + testing {:macro "true"} + macro-without-style-indent-1 {:macro "true", :style/indent "1"} + is {:macro "true"} + is+ {:macro "true"} + fn-test-multi {:fn "true"} + deftest {:macro "true"} + fn-test-def-fn {:fn "true"} + fn-test-var {} + test-macro {:macro "true", :style/indent "1"}}} + (sut/ns-state (find-ns 'cider.nrepl.middleware.track-state-test)))) + +(deftest ns-state-cljs-test (let [cljs-ns {:use-macros {'test-fn 'cider.nrepl.middleware.track-state-test 'test-macro 'cider.nrepl.middleware.track-state-test} @@ -152,87 +69,83 @@ :requires {'sym-3 'some-namespace}} other-namespaces [{:name 'some-other-cljs-ns :defs {'sym-1 {:meta {:arglists '([] [a] [a b])}}}}] - {:keys [aliases interns]} (sut/ns-as-map cljs-ns other-namespaces)] - (is (any? (sut/ns-as-map (dissoc cljs-ns :macros :require-macros :use-macrps) - other-namespaces)) - "Doesn't throw exceptions in the absence of optional keys") - (is (= '{sym-2 some-namespace sym-3 some-namespace} aliases)) - (is (= '{a-fn {:fn "true"}, - b-fn {:fn "true"}, - c-fn {:fn "true"}, - d-fn {:fn "true"}, - a-var {}, - ;; fetched by traversing `other-namespaces`: - sym-1 {:arglists "([] [a] [a b])"}, - ;; fetched by inspecting the JVM clojure environment: - test-fn {:arglists "([a b] [a] [])", :doc "\"docstring\""} - ;; adds :style/indent despite it not being originally present: - test-macro {:macro "true", :arglists "([a & body])", :style/indent "1"} - ;; :style/indent is preserved: - from-macros-with-style-indent {:macro "true", :arglists "([& args])", :style/indent ":defn"}, - ;; :style/indent is inferred: - from-macros-without-style-indent {:macro "true", :arglists "([& args])", :style/indent "0"}} - interns)))) + {:keys [aliases interns]} (sut/ns-state cljs-ns)] + (binding [sut/*all-cljs-namespaces* other-namespaces] + (let [{:keys [aliases interns]} (sut/ns-state cljs-ns)] + (is (any? (sut/ns-state (dissoc cljs-ns :macros :require-macros :use-macros))) + "Doesn't throw exceptions in the absence of optional keys") + (is (= '{sym-2 some-namespace sym-3 some-namespace} aliases)) + (is (= '{a-fn {:fn "true"}, + b-fn {:fn "true"}, + c-fn {:fn "true"}, + d-fn {:fn "true"}, + a-var {}, + ;; fetched by traversing `other-namespaces`: + sym-1 {:arglists "([] [a] [a b])"}, + ;; fetched by inspecting the JVM clojure environment: + test-fn {:arglists "([a b] [a] [])", :doc "\"docstring\""} + ;; adds :style/indent despite it not being originally present: + test-macro {:macro "true", :arglists "([a & body])", :style/indent "1"} + ;; :style/indent is preserved: + from-macros-with-style-indent {:macro "true", :arglists "([& args])", :style/indent ":defn"}, + ;; :style/indent is inferred: + from-macros-without-style-indent {:macro "true", :arglists "([& args])", :style/indent "0"}} + interns)))))) (deftest calculate-used-aliases-test - (is (contains? (sut/merge-used-aliases some-ns-map nil ns-name (all-ns)) - 'cider.nrepl.middleware.track-state)) - (is (contains? (sut/merge-used-aliases some-ns-map {'cider.nrepl.middleware.track-state nil} ns-name (all-ns)) - 'cider.nrepl.middleware.track-state)) - (is (contains? (sut/merge-used-aliases (assoc some-ns-map 'cider.nrepl.middleware.track-state nil) nil ns-name (all-ns)) + (is (contains? (#'sut/merge-used-aliases @some-ns-map) 'cider.nrepl.middleware.track-state))) (deftest ensure-clojure-core-present (testing "if clojurescript doesn't add clojure" - ;; note that the {:msg :stuff} object is much more complex in - ;; actual use and in fact the msg is much more complicated - (is (-> (sut/ensure-clojure-core-present {} - {'cljs.core :present} - {:msg :stuff} - (all-ns)) - keys - #{sut/clojure-core} - not))) - (testing "if core already present doesn't overwrite or add" - (is (= :present - (-> (sut/ensure-clojure-core-present {} - {sut/clojure-core :present} - nil - (all-ns)) - (get sut/clojure-core))))) + (binding [sut/*cljs* true] + (is (not (contains? (#'sut/add-core-namespace-vars {}) 'clojure.core))))) (testing "if core missing and not cljs, it adds it" - (is (= sut/clojure-core-map - (-> (sut/ensure-clojure-core-present {} {} nil (all-ns)) - (get sut/clojure-core)))))) + (is (contains? (#'sut/add-core-namespace-vars {}) 'clojure.core)))) (defmacro macro-without-style-indent-1 [opts & body]) (defmacro macro-without-style-indent-2 [opts body]) (defmacro macro-without-style-indent-3 [opts baddy]) (defmacro macro-with-explicitly-nil-style-indent {:style/indent nil} [opts & body]) -(def mock-msg (reify nrepl.transport/Transport - (recv [this]) - (recv [this timeout]) - (send [this msg]))) - (deftest indentation-inference-test (testing "Adds `:style/indent` metadata when it's suitable to do so" - (let [cache (sut/update-and-send-cache nil - {:transport mock-msg}) - interns (-> cache - (get 'cider.nrepl.middleware.track-state-test) - :interns)] - (is (= "1" - (-> interns (get 'macro-without-style-indent-1) :style/indent))) - (is (= "1" - (-> interns (get 'macro-without-style-indent-2) :style/indent))) - (is (= nil - (-> interns (get 'macro-without-style-indent-3) :style/indent))) - (is (= nil - (-> interns (get 'macro-with-explicitly-nil-style-indent) :style/indent)))))) + (is+ {"interns" {"macro-without-style-indent-1" {"style/indent" "1"} + "macro-without-style-indent-2" {"style/indent" "1"} + "macro-without-style-indent-3" {"style/indent" matchers/absent} + "macro-with-explicitly-nil-style-indent" {"style/indent" matchers/absent}}} + (-> (sut/calculate-changed-project-state-response {:session (atom {})}) + (get-in [:changed-namespaces "cider.nrepl.middleware.track-state-test"]))))) (deftest inferrable-indent?-test (testing "clojure.* macros are not inferrable" (is (#'sut/inferrable-indent? (meta #'macro-without-style-indent-1))) (is (not (#'sut/inferrable-indent? (meta #'defn)))) (is (not (#'sut/inferrable-indent? (meta #'deftest)))))) + +(defn- message-and-state [msg] + (last ((#'nrepl/delimited-transport-seq + session/*session* #{"state" :state} {:id (nrepl.misc/uuid)}) msg))) + +(deftest integration-test + (session/session-fixture + (fn [] + (is+ {:changed-namespaces {:cider.nrepl.middleware.track-state-test + {:interns #(> (count %) 10)}}} + (message-and-state {:op "eval" + :code "(+ 1 2)"})) + + (testing "subsequent evaluation reports empty changed state" + (is+ {:changed-namespaces empty?} + (message-and-state {:op "eval" + :code "(+ 1 2)"}))) + + (testing "modifying metadata reports just updates to that var" + (is+ {:changed-namespaces + (matchers/all-of #(= (count %) 1) + {:cider.nrepl.middleware.track-state-test + {:interns {:fn-test-defn-fn {:fn "true" :deprecated "true"}}}})} + (message-and-state {:op "eval" + :code "(alter-meta! #'cider.nrepl.middleware.track-state-test/fn-test-defn-fn assoc :deprecated true)"}))) + ;; Restore + (alter-meta! #'cider.nrepl.middleware.track-state-test/fn-test-defn-fn dissoc :deprecated))))