(ns clj-kondo.impl.analyzer {:no-doc true} (:refer-clojure :exclude [ns-name]) (:require [babashka.fs :as fs] [clj-kondo.impl.analysis :as analysis] [clj-kondo.impl.analyzer.babashka :as babashka] [clj-kondo.impl.analyzer.clojure-data-xml :as xml] [clj-kondo.impl.analyzer.common :refer [common]] [clj-kondo.impl.analyzer.compojure :as compojure] [clj-kondo.impl.analyzer.core-async :as core-async] [clj-kondo.impl.analyzer.datalog :as datalog] [clj-kondo.impl.analyzer.jdbc :as jdbc] [clj-kondo.impl.analyzer.match :as match] [clj-kondo.impl.analyzer.namespace :as namespace-analyzer :refer [analyze-ns-decl]] [clj-kondo.impl.analyzer.potemkin :as potemkin] [clj-kondo.impl.analyzer.re-frame :as re-frame] [clj-kondo.impl.analyzer.spec :as spec] [clj-kondo.impl.analyzer.test :as test] [clj-kondo.impl.analyzer.usages :as usages :refer [analyze-usages2]] [clj-kondo.impl.cache :as cache] [clj-kondo.impl.config :as config] [clj-kondo.impl.docstring :as docstring] [clj-kondo.impl.findings :as findings] [clj-kondo.impl.gen-macros :as gen-macros] [clj-kondo.impl.hooks :as hooks] [clj-kondo.impl.linters :as linters] [clj-kondo.impl.linters.config :as lint-config] [clj-kondo.impl.linters.deps-edn :as deps-edn] [clj-kondo.impl.linters.keys :as key-linter] [clj-kondo.impl.macroexpand :as macroexpand] [clj-kondo.impl.metadata :as meta] [clj-kondo.impl.namespace :as namespace :refer [resolve-name]] [clj-kondo.impl.parser :as p] [clj-kondo.impl.rewrite-clj.node.seq :as seq] [clj-kondo.impl.rewrite-clj.node.token :as token] [clj-kondo.impl.rewrite-clj.reader :refer [*reader-exceptions* *reader-features*]] [clj-kondo.impl.schema :as schema] [clj-kondo.impl.types :as types] [clj-kondo.impl.types.utils :as types-utils] [clj-kondo.impl.utils :as utils :refer [assoc-some ctx-with-bindings linter-disabled? node->line one-of parse-string select-lang sexpr string-from-token symbol-call tag assoc-new some']] [clojure.java.io :as io] [clojure.set :as set] [clojure.string :as str] [sci.core :as sci])) (set! *warn-on-reflection* true) (declare analyze-expression**) (defn analyze-children ([ctx children] (analyze-children ctx children true)) ([{:keys [callstack config top-level?] :as ctx} children add-new-arg-types?] (let [top-level? (and top-level? (let [fst (first callstack)] (one-of fst [[clojure.core comment] [cljs.core comment] [clojure.core do] [cljs.core do] [clojure.core let] [cljs.core let]])))] (when-not (and (:in-comment ctx) (:skip-comments config)) (let [len (count children) ctx (-> ctx (assoc-new :top-level? top-level?) (assoc-new :arg-types (if add-new-arg-types? (let [[k v] (first callstack)] (when (and (symbol? k) (symbol? v)) (atom []))) (:arg-types ctx))) (assoc-new :len len))] (into [] (comp (map-indexed (fn [i e] (analyze-expression** (assoc ctx :idx i) e))) cat) children)))))) (defn or-entry-key "How the key of an :or entry reads: {:sym s} for a binding name, {:key k} for a literal map key (Clojure 1.13). The :or map is data, so nil and false are keys like any other. Nil for a key we can't read, e.g. [:x]." [ctx k] (if (and (identical? :token (tag k)) (symbol? (:value k))) {:sym (:value k)} (let [mk (types/map-key ctx k)] (when (types/known-map-key? mk) {:key mk})))) (defn or-entry-target "The entry of `form-keys` an :or entry addresses, nil when it addresses nothing we know. A symbol names a binding, anything else is a key." [{:keys [sym key]} form-keys] (if sym (when-let [e (find (:names form-keys) sym)] (find (:keys form-keys) (val e))) (find (:keys form-keys) key))) (defn analyze-keys-destructuring-defaults [ctx prev-ctx m defaults opts] (let [;; every key the form reads, see form-keys form-keys (:form-keys opts) ;; :all, :select and :defaults all bind the applied defaults defaults-read? (:defaults-read opts) mark-used? (or (:skip-reg-binding? ctx) (:mark-bindings-used? ctx) (when (:fn-args? opts) (-> ctx :config :linters :unused-binding :exclude-destructured-keys-in-fn-args))) undefined-locals (set (keys m)) seen (volatile! #{})] (doseq [[k v] (partition 2 (:children defaults))] (let [entry (or-entry-key ctx k) sym (:sym entry) target (when entry (or-entry-target entry form-keys)) {:keys [bindings required]} (some-> target val) mta (meta k)] (when-not mark-used? (cond (and (seq bindings) (not defaults-read?)) ;; one default, however many bindings read the key (namespace/reg-destructuring-default! ctx mta bindings) ;; the entry is fine: the key is read, or the binding exists and ;; only the key it reads is unreadable (or target (and sym (contains? m sym))) nil ;; a key we can't read claims nothing, in either direction entry (findings/reg-finding! ctx {:message (str k " is not bound in this destructuring form") :level :warning :row (:row mta) :col (:col mta) :end-row (:end-row mta) :end-col (:end-col mta) :filename (:filename ctx) :type :unbound-destructuring-default}))) (when required (findings/reg-finding! ctx {:message (if-let [b (first (filter :required bindings))] (str "Can't supply default value for required binding: " (:name b)) (str "Can't supply default value for required key: " (pr-str (key target)))) :row (:row mta) :col (:col mta) :end-row (:end-row mta) :end-col (:end-col mta) :filename (:filename ctx) :type :syntax})) ;; a name and a literal key for one key are two defaults. An entry that ;; addresses nothing is already reported, it needs no identity (when target (if (contains? @seen (key target)) (findings/reg-finding! ctx (node->line (:filename ctx) k :duplicate-map-key (str "Multiple :or defaults for same key: " k))) (vswap! seen conj (key target)))) (if (= k v) ;; see #915 (analyze-expression** prev-ctx v) (do (when (and (simple-symbol? sym) (:analyze-locals? ctx) (not (:clj-kondo/mark-used k))) (let [expr-meta (meta k) expr-meta (assoc-some expr-meta :name-row (:row expr-meta) :name-col (:col expr-meta) :name-end-row (:end-row expr-meta) :name-end-col (:end-col expr-meta) :name sym :filename (:filename ctx) :str (:string-value k))] (analysis/reg-local-usage! ctx (:filename ctx) (get (:bindings ctx) sym) expr-meta))) (let [ctx (assoc ctx :undefined-locals undefined-locals :in-or-default? true)] (analyze-expression** ctx v)))))))) (defn lift-meta-content* "Used within extract-bindings. Disables unresolved symbols while linting metadata." [{:keys [lang] :as ctx} expr] (meta/lift-meta-content2 (if (= :cljs lang) (utils/ctx-with-linter-disabled ctx :unresolved-symbol) ctx) expr)) (defn scope-end "Used within extract-bindings. Extracts the end postion of the scoped-expr for the binding." [scoped-expr] (some-> scoped-expr meta (select-keys [:end-row :end-col]) (set/rename-keys {:end-row :scope-end-row :end-col :scope-end-col}))) (defn analyze-binding-vector [ctx children] (let [as-kw? (fn [n] (and (= :as (:k n)) (not (:namespaced? n)))) rest-param+ (when (some' #(= '& (:value %)) children) (into [] (drop-while #(not= '& (:value %))) children)) varargs (when rest-param+ (into [] (take-while (complement as-kw?)) rest-param+)) as-args (when (some' as-kw? children) (into [] (drop-while (complement as-kw?)) children))] (cond (and (< 1 (count varargs)) (= '& (:value (second varargs)))) (findings/reg-finding! ctx (node->line (:filename ctx) (second varargs) :syntax "Invalid binding: &")) (and (< 1 (count as-args)) (= '& (:value (second as-args)))) (findings/reg-finding! ctx (node->line (:filename ctx) (second as-args) :syntax "Invalid binding: &")) (< 2 (count varargs)) (findings/reg-finding! ctx (node->line (:filename ctx) (nth varargs 2) :syntax (str "Only one varargs binding allowed but got: " (str/join ", " (rest varargs))))) (= 1 (count varargs)) (findings/reg-finding! ctx (node->line (:filename ctx) (first varargs) :syntax "Trailing & in binding form")) (< 2 (count as-args)) (findings/reg-finding! ctx (node->line (:filename ctx) (nth as-args 2) :syntax (str "Only one :as binding allowed but got: " (str/join ", " (rest as-args))))) (= 1 (count as-args)) (findings/reg-finding! ctx (node->line (:filename ctx) (first as-args) :syntax "Trailing :as in binding form"))))) ;; must produce the same keys as types/map-key does for call-site map literals (defn- destructuring-key [ctx modifier-ns modifier-type entry] (let [entry-name (or (:value entry) (:k entry))] (when entry-name (let [nm (name entry-name)] (case modifier-type (:keys :keys!) (if (or (:namespaced? entry) (namespace entry-name)) (let [resolved (usages/resolve-keyword ctx entry (-> ctx :ns :name)) ns (:ns resolved)] (when-not (identical? :clj-kondo/unknown-namespace ns) (keyword (some-> ns str) (name (:name resolved))))) (keyword (some-> modifier-ns str) nm)) ;; symbol keys are never alias-resolved, unlike :keys! entries (:syms :syms!) (if-let [ens (namespace entry-name)] (symbol ens nm) (symbol (some-> modifier-ns str) nm)) (:strs :strs!) nm nil))))) (defn- destructuring-keys [ctx modifier-node modifier-type entries] (let [modifier-ns (:ns (usages/resolve-keyword ctx modifier-node (-> ctx :ns :name)))] (when-not (identical? :clj-kondo/unknown-namespace modifier-ns) (first (reduce (fn [[m amp?] entry] (cond (= '& (:value entry)) [m true] ;; after & the entry is the key as written, the ;; :keys/:strs/:syms reading does not apply amp? (let [k (types/map-key ctx entry)] [(cond-> m (types/known-map-key? k) (assoc k :any)) amp?]) :else (if-let [k (destructuring-key ctx modifier-ns modifier-type entry)] [(assoc m k :any) amp?] [m amp?]))) [{} false] entries))))) (declare extract-bindings) (defn node-contains-or? "Whether a destructuring form has an :or directive at any depth. Over-matches :or in other positions, which callers accept." [node] (or (and (= :or (:k node)) (not (:namespaced? node))) (some node-contains-or? (:children node)))) (defn all-tag "Tag for an :all binding: the init's map type, with the keys that only an :or default provides and the nested forms that apply their own defaults added. Plain :map when the init's type can't be augmented, nil when it says nothing." [ctx form-tag defaults nested-keys] (let [defaulted (into {} (keep (fn [[dk node]] ;; the init's own key wins over the default (when-not (contains? (:val form-tag) dk) (let [t (types/expr->tag ctx node)] ;; A nil default adds no key. :or works on the presence ;; of a key, not its value, and a key mapped to nil is ;; not a missing key, so :all and :select merge the ;; defaults through some-vals, which drops them. ;; Confirmed upstream (when-not (identical? :nil t) [dk (if t {:tag t} {})]))))) defaults) ;; a nested form applies its own defaults, so only its mapness holds additions (into defaulted (map (fn [k] [k {:tag :map}])) nested-keys)] (cond (empty? additions) form-tag (identical? :map (:type form-tag)) (update form-tag :val merge additions) form-tag :map))) (defn extract-map-bindings [ctx expr scoped-expr opts] (let [;; in a namespaced map the reader qualifies :as, :or and :select, ;; which Clojure rejects as map directives plain-directive? (if (:namespaced-map opts) (fn [_ _] false) (fn [k kw] (and (= kw (:k k)) (not (:namespaced? k))))) ;; inference is the only consumer of the key-bindings ;; collection, other linters do read binding tags types-off? (linter-disabled? ctx :type-mismatch) ;; the init's tag types each destructured binding, see ;; types/destructured-key-tag. :tag must not leak to children ;; wholesale form-tag (:tag opts) opts (dissoc opts :allow-amp :namespaced-map :tag) kvs (partition 2 (:children expr)) select? (some (fn [[k _]] (plain-directive? k :select)) kvs) or? (some (fn [[k _]] (plain-directive? k :or)) kvs) all? (some (fn [[k _]] (plain-directive? k :all)) kvs) ;; :all, :select and :defaults all bind the applied :or defaults. :all ;; and :select reach through nested forms too, :defaults does not defaults-read-deep? (or all? select? (:defaults-read-deep opts)) defaults-read? (or defaults-read-deep? (some (fn [[k _]] (plain-directive? k :defaults)) kvs)) ;; the default per binding name or literal key, to type what :all adds. ;; Tagged like default-id, a name and a symbol key are not the same key or-defaults (when (and all? or?) (into {} (comp (filter (fn [[k _]] (plain-directive? k :or))) (mapcat (fn [[_ v]] (partition 2 (:children v)))) (keep (fn [[k v]] (when-let [e (or-entry-key ctx k)] [(if (contains? e :sym) [:sym (:sym e)] [:key (:key e)]) v])))) kvs)) [req sel] (reduce (fn [[req sel] [k v]] (let [key-name (some-> (:k k) name keyword)] (cond (one-of key-name [:keys! :syms! :strs!]) (let [ks (destructuring-keys ctx k key-name (:children v))] [(merge req ks) (merge sel ks)]) (not select?) [req sel] (one-of key-name [:keys :syms :strs]) [req (merge sel (destructuring-keys ctx k key-name (:children v)))] ;; k is a binding form, v its lookup key (nil? key-name) [req (let [mk (types/map-key ctx v)] (if (types/known-map-key? mk) (assoc sel mk :any) sel))] :else [req sel]))) [{} {}] kvs)] (key-linter/lint-map-keys ctx expr) ;; [map-key binding defaulted] per destructured entry, for backward ;; param-type inference, see inferable-params. A binding with an ;; :or default never proves its key required (let [key-bindings (volatile! []) ;; the :all binding is extracted after the loop, its type needs the ;; keys of the whole form all-node (volatile! nil) nested-keys (volatile! []) ;; Every key the form reads, the one thing :or is checked against: ;; {:keys {key {:bindings [b ..] :required bool}} :names {name key}}. ;; :bindings is empty for a key after & and for a nested form. A key ;; we can't read never enters, so nothing is claimed about it form-keys (when or? (volatile! {:keys {} :names {}})) note-key! (fn [mk b required] (some-> form-keys (vswap! (fn [fk] (cond-> (update-in fk [:keys mk :required] #(or % required)) b (update-in [:keys mk :bindings] (fnil conj []) b) b (assoc-in [:names (:name b)] mk)))))) or-key-nodes (when (and or? (not types-off?)) (into [] (comp (filter (fn [[k _]] (plain-directive? k :or))) (mapcat (fn [[_ v]] (take-nth 2 (:children v))))) kvs)) or-names (into #{} (keep (fn [k] (let [v (:value k)] (when (simple-symbol? v) v)))) or-key-nodes) or-keys (into #{} (keep (fn [k] (when (types/static-map-key? ctx k) (let [mk (types/map-key ctx k)] (when (types/known-map-key? mk) mk))))) or-key-nodes) defaulted? (fn [binding-name map-key] (or (contains? or-names binding-name) (contains? or-keys map-key)))] (loop [[k v & rest-kvs] (:children expr) res {}] (if k (let [k (lift-meta-content* ctx k)] (cond (:k k) (let [key-name (keyword (name (:k k))) ns-modifier? (one-of key-name [:keys :syms :strs :keys! :syms! :strs! ;; TODO: restrict this to language :cljd :flds])] (if ns-modifier? (do (usages/analyze-keyword ctx k (assoc opts :keys-destructuring-ns-modifier? true)) (let [opts (assoc opts :keys-destructuring? true :destructuring-type key-name :destructuring-expr k) modifier-ns (when (or or? (not types-off?)) (:ns (usages/resolve-keyword ctx k (-> ctx :ns :name)))) required-keys? (one-of key-name [:keys! :syms! :strs!]) ;; before & are bindings, after & only literal keys res (loop [children (:children v) amp? false res res] (if-let [child (first children)] (cond (= '& (:value child)) (do (when amp? (findings/reg-finding! ctx (node->line (:filename ctx) child :syntax "& can only appear once in map destructuring"))) (recur (next children) true res)) amp? (do (cond (symbol? (:value child)) (findings/reg-finding! ctx (node->line (:filename ctx) child :syntax (str "Binding symbols can only appear before &, use keys after: " (:value child)))) :else (do (when (:k child) (usages/analyze-keyword ctx child opts)) ;; after & the entry is the key itself, the ;; :keys/:strs/:syms reading does not apply (let [mk (types/map-key ctx child)] (when (types/known-map-key? mk) (note-key! mk nil required-keys?))))) (recur (next children) true res)) :else (let [dk (when-not (identical? :clj-kondo/unknown-namespace modifier-ns) (destructuring-key ctx modifier-ns key-name child)) bname (or (some-> (:value child) name symbol) (some-> (:k child) name symbol)) child-opts (if-let [vt (when dk (types/destructured-key-tag form-tag dk (defaulted? bname dk)))] (assoc opts :tag vt) opts) bnds (extract-bindings ctx child scoped-expr child-opts)] (when dk (when-let [b (some-> bnds first val)] (vswap! key-bindings conj [dk b (defaulted? (:name b) dk)]) (note-key! dk b required-keys?))) (recur (next children) false (merge res bnds)))) res))] (recur rest-kvs res))) (do (usages/analyze-keyword ctx k) (case key-name :or ;; or doesn't introduce new bindings, it only gives defaults (cond (not (plain-directive? k :or)) (recur rest-kvs res) (empty? rest-kvs) ;; or can refer to a binding introduced by what we extracted (let [prev-ctx ctx ctx (ctx-with-bindings ctx res)] (analyze-keys-destructuring-defaults ctx prev-ctx res v (assoc opts :form-keys (some-> form-keys deref) :defaults-read defaults-read?)) (recur rest-kvs res)) :else ;; analyze or after the rest (let [;; prevent infinite loop with multiple :or rest-kvs (remove #(plain-directive? % :or) rest-kvs)] (recur (concat rest-kvs [k v]) res))) ;; the :as binding is the whole init :as (let [as-opts (if form-tag (assoc opts :tag form-tag) opts)] (cond (not (plain-directive? k :as)) (recur rest-kvs res) (-> ctx :config :linters :unused-binding :exclude-destructured-as) (recur rest-kvs (merge res (extract-bindings (assoc ctx :mark-bindings-used? true) v scoped-expr as-opts))) :else (recur rest-kvs (merge res (extract-bindings ctx v scoped-expr as-opts))))) ;; Clojure 1.13: :all is the init with the :or ;; defaults applied, also those of nested forms :all (do (when (plain-directive? k :all) (vreset! all-node v)) (recur rest-kvs res)) ;; Clojure 1.13: binds a map with the keys named in this form :select (if (plain-directive? k :select) (recur rest-kvs (merge res (extract-bindings ctx v scoped-expr (assoc opts :tag {:type :map :val (update-vals sel (fn [t] {:tag t}))})))) (recur rest-kvs res)) ;; Clojure 1.13 CLJ-2966: binds a map of the applied :or defaults :defaults (if (plain-directive? k :defaults) (do (when-not or? (findings/reg-finding! ctx (node->line (:filename ctx) k :syntax "Can't specify :defaults without :or"))) (recur rest-kvs (merge res (extract-bindings ctx v scoped-expr opts)))) (recur rest-kvs res)) (recur rest-kvs res))))) :else ;; k is a binding form, v its lookup key (let [mk (types/map-key ctx v) known-key? (types/known-map-key? mk) child-opts (cond-> opts defaults-read-deep? (assoc :defaults-read-deep true)) child-opts (if-let [vt (when known-key? (types/destructured-key-tag form-tag mk (defaulted? (:value k) mk)))] (assoc child-opts :tag vt) child-opts) bnds (extract-bindings ctx k scoped-expr child-opts)] (when (and all? known-key? (identical? :map (tag k)) (node-contains-or? k)) (vswap! nested-keys conj mk)) (when known-key? (let [b (when (utils/symbol-token? k) (some-> bnds first val))] (when b (vswap! key-bindings conj [mk b (defaulted? (:name b) mk)])) ;; a nested form reads the key without binding a name (note-key! mk b nil))) (recur rest-kvs (merge res bnds {:analyzed (analyze-expression** ctx v)}))))) (let [res (if-let [all-expr @all-node] (let [;; a default reaches its key by name or by the key ;; itself, both lead to the same entry defaults (when or-defaults (into {} (keep (fn [[mk {:keys [bindings]}]] (when-let [d (or (some #(get or-defaults [:sym (:name %)]) bindings) (get or-defaults [:key mk]))] [mk d]))) (some-> form-keys deref :keys))) t (when-not types-off? (all-tag ctx form-tag defaults @nested-keys)) all-opts (if t (assoc opts :tag t) opts) ctx (cond-> ctx (-> ctx :config :linters :unused-binding :exclude-destructured-as) (assoc :mark-bindings-used? true))] (merge res (extract-bindings ctx all-expr scoped-expr all-opts))) res)] (cond-> res (seq req) (vary-meta assoc :keys-spec {:op :keys :req req}) (seq @key-bindings) (vary-meta assoc :key-bindings @key-bindings)))))))) (defn extract-bindings ([ctx expr] (extract-bindings ctx expr expr {})) ([ctx expr scoped-expr opts] (when expr (utils/handle-ignore ctx expr) (let [fn-args? (:fn-args? opts) keys-destructuring? (:keys-destructuring? opts) expr (lift-meta-content* ctx expr) t (tag expr) mark-used? (or (:mark-bindings-used? ctx) (let [unused-binding-cfg (-> ctx :config :linters :unused-binding)] (or (when (and keys-destructuring? fn-args?) (-> unused-binding-cfg :exclude-destructured-keys-in-fn-args)) (and (:defmulti? ctx) (-> unused-binding-cfg :exclude-defmulti-args)) (identical? :off (:level unused-binding-cfg))))) ctx (cond-> ctx mark-used? (assoc :mark-bindings-used? mark-used?)) only-arity-analysis (:skip-reg-binding? ctx)] (case t :token (cond ;; symbol (utils/symbol-token? expr) (let [sym (:value expr)] (when (one-of (:destructuring-type opts) [:keys :keys!]) (usages/analyze-keyword ctx expr opts)) (when-not only-arity-analysis (when-let [fn-dupes (:fn-dupes ctx)] (when (and (contains? @fn-dupes sym) (not= '_ sym) (not= '& sym)) (findings/reg-finding! ctx (assoc (meta expr) :type :shadowed-fn-param :filename (:filename ctx) :message (str "Shadowed fn param: " sym)))) (swap! fn-dupes conj sym))) (if (= '& sym) (when-not (:allow-amp opts) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax "Invalid binding: &"))) (let [ns (namespace sym) valid? (or (not ns) keys-destructuring?)] (if valid? (let [s (symbol (name sym)) m (meta expr) t (or (types/tag-from-meta (:tag m)) (:tag opts)) v (utils/binding-rec m {:name s :filename (:filename ctx) :tag t :auto-resolved (:namespaced? expr)}) v (cond-> v (one-of (:destructuring-type opts) [:keys! :syms! :strs!]) (assoc :required true) ;; see analyzer/nil-literal-condition? (:nil-literal opts) (vary-meta assoc :nil-literal true) (:analyze-locals? ctx) (-> (assoc :id (swap! (:id-gen ctx) inc) :str (str expr)) (merge (scope-end scoped-expr))))] (namespace/reg-binding! ctx (-> ctx :ns :name) v) (namespace/check-shadowed-binding! ctx s expr) (with-meta {s v} (when t {:tag t}))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax (str "unsupported binding form " sym))))))) ;; keyword (:k expr) (let [k (:k expr)] (usages/analyze-keyword ctx expr opts) (if keys-destructuring? (let [s (-> k name symbol) m (meta expr) v (utils/binding-rec m {:name s :keyword k :filename (:filename ctx) :auto-resolved (:namespaced? expr)}) v (cond-> v (one-of (:destructuring-type opts) [:keys! :syms! :strs!]) (assoc :required true) (:analyze-locals? ctx) (-> (assoc :id (swap! (:id-gen ctx) inc) :str (str expr)) (merge (scope-end scoped-expr))))] (namespace/reg-binding! ctx (-> ctx :ns :name) v) {s v}) ;; TODO: we probably need to check if :as is supported in this ;; context, e.g. seq-destructuring? (when (or (:namespaced? expr) (not= :as k)) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax (str "unsupported binding form " expr)))))) :else (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax (str "unsupported binding form " expr)))) :vector (let [children (:children expr) all-tokens? (every? #(identical? :token %) (map :tag children)) exclude-as? (-> ctx :config :linters :unused-binding :exclude-destructured-as) as-node (let [[as as-node] (take-last 2 children)] (when (and (identical? :as (:k as)) (not (:namespaced? as))) as-node)) as-sym (when exclude-as? as-node) ;; the value's tag describes the whole sequence, not its ;; elements, see the same guard in extract-map-bindings. ;; Only :as names the whole value child-opts (assoc (dissoc opts :tag) :allow-amp true) opts-for (fn [child] (if (and (identical? child as-node) (:tag opts)) (assoc child-opts :tag (:tag opts)) child-opts)) v (let [ctx (update ctx :callstack conj [nil :vector])] (if all-tokens? (map #(extract-bindings ctx % scoped-expr (opts-for %)) children) (-> (reduce (fn [[ctx acc] expr] (let [ctx (if (and as-sym (= expr as-sym)) (assoc ctx :mark-bindings-used? true) ctx) bnds (extract-bindings ctx expr scoped-expr (opts-for expr))] [(ctx-with-bindings ctx bnds) (conj! acc bnds)])) [ctx (transient [])] children) second persistent!))) ;; only map-destructure children can carry :keys-spec amp-idx (when-not all-tokens? (count (take-while #(not= '& (:value %)) children))) tags (map-indexed (fn [i b] (let [m (meta b)] (or (when (and amp-idx (< i amp-idx)) (:keys-spec m)) (:tag m)))) v) keys-bindings (when-not all-tokens? (map-indexed (fn [i b] (when (and amp-idx (< i amp-idx)) (:key-bindings (meta b)))) v)) expr-meta (meta expr) t (:tag expr-meta) t (when t (types/tag-from-meta t))] (analyze-binding-vector ctx children) (with-meta (into {} v) ;; this is used for checking the return tag of a function body (assoc expr-meta :tag t :tags tags :keys-bindings keys-bindings))) :namespaced-map (extract-bindings ctx (first (:children expr)) scoped-expr (assoc opts :namespaced-map true)) :map ;; first check even amount of keys + vals (extract-map-bindings ctx expr scoped-expr opts) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax (str "unsupported binding form " expr)))))))) (defn analyze-in-ns [ctx {:keys [children] :as expr}] (let [{:keys [row col]} expr lang (:lang ctx) ns-name (-> children second :children first :value) ns (when ns-name (-> (namespace-analyzer/new-namespace (:filename ctx) (:base-lang ctx) (:lang ctx) ns-name :in-ns row col) ;; fix fully qualified core references (assoc :qualify-ns (cond-> {} (identical? :clj lang) (assoc 'clojure.core 'clojure.core) (identical? :cljs lang) (assoc 'cljs.core 'cljs.core 'clojure.core 'cljs.core)))))] (namespace/reg-namespace! ctx ns) (analyze-children ctx (next children)) ns)) ;;;; function arity (defn lint-fn-name! [ctx name-node] (when-not (simple-symbol? (:value name-node)) (findings/reg-finding! ctx (assoc (meta name-node) :message (str "Function name must be simple symbol but got: " name-node) :type :syntax :filename (:filename ctx))))) (defn analyze-arity [arg-vec] (reduce (fn [{fa :fixed-arity} {v :value}] (if (= '& v) (reduced {:min-arity fa, :varargs? true}) {:fixed-arity (inc fa)})) {:fixed-arity 0} (:children arg-vec))) (defn analyze-fn-arity [ctx body] (if-let [a (:analyzed-arity body)] a (do (utils/handle-ignore ctx body) (if-let [children (seq (:children body))] (let [arg-vec (first children) arg-vec-t (tag arg-vec)] (if (not= :vector arg-vec-t) (findings/reg-finding! ctx (node->line (:filename ctx) body :syntax "Function arguments should be wrapped in vector.")) (let [fn-dupes (atom #{}) ;; used to detect duplicate fn arg names arg-bindings (extract-bindings (assoc ctx :fn-dupes fn-dupes) arg-vec body {:fn-args? true}) {return-tag :tag arg-tags :tags keys-bindings :keys-bindings} (meta arg-bindings) arity (analyze-arity arg-vec) ret (cond-> {:arg-bindings (dissoc arg-bindings :analyzed) :arity arity :analyzed-arg-vec (:analyzed arg-bindings) :arg-vec arg-vec :args arg-tags :keys-bindings keys-bindings :ret return-tag} (:analyze-arglists? ctx) (assoc :arglist-str (str arg-vec)))] ret))) (findings/reg-finding! ctx (node->line (:filename ctx) body :syntax "Invalid function body.")))))) (defn- meta-arglists-node->strs "Return arglist-strs for `node` representing arglists metadata value. Returns nil if node does not match expected quoted list of vectors shape, ex: '([x][x y] ...)." [node] (when (and node (= :quote (tag node)) (= :list (some-> node :children first tag))) (reduce (fn [acc arg-vec] (if (= :vector (tag arg-vec)) (conj acc (str arg-vec)) (reduced nil))) [] (-> node :children first :children)))) (defn- meta-node->arglist-strs "Returns arglists-strs for `:arglists` in `node` representing metadata map. Returns nil if no `:arglists` found, or found `:arglists` looks invalid." [node] (some-> node (utils/map-node-get-value-node :arglists) meta-arglists-node->strs)) (defn analyze-pre-post-map [ctx expr] (let [ctx (update ctx :callstack conj [nil :pre-post]) children (:children expr)] (key-linter/lint-map-keys ctx expr) (mapcat (fn [[key-expr value-expr]] (let [analyzed-key (analyze-expression** ctx key-expr) analyzed-value (if (= :post (:k key-expr)) (analyze-expression** (ctx-with-bindings ctx '{% {}}) value-expr) (analyze-expression** ctx value-expr))] (concat analyzed-key analyzed-value))) (partition 2 children)))) (defn initial-constraints "The constraints a param starts with, decided by its binding tag: none for an untagged param, the desugared union for a nilable hint. Nil for any other tag: a hard hint is trusted as is, the param is excluded from inference." [t] (cond (nil? t) #{} (and (keyword? t) (types/nilable? t)) (let [s (types/desugar-nilable t)] ;; :nilable/any desugars to :any, which constrains nothing (if (identical? :any s) #{} #{s})) :else nil)) (defn inferable-params "The params backward type inference may constrain, as descriptor maps {:idx :binding :constraints}, plus :key and :defaulted for a map-destructured binding, for params that are untagged or hinted nilable, a nilable hint being sugar for a union constraint. Nil when inference is off for this fn: a macro, the linter disabled, or a user spec covering this arity, which wins outright. Coverage includes the :varargs fallback, same as spec lookup at call sites." [ctx arg-vec arg-bindings arity macro? keys-bindings] (when (and arg-vec (not macro?) (not (linter-disabled? ctx :type-mismatch)) (not (when-let [cfg-arities (some-> (config/type-mismatch-config (:config ctx) (-> ctx :ns :name) (:in-def ctx)) :arities)] (if-let [fa (:fixed-arity arity)] (types/args-spec-from-arities cfg-arities fa) (contains? cfg-arities :varargs))))) (let [kbs (some-> keys-bindings vec)] (loop [[node & more] (:children arg-vec) i 0 acc []] (if (nil? node) (seq acc) (let [v (when (identical? :token (tag node)) (:value node))] (if (= '& v) (seq acc) (recur more (inc i) (if-let [b (and (symbol? v) (not (namespace v)) (get arg-bindings v))] (if-let [ic (initial-constraints (:tag b))] (conj acc {:idx i :binding b :constraints ic}) acc) (reduce (fn [acc [k b defaulted]] (if-let [ic (initial-constraints (:tag b))] (conj acc {:idx i :binding b :constraints ic :key k :defaulted defaulted}) acc)) acc (when kbs (nth kbs i nil)))))))))))) (defn in-branch-ctx "Enters conditionally evaluated code: bumps the branch count, which stops every currently visible param from constraining. No-op when inference is off." [ctx] (if (:param-infers ctx) (update ctx :branch-count (fnil inc 0)) ctx)) (defn ctx-with-param-infers "Makes `simple-params` visible for inference. The marks pin both counters at fn entry, a usage constrains only while each counter still equals its mark, so only this fn's own unconditional spine constrains its params." [ctx simple-params param-infer] (let [entry {:param-infer param-infer :branch-mark (:branch-count ctx 0) :fn-mark (:fn-depth ctx 0)}] (update ctx :param-infers (fnil into {}) (map (fn [{:keys [binding]}] [binding entry]) simple-params)))) (defn analyze-fn-body [ctx body] (let [docstring (:docstring ctx) macro? (:macro? ctx) {:keys [arg-bindings arity analyzed-arg-vec arglist-str arg-vec keys-bindings] return-tag :ret arg-tags :args} (analyze-fn-arity ctx body) ctx (-> (ctx-with-bindings ctx arg-bindings) ;; params shadow any outer local fn of the same name: drop its ;; stale arity info so calls aren't checked against it (update :arities #(apply dissoc % (keys arg-bindings)))) ctx (assoc ctx :recur-arity arity :top-level? false) ;; a nested fn may run conditionally or never: constraints on ;; enclosing params collect here, dormant until a call site proves ;; the fn invoked on the spine, see types/activate-pending! pending-sink (when (:param-infers ctx) (atom {})) ctx (cond-> ctx pending-sink (-> (update :fn-depth (fnil inc 0)) (assoc :pending-infers pending-sink))) simple-params (inferable-params ctx arg-vec arg-bindings arity macro? keys-bindings) param-infer (when simple-params (atom (into {} (map (fn [{:keys [binding constraints]}] [binding constraints])) simple-params))) ctx (cond-> ctx param-infer (ctx-with-param-infers simple-params param-infer)) children (next (:children body)) first-child (first children) one-child? (= 1 (count children)) pre-post-map (when-not one-child? (when (and first-child (identical? :map (tag first-child)) (some #(let [k (:k %)] (or (= :pre k) (= :post k))) (take-nth 2 (:children first-child)))) first-child)) analyze-pre-post (when pre-post-map (analyze-pre-post-map ctx first-child)) children (if pre-post-map (next children) children) _ (let [t (when first-child (tag first-child))] ;;(prn (first (:callstack ctx))) (cond (and (not docstring) (not one-child?) (one-of t [:token :multi-line]) (string-from-token first-child) (one-of (first (:callstack ctx)) [[clojure.core defn] [cljs.core defn] [clojure.core defn-] [cljs.core defn-]])) (findings/reg-finding! ctx (node->line (:filename ctx) first-child :misplaced-docstring "Misplaced docstring.")))) _ (when (and (not (identical? :clj (:lang ctx))) arg-vec (:async (meta (meta/lift-meta-content2 ctx arg-vec)))) ;; defn can only carry ^:async on its name, fn literals also on the fn symbol (let [defn? (one-of (first (:callstack ctx)) [[cljs.core defn] [cljs.core defn-]])] (findings/reg-finding! ctx (node->line (:filename ctx) arg-vec :misplaced-async-metadata (str "Misplaced ^:async metadata: expected on fn name" (when-not defn? " or fn sym") " instead"))))) ctx (-> ctx (assoc :fn-args (:children arg-vec)) (assoc :body-children-count (count children)) (assoc :pre-post-map (some? pre-post-map))) children (if (:analyze-var-defs-shallowly? ctx) [] children) [parsed return-tag] (if (or macro? return-tag) [(analyze-children ctx children) return-tag] (let [last-expr (last children) ret-expr-id (gensym) last-expr (when last-expr (assoc last-expr :id ret-expr-id)) body-exprs (concat (butlast children) [last-expr]) parsed (doall (analyze-children ctx body-exprs)) ret-tag (or return-tag (let [maybe-call (get @(:calls-by-id ctx) ret-expr-id) tag (cond maybe-call (:ret maybe-call) last-expr (types/expr->tag ctx last-expr))] tag))] [parsed ret-tag])) arg-tags (if param-infer (types/merge-inferred-arg-tags simple-params param-infer arg-tags) arg-tags)] (assoc-some (assoc arity :parsed (concat analyzed-arg-vec analyze-pre-post parsed) :ret return-tag :arglist-str arglist-str :arg-vec arg-vec :args arg-tags) :pending-infer (when pending-sink (not-empty @pending-sink))))) (defn fn-bodies [ctx children body] (loop [[expr & rest-exprs :as exprs] children] (when expr (let [expr (meta/lift-meta-content2 ctx expr) t (tag expr)] (case t :vector [(with-meta (utils/list-node exprs) (dissoc (meta body) :clj-kondo/ignore))] :list exprs (recur rest-exprs)))))) (defn extract-arity-info [ctx parsed-bodies] (reduce (fn [acc {:keys [fixed-arity varargs? min-arity ret args arg-vec arglist-str]}] (let [arg-tags (when (some identity args) args) v (assoc-some {} :ret ret :min-arity min-arity :args arg-tags :arglist-str arglist-str)] (if varargs? (assoc acc :varargs v) (do (when (get acc fixed-arity) (findings/reg-finding! ctx (node->line (:filename ctx) arg-vec :conflicting-fn-arity (format "More than one function overload with arity %s." fixed-arity)))) (assoc acc fixed-arity v))))) {} parsed-bodies)) (defn analyze-defn [ctx expr defined-by defined-by->lint-as] (let [ns-name (-> ctx :ns :name) ;; "my-fn docstring" {:no-doc true} [x y z] x [name-node & children] (next (:children expr)) name-node-meta-nodes (:meta name-node) name-node (when name-node (meta/lift-meta-content2 ctx name-node)) _ (when name-node (lint-fn-name! ctx name-node)) _ (utils/handle-ignore ctx name-node) fn-name (some-> (:value name-node) (with-meta (meta name-node))) call (name (symbol-call expr)) var-leading-meta (meta name-node) _ (when (identical? :clj (:lang ctx)) (when-let [t (:tag var-leading-meta)] (let [tstr (str t) matching-node (some #(when (= tstr (str %)) %) name-node-meta-nodes)] (when matching-node (findings/reg-finding! ctx (node->line (:filename ctx) matching-node :non-arg-vec-return-type-hint (str "Prefer placing return type hint on arg vector: " t))))))) docstring (string-from-token (first children)) doc-node (when docstring (first children)) children (if docstring (next children) children) meta-node (when-let [fc (first children)] (let [t (tag fc)] (when (= :map t) fc))) children (if meta-node (next children) children) meta-node2 (when-let [fc (first children)] (let [fct (tag fc)] (when (= :list fct) (when-let [lc (last (next children))] (let [lct (tag lc)] (when (= :map lct) lc)))))) children (if meta-node2 (butlast children) children) ;; to not trigger unused-value linter we insert empty vector in callstack meta-ctx (update ctx :callstack (fn [cs] (cons [] cs))) ;; use dorun to force evaluation, we don't use the result! _ (when meta-node (dorun (analyze-expression** meta-ctx meta-node))) _ (when meta-node2 (dorun (analyze-expression** meta-ctx meta-node2))) meta-node-meta (when meta-node (sexpr meta-node)) [doc-node docstring] (or (and meta-node-meta (:doc meta-node-meta) (docstring/docs-from-meta meta-node)) [doc-node docstring]) meta-node2-meta (when meta-node2 (sexpr meta-node2)) [doc-node docstring] (or (and meta-node2-meta (:doc meta-node2-meta) (docstring/docs-from-meta meta-node2)) [doc-node docstring]) var-meta (if meta-node-meta (merge var-leading-meta meta-node-meta) var-leading-meta) var-meta (if meta-node2-meta (merge var-meta meta-node2-meta) var-meta) _ (let [fq-sym (symbol (str ns-name) (str fn-name)) {:clj-kondo/keys [config lint-as ignore]} var-meta config (cond-> nil config (assoc-in [:config-in-call fq-sym] (config/unquote config)) lint-as (assoc-in [:lint-as fq-sym] (config/unquote lint-as)) ignore (assoc-in [:config-in-call fq-sym :ignore] ignore))] (when config (swap! (:inline-configs ctx) conj config))) macro? (when (or (one-of defined-by->lint-as [clojure.core/defmacro cljs.core/defmacro]) (:macro var-meta)) true) gen-marked? (and (:clj-kondo/macroexpand-hook var-meta) ns-name fn-name (not (gen-macros/reserved-ns? ns-name))) gen-macro? (and gen-marked? (one-of defined-by->lint-as [clojure.core/defmacro cljs.core/defmacro])) gen-macros-acc (when gen-marked? (atom [])) deprecated (:deprecated var-meta) ctx (if macro? (ctx-with-bindings ctx '{&env {} &form {}}) ctx) private? (or (= "defn-" call) (:private var-meta)) [doc-node docstring] (if docstring [doc-node docstring] (when (some-> var-leading-meta :doc str) (some docstring/docs-from-meta name-node-meta-nodes))) bodies (fn-bodies ctx children expr) _ (when (empty? bodies) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax "Invalid function body."))) ;; var is known when making recursive call _ (when fn-name (namespace/reg-var! ctx ns-name fn-name expr {:temp true})) parsed-bodies (map #(analyze-fn-body (cond-> (-> ctx (assoc :docstring docstring :in-def fn-name :async-fn? (:async var-meta) :macro? macro?)) gen-macros-acc (assoc :gen-macros-aliases-acc gen-macros-acc)) %) bodies) ;; poor naming, this is for type information arities (extract-arity-info ctx parsed-bodies) fixed-arities (into #{} (filter number?) (keys arities)) varargs-min-arity (get-in arities [:varargs :min-arity])] (when gen-marked? (gen-macros/record! ctx {:orig-ns ns-name :expr expr :alias-usages @gen-macros-acc :source-aliases (:aliases (:ns ctx))}) (when gen-macro? (let [fq-sym (symbol (str ns-name) (str fn-name)) gen-ns (gen-macros/gen-ns-sym ns-name) hook-cfg {:hooks {:macroexpand {fq-sym (symbol (str gen-ns) (str fn-name))}}}] (swap! (:inline-configs ctx) conj hook-cfg)))) (when fn-name (namespace/reg-var! ctx ns-name fn-name expr (assoc-some var-leading-meta :user-meta (when (:analysis-var-meta ctx) (conj (or (:user-meta var-leading-meta) []) meta-node-meta meta-node2-meta)) :macro macro? :private private? :deprecated deprecated :defined-by defined-by :defined-by->lint-as defined-by->lint-as :fixed-arities (not-empty fixed-arities) :arglist-strs (when (:analyze-arglists? ctx) (or (meta-node->arglist-strs meta-node2) (meta-node->arglist-strs meta-node) (mapv :arglist-str parsed-bodies))) :arities arities :varargs-min-arity varargs-min-arity :doc docstring :added (:added var-meta) :type (when (one-of defined-by->lint-as [clojure.core/defn cljs.core/defn clojure.core/defn- cljs.core/defn-]) :fn)))) (docstring/lint-docstring! ctx doc-node docstring) (mapcat :parsed parsed-bodies))) (defn analyze-case [ctx expr] (let [children (rest (:children expr)) matched-val (first children)] (analyze-expression** ctx matched-val) ;; branches are conditionally evaluated, so no param inference (let [ctx (in-branch-ctx ctx) [test-ctx test-opts] (if (identical? :cljs (:lang ctx)) [(utils/ctx-with-linters-disabled ctx [:unresolved-symbol :private-call]) nil] [ctx {:quote? true}])] (loop [[constant expr & exprs] (rest children) seen-constants #{}] (when constant (if-not expr ;; this is the default expression (analyze-expression** ctx constant) (let [t (tag constant) list-const? (identical? :list t) dupe-cands (if list-const? (:children constant) [constant])] (when (symbol? (:value constant)) (findings/reg-finding! ctx (node->line (:filename ctx) constant :case-symbol-test "Case test symbol is compile time constant and is never evaluated."))) (let [t (:tag constant)] (when (identical? :quote t) (findings/reg-finding! ctx (node->line (:filename ctx) constant :case-quoted-test "Case test is compile time constant and should not be quoted.")))) (loop [[dupe & more] dupe-cands seen-local seen-constants] (let [t (:tag dupe)] (when (identical? :quote t) (findings/reg-finding! ctx (node->line (:filename ctx) dupe :case-quoted-test "Case test is compile time constant and should not be quoted.")))) (when (symbol? (:value dupe)) (findings/reg-finding! ctx (node->line (:filename ctx) dupe :case-symbol-test "Case test symbol is compile time constant and is never evaluated."))) (let [s-dupe (str dupe)] (when (seen-local s-dupe) (findings/reg-finding! ctx (node->line (:filename ctx) dupe :case-duplicate-test (format "Duplicate case test constant: %s" s-dupe)))) (when (seq more) (recur more (conj seen-local s-dupe))))) (if list-const? (run! #(analyze-usages2 test-ctx % test-opts) (:children constant)) (analyze-usages2 test-ctx constant test-opts)) (when expr (analyze-expression** ctx expr) (recur exprs (into seen-constants (map str dupe-cands))))))))))) (defn init-tag "Tag of a binding's init expression: the return of an init analyzed as a call, via calls-by-id, else its expression tag. Unwraps a {:tag ..} wrapper." [ctx value-id value] (let [maybe-call (get @(:calls-by-id ctx) value-id) t (cond maybe-call (:ret maybe-call) value (types/expr->tag ctx value))] (or (:tag t) t))) (defn expr-bindings [ctx binding-vector scoped-expr] (let [ctx (update ctx :callstack conj [:nil :vector])] (->> binding-vector :children (take-nth 2) (map #(extract-bindings ctx % scoped-expr {})) (reduce utils/deep-merge {})))) (defn analyze-redundant-bindings [ctx bv-node] (when (and (not (identical? :off (-> ctx :config :linters :redundant-let-binding :level))) (= :vector (tag bv-node))) (loop [[binding value & rest-bindings] (:children bv-node)] (let [binding-val (:value binding) value-val (:value value)] (when (and (simple-symbol? binding-val) (= binding-val value-val) (not-any? :meta [binding value])) ; ignore type-hinted self-binding (findings/reg-finding! ctx (assoc (meta binding) :filename (:filename ctx) :type :redundant-let-binding :message (str "Redundant let binding: " binding-val))))) (when (seq rest-bindings) (recur rest-bindings))))) (defn- if-assoc-rebind-shape? "AST shape check: `(if pred (assoc map-sym k v ...) map-sym)` where `assoc` still resolves to core. Does not inspect pred for self-reference - that is handled via binding-use tracking. Must run with the ctx active at the value's lexical scope so local shadows of `assoc` are detected." [ctx value-node map-sym] (when (= :list (tag value-node)) (let [[op _pred then else :as ch] (:children value-node) then-children (:children then)] (and (= 4 (count ch)) (= :token (tag op)) (= 'if (:value op)) (= :list (tag then)) (>= (count then-children) 4) (let [[a m] then-children] (and (= :token (tag a)) (= 'assoc (:value a)) (= :token (tag m)) (= map-sym (:value m)) (= :token (tag else)) (= map-sym (:value else)) (namespace/core-symbol-in-scope? ctx 'assoc))))))) (defn- lint-conditional-build-up! "A valid chain step needs exactly 2 references to the previous binding for `m` (the `assoc m` head and `else m` branch - more means pred or assoc args also reference it, which breaks a `cond->` rewrite) plus the if-assoc shape. Both conditions are pre-computed per pair into a single truthy entry." [ctx bv collected] (loop [entries collected run 0] (cond (>= run 2) (findings/reg-finding! ctx (node->line (:filename ctx) bv :conditional-build-up "Prefer cond-> to build a map with successive conditional assocs.")) (seq entries) (recur (next entries) (if (first entries) (inc run) 0))))) (defn analyze-let-like-bindings [ctx binding-vector scoped-expr] (let [resolved-as-clojure-var-name (:resolved-as-clojure-var-name ctx) for-like? (one-of resolved-as-clojure-var-name [for doseq]) callstack (:callstack ctx) call (-> callstack second second) let? (= 'let call) ;; don't register arg types on the same level ctx (assoc ctx :arg-types (atom []))] (loop [[binding value & rest-bindings] (-> binding-vector :children) bindings (:bindings ctx) arities (:arities ctx) analyzed []] (if binding (let [binding-tag (tag binding) binding-val (case binding-tag :token (or ;; symbol (:value binding) ;; keyword (:k binding)) nil) ;; binding-sexpr (sexpr binding) for-let? (and for-like? (= :let binding-val))] (if for-let? (let [ctx* (ctx-with-bindings ctx bindings) _ (analyze-redundant-bindings ctx* value) {new-bindings :bindings new-analyzed :analyzed new-arities :arities} (analyze-let-like-bindings ctx* value scoped-expr)] (recur rest-bindings (merge bindings new-bindings) (merge arities new-arities) (concat analyzed new-analyzed))) (let [binding (cond for-let? value ;; ignore :when and :while in for (keyword? binding-val) nil :else binding) ctx* (-> ctx (ctx-with-bindings bindings) (assoc :arities arities)) value-id (gensym) cbu-collector (:conditional-build-up-collector ctx) ;; Only allocate a tracker when there's a previous binding ;; of the same name to count refs against; otherwise no ;; chain step is possible. prev-binding (when cbu-collector (get bindings binding-val)) pair-tracker (when prev-binding (atom 0)) ;; Drop the collector when descending into value so nested ;; let-like forms (loop, for, when-let, ...) do not pollute ;; the outer let's collector. A nested `let` re-runs ;; `analyze-let` which installs its own collector. ctx** (cond-> ctx* pair-tracker (assoc :local-use-tracker pair-tracker :local-use-target prev-binding) cbu-collector (dissoc :conditional-build-up-collector)) analyzed-value (when (and value (not for-let?)) (analyze-expression** ctx** (assoc value :id value-id))) tag (when (and let? binding (one-of (tag binding) [:token :map])) (init-tag ctx* value-id value)) new-bindings (when binding (extract-bindings ctx* binding scoped-expr (cond-> {:tag tag} (and value (utils/nil-token? value)) (assoc :nil-literal true)))) analyzed-binding (:analyzed new-bindings) new-bindings (dissoc new-bindings :analyzed) m (meta analyzed-value) arity (:arity m) types-by-arity (:arities m) next-arities (if arity ;; in this case binding-sexpr is a symbol, ;; since functions cannot be destructured (assoc arities binding-val (assoc-some (assoc arity :types types-by-arity) :pending-infer (:pending-infer m))) ;; a non-fn binding shadows any prior local fn ;; of the same name: drop its stale arity info (dissoc arities binding-val))] (when cbu-collector (swap! cbu-collector conj (and (= 2 (some-> pair-tracker deref)) (if-assoc-rebind-shape? ctx* value binding-val)))) (recur rest-bindings (merge bindings new-bindings) next-arities (concat analyzed analyzed-binding analyzed-value))))) {:arities arities :bindings bindings :analyzed analyzed})))) (defn lint-even-forms-bindings! [ctx form-name bv] (let [num-children (count (:children bv))] (when (odd? num-children) (findings/reg-finding! ctx (node->line (:filename ctx) bv :syntax (format "%s binding vector requires even number of forms" form-name)))))) (defn assert-vector [ctx call expr] (when expr (let [vec? (and expr (= :vector (tag expr)))] (if-not vec? (do (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax ;; cf. error in clojure (format "%s requires a vector for its binding" call))) nil) expr)))) (defn analyze-like-let [{:keys [filename callstack let-parent] :as ctx} expr] (let [call (-> callstack first second) [current-call parent-call] callstack parent-let (one-of parent-call [[clojure.core let] [cljs.core let]]) current-let (one-of current-call [[clojure.core let] [cljs.core let]]) bv-node (-> expr :children second) valid-bv-node (assert-vector ctx call bv-node)] (when (and current-let (not (:clj-kondo.impl/generated expr)) (or (and parent-let (= parent-let let-parent) ;; not generated by hook code (not (:clj-kondo.impl/generated (meta parent-let)))) (and valid-bv-node (empty? (:children valid-bv-node))))) (findings/reg-finding! ctx (node->line filename expr :redundant-let "Redundant let expression."))) (when bv-node (let [{analyzed-bindings :bindings arities :arities analyzed :analyzed} (analyze-let-like-bindings (-> ctx ;; prevent linting redundant let when using let in bindings (update :callstack #(cons [nil :let-bindings] %))) valid-bv-node expr) let-body (nnext (:children expr)) let-parent (when (and current-let (= 1 (count let-body))) current-let) _ (lint-even-forms-bindings! ctx call valid-bv-node) analyzed (concat analyzed (doall (analyze-children (-> ctx (ctx-with-bindings analyzed-bindings) (assoc :arities arities) (assoc :let-parent let-parent)) let-body false)))] analyzed)))) (defn analyze-let [ctx expr] (let [bv (-> expr :children second) collector (when (and bv (= :vector (tag bv)) ;; chain needs >=3 bindings (1 base + 2 rebinds), ;; i.e. >=6 binding-vector children (>= (count (:children bv)) 6) (not (linter-disabled? ctx :conditional-build-up))) (atom [])) ctx (cond-> ctx collector (assoc :conditional-build-up-collector collector)) _ (analyze-redundant-bindings ctx bv) analyzed (analyze-like-let ctx expr)] (when collector (lint-conditional-build-up! ctx bv @collector)) analyzed)) (defn analyze-do [{:keys [filename callstack] :as ctx} expr] (let [parent-call (second callstack) core? (one-of (first parent-call) [clojure.core cljs.core]) core-sym (when core? (second parent-call)) ;; avoid warnings from hook code generated? (:clj-kondo.impl/generated expr) redundant? (and (not generated?) (not= 'fn* core-sym) (not= 'let* core-sym) (or ;; zero or one children (< (count (rest (:children expr))) 2) (and core? (not (:condition expr)) (not (:clj-kondo.impl/generated (meta parent-call))) (or ;; explicit do (= 'do core-sym) ;; implicit do (one-of core-sym [fn defn defn- let when-let loop binding with-open doseq try when when-not when-first when-some future catch])))))] (when redundant? (findings/reg-finding! ctx (node->line filename expr :redundant-do "redundant do")))) (analyze-children ctx (next (:children expr)) false)) (defn lint-two-forms-binding-vector! [ctx form-name expr] (let [num-children (count (:children expr))] (when (not= 2 num-children) (findings/reg-finding! ctx (node->line (:filename ctx) expr :syntax (format "%s binding vector requires exactly 2 forms" form-name)))))) (defn nil-literal-condition? "True for a literal nil, or a local bound to one. An intentional way to disable a branch, like a false literal, which is typed :boolean and gets no verdict either." [ctx expr] (or (utils/nil-token? expr) (when-let [sym (utils/symbol-from-token expr)] (:nil-literal (meta (get (:bindings ctx) sym)))))) (defn constant-condition-linter [ctx expr] (findings/reg-finding! ctx (node->line (:filename ctx) expr :constant-condition utils/condition-always-true-msg))) (defn analyze-condition "Analyzes an expression in condition position. `lint?` false skips the always-true/false checks: a form lint-as'ed to a conditional need not put a real condition in that position. `nil-test?` is for if-some and when-some, which branch on nilness rather than on truthiness." ([ctx condition] (analyze-condition ctx condition true false)) ([ctx condition lint?] (analyze-condition ctx condition lint? false)) ([ctx condition lint? nil-test?] (let [;; arg-types could be nil due to type-mismatch being disabled arg-types (or (:arg-types ctx) (atom [])) ctx (assoc ctx :arg-types arg-types) pos (-> ctx :arg-types deref count) ;; :condition also tells analyze-do / unused-value not to treat the test ;; as an implicit-do body, so it stays truthy when linting is skipped condition (assoc condition :condition (if lint? true :no-lint)) analyzed (doall (analyze-expression** ctx condition))] (when (and lint? (not (linter-disabled? ctx :constant-condition)) ;; a keyword test in cond->/cond->> marks a step that always ;; runs, e.g. :always (not (and (:k condition) (:cond-arrow-test condition))) (not (:clj-kondo.impl/generated condition))) (let [tag (some-> @arg-types (nth pos) :tag)] (case (types/constant-verdict tag nil-test?) :always-false (when-not (nil-literal-condition? ctx condition) (findings/reg-finding! ctx (node->line (:filename ctx) condition :constant-condition "Condition always false"))) :always-true (constant-condition-linter ctx condition) ;; a tag with unresolved calls in it gets a second chance once every ;; namespace is analyzed, see linters/lint-deferred-conditions!. A ;; var usage does not defer: its def tag misses set! and ;; alter-var-root, as in (def x nil) guarded by (when-not x (set! x ..)) (when (and tag (not (:usage tag)) (not (types-utils/resolved-type? tag))) (when-let [deferred (:deferred-conditions ctx)] (swap! deferred conj {:ctx ctx :condition condition :tag tag :nil-test? nil-test?})))))) analyzed))) (defn analyze-conditional-let [ctx call expr lint-as?] (let [children (next (:children expr)) bv (first children) vec? (when bv (= :vector (tag bv)))] (when vec? (let [if? (one-of call [if-let if-some]) condition (-> bv :children second) body-exprs (next children) scoped (if if? (first body-exprs) expr) two-forms? (= 2 (count (:children bv))) value-id (when two-forms? (gensym)) ;; a vector binding form would leak the whole init tag onto its ;; elements, see the :vector branch of extract-bindings. ;; when-first binds the first element, not the init, so it ;; gets no tag until element types are modeled tag-form? (and (not= 'when-first call) (one-of (some-> bv :children first tag) [:token :map])) analyzed-condition (let [cctx (update ctx :callstack conj [:vector]) cnode (cond-> condition value-id (assoc :id value-id))] ;; when-first runs on (seq coll), not the ;; coll's truthiness, so no condition checks (if (= 'when-first call) (analyze-expression** cctx cnode) (analyze-condition cctx cnode (not (or lint-as? (:clj-kondo.impl/generated expr))) (one-of call [if-some when-some])))) raw-tag (when value-id (init-tag ctx value-id condition)) ;; a provably nil init means the bound branch never runs, for ;; any binding form dead-body? (identical? :nil raw-tag) ;; a dead bound branch gets no type errors: the body, but also ;; destructuring defaults and key exprs, which only evaluate ;; behind the failed condition dead-ctx (fn [c] (if dead-body? (utils/ctx-with-linters-disabled c [:type-mismatch]) c)) ;; the init's tag types the binding, like in let, minus nil: ;; the body only runs when the value is non-nil btag (when (and tag-form? (not dead-body?)) (cond (set? raw-tag) (let [t* (disj raw-tag :nil)] (case (count t*) 0 nil 1 (first t*) t*)) (and (keyword? raw-tag) (types/nilable? raw-tag)) (types/unnil raw-tag) :else raw-tag)) bindings (if two-forms? (extract-bindings (dead-ctx (update ctx :callstack conj [:nil :vector])) (-> bv :children first) scoped {:tag btag}) (expr-bindings ctx bv scoped)) ctx-with-binding (ctx-with-bindings ctx (dissoc bindings :analyzed))] (lint-two-forms-binding-vector! ctx call bv) (concat (:analyzed bindings) analyzed-condition ;; bodies are conditionally evaluated, so no param inference ;; the else branch of if-let stays live (let [ctx (in-branch-ctx ctx) ctx-with-binding (in-branch-ctx ctx-with-binding)] (if if? ;; in the case of if, the binding is only valid in the first expression (concat (analyze-expression** (dead-ctx (ctx-with-bindings ctx (dissoc bindings :analyzed))) (first body-exprs)) (analyze-children ctx (rest body-exprs) false)) (analyze-children (dead-ctx ctx-with-binding) body-exprs false)))))))) (defn fn-arity [ctx bodies] (let [arities (map #(analyze-fn-arity ctx %) bodies) fixed-arities (set (keep (comp :fixed-arity :arity) arities)) varargs-min-arity (some #(when (:varargs? (:arity %)) (:min-arity (:arity %))) arities) arglist-strs (vec (keep :arglist-str arities)) bodies (map (fn [body arity] (assoc body :analyzed-arity arity)) bodies arities)] (cond-> ;; we return bodies so we don't have to run fn-arity twice over the bodies {:bodies bodies} (seq fixed-arities) (assoc :fixed-arities fixed-arities) varargs-min-arity (assoc :varargs-min-arity varargs-min-arity) (seq arglist-strs) (assoc :arglist-strs arglist-strs)))) (defn- def? [x] (one-of x [[clojure.core def] [cljs.core def]])) (defn- let? [x] (one-of x [[clojure.core let] [cljs.core let]])) (defn- def-fn? [{:keys [callstack]}] (let [[_ parent extra-parent] callstack] (or (def? parent) (and (let? parent) (def? extra-parent))))) (defn- reg-def-fn! [ctx expr filename] (findings/reg-finding! ctx (node->line filename expr :def-fn "Use defn instead of def + fn"))) (defn analyze-fn [ctx expr] (let [ctx (assoc ctx :seen-recur? (volatile! nil)) protocol-fn (:protocol-fn expr) ctx (assoc ctx :protocol-fn protocol-fn) children (:children expr) fn-sym (first children) ?name-expr (second children) ?fn-name (when ?name-expr (when-let [n (utils/symbol-from-token ?name-expr)] n)) ;; CLJS only honors ^:async on the fn symbol or the function name. ;; Metadata on the whole (fn ...) form lands on the list's own metadata ;; and is ignored. _ (when (and (not (identical? :clj (:lang ctx))) (:async (meta expr))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :misplaced-async-metadata "Misplaced ^:async metadata: expected on fn name or fn sym instead"))) ctx (assoc ctx :async-fn? (or (:async (meta (meta/lift-meta-content2 ctx fn-sym))) (when ?fn-name (:async (meta (meta/lift-meta-content2 ctx ?name-expr)))))) _ (when (and ?name-expr (identical? :token (tag ?name-expr))) (lint-fn-name! ctx ?name-expr)) bodies (fn-bodies ctx (next children) expr) ;; we need the arity beforehand because this is valid in each body arity (fn-arity ctx bodies) bodies (:bodies arity) filename (:filename ctx) parsed-bodies (let [ctx (-> ctx (assoc :fn-body-count (count bodies)) (assoc :fn-parent-loc (meta expr))) ctx (if ?fn-name (-> ctx (update :bindings conj [?fn-name (assoc (meta ?name-expr) :name ?fn-name :filename filename)]) (update :arities assoc ?fn-name arity)) ctx)] (map #(analyze-fn-body ctx %) bodies)) arities (when-not (some-> ctx :def-meta :macro) (extract-arity-info ctx parsed-bodies)) fixed-arities (when arities (into #{} (filter number?) (keys arities))) varargs-min-arity (when arities (get-in arities [:varargs :min-arity])) arglist-strs (when arities (into [] (keep :arglist-str) (vals arities))) pending-infer (not-empty (apply merge-with into {} (keep :pending-infer parsed-bodies))) parsed-bodies (mapcat :parsed parsed-bodies)] (when (and (not (linter-disabled? ctx :def-fn)) (def-fn? ctx)) (reg-def-fn! ctx expr filename)) (with-meta parsed-bodies (when arities (cond-> {:arity {:fixed-arities fixed-arities :varargs-min-arity varargs-min-arity} :arities arities} (seq arglist-strs) (assoc-in [:arity :arglist-strs] arglist-strs) pending-infer (assoc :pending-infer pending-infer)))))) (defn analyze-alias [ctx expr] (let [ns (:ns ctx) [alias-expr ns-expr :as children] (rest (:children expr)) alias-sym (let [t (tag alias-expr)] (or (when (identical? :quote t) (:value (first (:children alias-expr)))) (when (identical? :list t) (let [children (:children alias-expr)] (when (= 'quote (some-> children first utils/symbol-from-token)) (utils/symbol-from-token (second children))))))) ns-sym (let [t (tag ns-expr)] (or (when (identical? :quote t) (:value (first (:children ns-expr)))) (when (identical? :list t) (let [children (:children ns-expr)] (when (= 'quote (some-> children first utils/symbol-from-token)) (utils/symbol-from-token (second children)))))))] (when (= alias-expr ns-expr) (findings/reg-finding! ctx (node->line (:filename ctx) alias-expr :alias-same-as-ns (str "Alias same as namespace name: " alias-sym)))) (if (and alias-sym (symbol? alias-sym) ns-sym (symbol? ns-sym)) (namespace/reg-alias! ctx (:name ns) alias-sym ns-sym) (analyze-children ctx children)) (assoc-in ns [:qualify-ns alias-sym] ns-sym))) (defn analyze-loop [ctx expr] (let [seen-recur? (volatile! nil) ctx (-> (assoc ctx :seen-recur? seen-recur?) (dissoc :protocol-fn)) bv (-> expr :children second)] (when (and bv (= :vector (tag bv))) (let [arg-count (let [c (count (:children bv))] (when (even? c) (/ c 2))) analyzed (analyze-like-let (assoc ctx :recur-arity {:fixed-arity arg-count}) expr)] (when-not @seen-recur? (findings/reg-finding! ctx (node->line (:filename ctx) expr :loop-without-recur "Loop without recur."))) analyzed)))) (defn first-callstack-elt-ignoring-macros [callstack] (loop [callstack callstack] (when-let [cse (first callstack)] (if (not (one-of (second cse) [-> ->> some-> some->> doto cond-> alt! alt!!])) cse (recur (rest callstack)))))) (defn mark-non-tail-recur "Marks ctx as a non-tail position for recur (e.g. inside a collection literal). An empty map is used as the sentinel so that downstream `assoc-in [:recur-arity :fixed-arity] 0` calls still work." [ctx] (assoc ctx :recur-arity {})) (defn non-tail-recur? "Inverse of `mark-non-tail-recur`: true when the ctx's :recur-arity signals a non-tail position. Distinguished from a nil :recur-arity, which means there is no enclosing fn or loop at all." [recur-arity] (and (map? recur-arity) (empty? recur-arity))) (defn analyze-recur [ctx expr] (let [filename (:filename ctx) recur-arity (:recur-arity ctx) seen-recur? (:seen-recur? ctx)] (when seen-recur? (vreset! seen-recur? true)) (when-not (or (linter-disabled? ctx :invalid-arity) (config/skip? (:config ctx) :invalid-arity (:callstack ctx))) (if (non-tail-recur? recur-arity) (findings/reg-finding! ctx (node->line filename expr :unexpected-recur "Recur can only be used in tail position.")) (let [arg-count (count (rest (:children expr))) expected-arity (or (:fixed-arity recur-arity) ;; varargs must be passed as a seq or nil in recur (when-let [min-arity (:min-arity recur-arity)] (inc min-arity))) expected-arity (if (:protocol-fn ctx) ;; compensate for this argument (dec expected-arity) expected-arity)] (let [len (:len ctx) idx (:idx ctx) parent (-> (:callstack ctx) rest first-callstack-elt-ignoring-macros second)] (when (and len idx (not= (dec len) idx) (not (one-of parent [if case cond if-let if-not if-some condp]))) (findings/reg-finding! ctx (node->line filename expr :unexpected-recur "Recur can only be used in tail position.")))) (cond (not expected-arity) (findings/reg-finding! ctx (node->line filename expr :unexpected-recur "Unexpected usage of recur.")) (not= expected-arity arg-count) (findings/reg-finding! ctx (node->line filename expr :invalid-arity (format "recur argument count mismatch (expected %d, got %d)" expected-arity arg-count))) :else nil))))) (analyze-children ctx (rest (:children expr)))) (defn analyze-letfn [ctx expr] (let [fns (-> expr :children second :children) name-exprs (map #(-> % :children first) fns) bindings (when (seq name-exprs) (mapv (fn [name-expr] (let [m (meta name-expr) v (utils/binding-rec m {:name (:value name-expr) :filename (:filename ctx)}) v (cond-> v (:analyze-locals? ctx) (-> (assoc :id (swap! (:id-gen ctx) inc) :str (:str name-expr)) (merge (scope-end expr))))] (namespace/reg-binding! ctx (-> ctx :ns :name) v) [(:value name-expr) v])) name-exprs)) ctx (ctx-with-bindings ctx bindings) protocol-fn (:protocol-fn ctx) ctx* (dissoc ctx :protocol-fn) processed-fns (for [f fns :let [children (:children f) fn-name (:value (first children)) bodies (fn-bodies ctx* (next children) f) arity (fn-arity ctx bodies) bodies (:bodies arity)]] {:name fn-name :arity arity :bodies bodies}) ctx* (reduce (fn [ctx pf] (assoc-in ctx [:arities (:name pf)] (:arity pf))) ctx* processed-fns) parsed-fns (map #(analyze-fn-body ctx* %) (mapcat :bodies processed-fns)) ctx (assoc ctx* :protocol-fn protocol-fn) analyzed-children (analyze-children ctx (->> expr :children (drop 2)))] (concat (mapcat :parsed parsed-fns) analyzed-children))) (declare analyze-defmethod) (defn current-namespace-var-name [ctx var-name-node var-name] (if (qualified-symbol? var-name) (let [ns (:ns ctx) alias (symbol (namespace var-name))] (if (= (:name ns) (get (:qualify-ns ns) alias)) (symbol (name var-name)) (do (findings/reg-finding! ctx (node->line (:filename ctx) var-name-node :syntax (str "Invalid var name: " var-name))) nil))) (some-> var-name (with-meta (meta var-name-node))))) (defn analyze-def [ctx expr defined-by defined-by->lint-as] (let [children (next (:children expr)) raw-var-name-node (first children) var-name-node-meta-nodes (:meta raw-var-name-node) _ (utils/handle-ignore ctx raw-var-name-node) var-name-node (meta/lift-meta-content2 ctx raw-var-name-node) metadata (meta var-name-node) var-name (:value var-name-node) var-name (current-namespace-var-name ctx var-name-node var-name) children (next children) docstring (when (> (count children) 1) (string-from-token (first children))) defmulti? (or (= 'clojure.core/defmulti defined-by->lint-as) (= 'cljs.core/defmulti defined-by->lint-as)) doc-node (when docstring (first children)) [child & children] (if docstring (next children) children) core-def? (one-of (first (:callstack ctx)) [[clojure.core def] [cljs.core def]]) _ (when (and core-def? children) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity "Too many arguments to def"))) _ (when-not child (findings/reg-finding! ctx (node->line (:filename ctx) expr :uninitialized-var "Uninitialized var"))) [extra-meta extra-meta-node children] (if (and defmulti? child (identical? :map (tag child))) [(sexpr child) child children] [nil nil (cons child children)]) metadata (if extra-meta (merge metadata extra-meta) metadata) [doc-node docstring] (or (and extra-meta (:doc extra-meta) (docstring/docs-from-meta extra-meta-node)) [doc-node docstring]) [doc-node docstring] (if docstring [doc-node docstring] (when (some-> metadata :doc str) (some docstring/docs-from-meta var-name-node-meta-nodes))) ctx (assoc ctx :in-def var-name :def-meta metadata :defmulti? defmulti?) children (if (:analyze-var-defs-shallowly? ctx) [] children) ns-name (-> ctx :ns :name) gen-marked? (and core-def? (:clj-kondo/macroexpand-hook metadata) ns-name var-name (not (gen-macros/reserved-ns? ns-name))) gen-macros-acc (when gen-marked? (atom [])) init-ctx (cond-> ctx gen-macros-acc (assoc :gen-macros-aliases-acc gen-macros-acc)) def-init (when (and core-def? (= 1 (count children))) (or (analyze-expression** init-ctx (first children)) ;; prevent analysis of only child more than once [])) _ (when gen-marked? (gen-macros/record! ctx {:orig-ns ns-name :expr expr :alias-usages @gen-macros-acc :source-aliases (:aliases (:ns ctx))})) init-meta (some-> def-init meta) ;; :args and :ret is are the type related keys ;; together this is called :arities in reg-var! arity (when init-meta (:arity init-meta)) var-name-str (str var-name) earmuffed? (re-matches #"\*+[^\*]+\*+" var-name-str) dynamic? (:dynamic metadata)] (if dynamic? (when (not earmuffed?) (findings/reg-finding! ctx (node->line (:filename ctx) var-name-node :dynamic-var-not-earmuffed (str "Var is declared dynamic but name is not earmuffed: " var-name-str)))) (when earmuffed? (findings/reg-finding! ctx (node->line (:filename ctx) var-name-node :earmuffed-var-not-dynamic (str "Var has earmuffed name but is not declared dynamic: " var-name-str))))) (when var-name (let [type (when-not dynamic? (let [t (some-> (:arg-types ctx) deref first :tag)] ;; a def'd var does not take a deferred marker type: its ;; value can change via alter-var-root, see mask-var-usages (when-not (and (map? t) (or (:call t) (:usage t))) t)))] (namespace/reg-var! ctx (-> ctx :ns :name) var-name expr (assoc-some metadata :user-meta (when (:analysis-var-meta ctx) (conj (:user-meta metadata) extra-meta)) :doc docstring :defined-by defined-by :defined-by->lint-as defined-by->lint-as :fixed-arities (:fixed-arities arity) :arglist-strs (when (:analyze-arglists? ctx) ;; match Clojure behaviour for var name meta nodes, ;; it will pick first :arglists, e.g.: ;; ^{:arglists '([x])} ^{:arglists '([y])} z (or (some meta-node->arglist-strs var-name-node-meta-nodes) (meta-node->arglist-strs extra-meta-node) (:arglist-strs arity))) :varargs-min-arity (:varargs-min-arity arity) :arities (:arities init-meta) :type type)))) (docstring/lint-docstring! ctx doc-node docstring) (or def-init ;; this was something else than core/def (analyze-children ctx children)))) (declare analyze-defrecord) (declare analyze-defprotocol) (defn analyze-schema [ctx fn-sym expr defined-by defined-by->lint-as] (let [{:keys [expr schemas]} (schema/expand-schema ctx fn-sym expr)] (concat (case fn-sym fn (analyze-fn ctx expr) def (analyze-def ctx expr defined-by defined-by->lint-as) defn (analyze-defn ctx expr defined-by defined-by->lint-as) defmethod (analyze-defmethod ctx expr) defrecord (analyze-defrecord ctx expr defined-by defined-by->lint-as) defprotocol (analyze-defprotocol ctx expr defined-by defined-by->lint-as)) (analyze-children ctx schemas)))) (defn arity-match? [fixed-arities varargs-min-arity arg-count] (or (contains? fixed-arities arg-count) (and varargs-min-arity (>= arg-count varargs-min-arity)))) (def inlined-vars '#{+' unchecked-remainder-int unchecked-subtract-int dec' short-array bit-shift-right aget = boolean bit-shift-left aclone dec < char unchecked-long unchecked-negate unchecked-inc-int floats pos? boolean-array alength bit-xor unsigned-bit-shift-right neg? unchecked-float num reduced? booleans int-array inc' <= -' * min get long double bit-and-not unchecked-add-int short quot unchecked-double longs unchecked-multiply-int int > unchecked-int unchecked-multiply unchecked-dec double-array float - byte-array zero? unchecked-dec-int rem nth nil? bit-and *' unchecked-add identical? unchecked-divide-int unchecked-subtract / bit-or >= long-array object-array doubles unchecked-byte unchecked-short float-array inc + chars ints bit-not byte max == count char-array compare shorts unchecked-negate-int unchecked-inc unchecked-char bytes}) (defn redundant-fn-wrapper [ctx callstack children interop?] (when-let [fn-args (:fn-args ctx)] (when (and (not (:pre-post-map ctx)) (not (identical? :off (-> ctx :config :linters :redundant-fn-wrapper :level))) (not (:extend-type ctx)) (not interop?) (= 1 (:fn-body-count ctx)) (= 1 (:body-children-count ctx)) (= (count children) (count fn-args)) (one-of (second callstack) [[clojure.core fn] [clojure.core fn*] [cljs.core fn] [cljs.core fn*]]) (let [[core-ns f] (first callstack)] (or (not f) (and (or (= 'clojure.core core-ns) (= 'cljs.core core-ns)) (not (contains? inlined-vars f))))) (not= '[cljs.core .] (nth callstack 2 nil)) (= (map #(str/replace % #"^%$" "%1") children) (map str fn-args))) (:fn-parent-loc ctx)))) (defn lint-map-call! [ctx arg-count expr] (let [callstack (:callstack ctx) config (:config ctx)] (when (or (zero? arg-count) (> arg-count 2)) (when-not (config/skip? config :invalid-arity callstack) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity (format "map is called with %s args but expects 1 or 2" arg-count))))))) (defn lint-vector-call! [ctx arg-count expr] (let [callstack (:callstack ctx) config (:config ctx)] (when (not= 1 arg-count) (when-not (config/skip? config :invalid-arity callstack) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity (str "Vector can only be called with 1 arg but was called with: " arg-count))))))) (defn lint-set-call! [ctx arg-count expr] (let [callstack (:callstack ctx) config (:config ctx) cljs? (identical? :cljs (:lang ctx)) expected-arg-counts (if cljs? #{1 2} #{1}) expected-arg-str (if cljs? "1 or 2 args" "1 arg")] (when-not (expected-arg-counts arg-count) (when-not (config/skip? config :invalid-arity callstack) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity (str "Set can only be called with " expected-arg-str " but was called with: " arg-count))))))) (defn analyze-binding-call [ctx fn-name binding expr] (let [callstack (:callstack ctx) config (:config ctx) ns-name (-> ctx :ns :name) fn-meta (meta fn-name) arg-types (atom []) ctx (assoc ctx :arg-types arg-types) children (:children expr) binding-info (get (:arities ctx) fn-name) tag (get-in ctx [:bindings fn-name :tag])] ;; calling a local fn is proof it runs here: commit its dormant ;; constraints on enclosing params, subject to reachability (when-let [pending (:pending-infer binding-info)] (types/activate-pending! ctx pending)) (when-let [k (types/keyword binding)] (when-not (types/match? k :ifn) (findings/reg-finding! ctx (node->line (:filename ctx) expr :type-mismatch (format "%s cannot be called as a function." (str/capitalize (types/label k))))))) (case (or (:type tag) tag) :map (lint-map-call! ctx (dec (count children)) expr) :vector (lint-vector-call! ctx (dec (count children)) expr) :set (lint-set-call! ctx (dec (count children)) expr) nil) (namespace/reg-used-binding! ctx ns-name binding (assoc (meta expr) :name-row (:row fn-meta) :name-col (:col fn-meta) :name-end-row (:end-row fn-meta) :name-end-col (:end-col fn-meta))) (when-not (config/skip? config :invalid-arity callstack) (let [filename (:filename ctx)] (when-not (linter-disabled? ctx :invalid-arity) (when-let [{:keys [fixed-arities varargs-min-arity]} binding-info] ;; (prn :arities types) (let [arg-count (count (rest children))] (when-not (arity-match? fixed-arities varargs-min-arity arg-count) (findings/reg-finding! ctx (node->line filename expr :invalid-arity (linters/arity-error nil fn-name arg-count fixed-arities varargs-min-arity))))))))) (when-let [fn-parent-loc (redundant-fn-wrapper ctx (cons nil callstack) (rest children) false)] (findings/reg-finding! ctx (assoc fn-parent-loc :filename (:filename ctx) :type :redundant-fn-wrapper :message "Redundant fn wrapper"))) (let [types (:types binding-info) children (rest children) type (get types (count children)) ret (:ret type)] (analyze-children (update ctx :callstack conj [nil fn-name]) children false) {:ret ret}))) (defn lint-inline-def! [ctx expr] (when (and (not (:in-comment ctx)) (or (:in-def ctx) (and (not (:top-level? ctx)) (let [[parent-ns parent-fn] (second (:callstack ctx))] (and (one-of parent-ns [clojure.core cljs.core]) (one-of parent-fn [fn defmethod])))))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :inline-def "inline def")))) (defn analyze-declare [ctx expr defined-by defined-by->lint-as] (let [ns-name (-> ctx :ns :name) var-name-nodes (next (:children expr)) ;; lift once and keep the lifted nodes: their meta carries user ;; metadata like :clj-kondo/macroexpand-hook next to the positions var-names (keep (fn [var-name-node] (let [lifted (meta/lift-meta-content2 ctx var-name-node)] (current-namespace-var-name ctx lifted (:value lifted)))) var-name-nodes) vars-ns-path [(:base-lang ctx) (:lang ctx) ns-name :vars] vars (get-in @(:namespaces ctx) vars-ns-path)] (when (and ns-name (some #(:clj-kondo/macroexpand-hook (meta %)) var-names) (not (gen-macros/reserved-ns? ns-name))) (gen-macros/record! ctx {:orig-ns ns-name :expr expr :alias-usages [] :source-aliases (:aliases (:ns ctx))})) (doseq [var-name var-names :let [var-name-meta (meta var-name)]] (when-not (linter-disabled? ctx :redundant-declare) (let [existing-var (get vars var-name)] (when (and existing-var (not (utils/ignored? existing-var :redundant-declare))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :redundant-declare (str "Redundant declare: " var-name)))))) (namespace/reg-var! ctx ns-name var-name expr (assoc (meta expr) :name-row (:row var-name-meta) :name-col (:col var-name-meta) :name-end-row (:end-row var-name-meta) :name-end-col (:end-col var-name-meta) :declared true :defined-by defined-by :defined-by->lint-as defined-by->lint-as))))) (defn analyze-catch [ctx expr] (let [ctx (update ctx :callstack conj [nil 'catch]) [class-expr binding-expr & exprs] (next (:children expr)) _ (analyze-expression** ctx class-expr) ;; analyze usage for unused import linter ;; catch params are not let-bound, & is allowed there binding (extract-bindings ctx binding-expr (last exprs) {:allow-amp true})] ;; a catch body only runs on an exception, so it is conditional code (analyze-children (ctx-with-bindings (in-branch-ctx ctx) binding) exprs))) (defn analyze-try [ctx expr] (let [children (next (:children expr)) children-until-catch-or-finally (take-while #(let [sc (symbol-call %)] (and (not= 'catch sc) (not= 'finally sc))) children) cnt (count children-until-catch-or-finally) children-after (drop cnt children) ;; a catch swallows the crash a param misuse in the body would cause, ;; so body usages prove nothing about param types body-ctx (if (some #(= 'catch (symbol-call %)) children-after) (in-branch-ctx ctx) ctx)] (analyze-children body-ctx children-until-catch-or-finally) (loop [[fst-child & rst-children] children-after analyzed [] ;; TODO: lint syntax _catch-phase false _finally-phase false has-catch-or-finally? false] (if fst-child (case (symbol-call fst-child) catch (let [analyzed-catch (analyze-catch ctx fst-child)] (recur rst-children (into analyzed analyzed-catch) true false true)) finally (recur rst-children (into analyzed (analyze-children (update ctx :callstack conj [nil 'finally]) (next (:children fst-child)))) false false true) ;; TODO: should never get here, probably syntax error (recur rst-children (into analyzed (analyze-expression** ctx fst-child)) false false has-catch-or-finally?)) (do (when-not has-catch-or-finally? (findings/reg-finding! ctx (node->line (:filename ctx) expr :missing-clause-in-try "Missing catch or finally in try"))) analyzed))))) (defn- method-arities-by-name [meths defined-by->lint-as] (let [interface? (= 'clojure.core/definterface defined-by->lint-as)] (reduce (fn [acc [fn-name fixed-arities]] (update acc fn-name (fnil into #{}) (cond->> fixed-arities interface? (map inc)))) {} meths))) (defn analyze-defprotocol [{:keys [ns] :as ctx} expr defined-by defined-by->lint-as] ;; for syntax, see https://clojure.org/reference/protocols#_basics (let [children (next (:children expr)) name-node (first children) name-node (meta/lift-meta-content2 ctx name-node) name-meta (meta name-node) protocol-name (:value name-node) ns-name (:name ns) docstring (string-from-token (second children)) doc-node (when docstring (second children)) transduce-arity-vecs (filter ;; skip last docstring #(when (= :vector (tag %)) %))] (docstring/lint-docstring! ctx doc-node docstring) (let [meths (for [c (next children) :when (= :list (tag c)) ;; skip first docstring :let [children (:children c) name-node (first children) name-node (meta/lift-meta-content2 ctx name-node) name-meta (meta name-node) fn-name (:value name-node) arities (rest children) docstring (string-from-token (last children)) doc-node (when docstring (last children))]] ;; This is here for analyzing usages of type hints, but it also causes ;; false positives in the analysis, so we can improve this (do (let [ctx (utils/ctx-with-linter-disabled ctx :unresolved-symbol)] (run! #(analyze-usages2 ctx %) arities)) (when fn-name (let [arglist-strs (when (:analyze-arglists? ctx) (->> arities (into [] (comp transduce-arity-vecs (map str))) (not-empty))) fixed-arities (into #{} (comp transduce-arity-vecs (map #(let [children (:children %)] (run! (fn [child] (when (= '& (:value child)) (findings/reg-finding! ctx (node->line (:filename ctx) child :protocol-method-varargs "Protocol methods do not support varargs.")))) children) (count children)))) arities)] (utils/handle-ignore ctx c) (namespace/reg-var! (cond-> ctx (= 'clojure.core/definterface defined-by->lint-as) (assoc :skip-reg-var true)) ns-name fn-name c (assoc-some (merge name-meta (meta c)) :user-meta (when (:analysis-var-meta ctx) (:user-meta name-meta)) :doc docstring :arglist-strs arglist-strs :name-row (:row name-meta) :name-col (:col name-meta) :name-end-row (:end-row name-meta) :name-end-col (:end-col name-meta) :fixed-arities fixed-arities :protocol-ns ns-name :protocol-name protocol-name :defined-by defined-by :defined-by->lint-as defined-by->lint-as)) (docstring/lint-docstring! ctx doc-node docstring) [fn-name fixed-arities]))))] (when protocol-name (namespace/reg-var! ctx ns-name protocol-name expr (assoc-some name-meta :user-meta (when (:analysis-var-meta ctx) (:user-meta name-meta)) :doc docstring :methods (mapv first meths) :method-arities (method-arities-by-name meths defined-by->lint-as) :defined-by defined-by :defined-by->lint-as defined-by->lint-as)))))) (defn analyze-protocol-impls [ctx defined-by defined-by->lint-as ns-name children] (let [def-by (name defined-by) end? (fn [node] (or (not node) (utils/symbol-from-token node)))] (loop [current-protocol nil children children protocol-ns nil protocol-name nil protocol-node nil methods []] (when-let [c (first children)] (if-let [[_ sym] (when-let [[_ v :as v'] (find c :value)] (when (or (symbol? v) ;; extend-type to nil (nil? v)) v'))] ;; We have encountered a protocol or interface name, or a ;; record or type name (in the case of extend-protocol and ;; extend-type). We need to deal with extend-protocol in a ;; special way, as there is a single protocol being extented ;; to multiple records/types. (do (when-not (and (identical? :cljs (:lang ctx)) (one-of sym [Object number function default object string bigint])) (analyze-expression** ctx c)) (let [[protocol-name' protocol-node end-node] (case (name defined-by) "extend-protocol" (if (nil? current-protocol) ;; extend-protocol has the protocol name as ;; it first symbol [sym c (second (rest children))] ;; but has record/type names in its body that ;; we need to ignore, and keep the initial ;; (and only) protocol name. [current-protocol protocol-node (second children)]) "extend-type" (if (nil? current-protocol) ;; extend-type has a type name as it first symbol, ;; not a protocol name. We need to skip it. (let [snd (second children)] [(utils/symbol-from-token snd) snd (second (rest children))]) [sym c (second children)]) ;; The rest of the use cases have only protocol names in their body. [sym c (second children)]) [protocol-ns protocol-name] (if (or (not= "extend-protocol" def-by) (not protocol-ns)) (let [{pns :ns pname :name} (when protocol-name' (resolve-name ctx true ns-name protocol-name' nil))] [pns pname]) ;; we already have the resolved ns + name for extend-protocol [protocol-ns protocol-name])] (when (end? end-node) (namespace/reg-protocol-impl! ctx ns-name (merge (meta protocol-node) {:protocol-ns protocol-ns :protocol-name protocol-name' :methods methods}))) (recur protocol-name' (rest children) protocol-ns protocol-name protocol-node []))) ;; Assume protocol fn impl. Analyzing the fn sym can cause false ;; positives. We are passing it to analyze-fn as is, so (foo [x y z]) ;; is linted as (fn [x y z]) (let [fn-children (:children c) protocol-method-name (first fn-children) protocol-fn? (and (not= "extend-protocol" def-by) (not= "extend-type" def-by))] (when protocol-method-name (utils/handle-ignore ctx protocol-method-name)) (when (and current-protocol (not= "definterface" def-by)) (analysis/reg-protocol-impl! ctx (:filename ctx) ns-name protocol-ns protocol-name c protocol-method-name defined-by defined-by->lint-as)) ;; protocol-fn-name might contain metadata (meta/lift-meta-content2 ctx protocol-method-name) (utils/handle-ignore ctx c) (let [method-children (:children c) {:keys [fixed-arities varargs-min-arity]} (-> (if (and (not protocol-fn?) (= 'Class/forName (:value (first method-children)))) (when (str/starts-with? (try (sexpr (second method-children)) (catch Exception _ "")) "[") (findings/reg-finding! ctx (assoc (meta c) :filename (:filename ctx) :type :syntax :level :warning :message "Prefer a symbol to refer to the array class"))) (analyze-fn (update ctx :callstack #(cons [nil :protocol-method] %)) (assoc c :protocol-fn protocol-fn?))) meta :arity) methods (conj methods (let [val (:value protocol-method-name) val (if (qualified-symbol? val) (symbol (name val)) val)] (cond-> val (symbol? val) (with-meta (assoc (meta protocol-method-name) :impl-fixed-arities fixed-arities :impl-varargs-min-arity varargs-min-arity)))))] (when (end? (second children)) (namespace/reg-protocol-impl! ctx ns-name (assoc (meta protocol-node) :protocol-ns protocol-ns :protocol-name protocol-name :methods methods))) (recur current-protocol (rest children) protocol-ns protocol-name protocol-node methods)))))))) (defn analyze-defrecord "Analyzes defrecord and deftype." [{:keys [ns lang] :as ctx} expr defined-by defined-by->lint-as] (let [ns-name (:name ns) children (:children expr) children (next children) name-node (first children) name-node (meta/lift-meta-content2 ctx name-node) metadata (meta name-node) metadata (assoc metadata :defined-by defined-by :defined-by->lint-as defined-by->lint-as) record-name (:value name-node) binding-vector (second children) field-count (count (:children binding-vector)) bindings (extract-bindings (assoc ctx :mark-bindings-used? true) binding-vector expr {}) arglists? (:analyze-arglists? ctx) ctx (ctx-with-bindings ctx bindings)] (when (and record-name bindings) (namespace/reg-var! ctx ns-name record-name expr (cond-> metadata (identical? :clj lang) (assoc :class true))) (namespace/reg-imports! ctx ns-name {(with-meta record-name {:clj-kondo/mark-used true}) ns-name}) (when-not (identical? :off (-> ctx :config :linters :duplicate-field :level)) (doseq [[_ fields] (group-by identity (:children binding-vector))] (when (> (count fields) 1) (doseq [field fields] (findings/reg-finding! ctx (node->line (:filename ctx) field :duplicate-field (format "Duplicate field name: %s" (:value field)))))))) (namespace/reg-var! ctx ns-name (symbol (str "->" record-name)) expr (assoc-some metadata :arglist-strs (when arglists? [(str binding-vector)]) :fixed-arities #{field-count})) (when (= "defrecord" (name defined-by->lint-as)) (namespace/reg-var! ctx ns-name (symbol (str "map->" record-name)) expr (assoc-some metadata :arglist-strs (when arglists? ["[m]"]) :fixed-arities #{1}))) (analyze-protocol-impls ctx defined-by defined-by->lint-as ns-name (nnext children))))) (defn analyze-defmethod [ctx expr] (when-let [children (next (:children expr))] (let [[method-name-node dispatch-val-node & fn-tail] children ctx-without-idx (dissoc ctx :idx :len) _ (analyze-usages2 (assoc ctx-without-idx :defmethod true, :dispatch-val-str (pr-str (sexpr dispatch-val-node))) method-name-node) _ (analyze-expression** ctx-without-idx dispatch-val-node)] (analyze-fn ctx-without-idx (with-meta {:children (cons nil fn-tail)} (meta expr)))))) (defn analyze-areduce [ctx expr] (let [children (next (:children expr)) [array-expr index-binding-expr ret-binding-expr init-expr body] children index-binding (extract-bindings ctx index-binding-expr expr {}) ret-binding (extract-bindings ctx ret-binding-expr expr {}) bindings (merge index-binding ret-binding) analyzed-array-expr (analyze-expression** ctx array-expr) analyzed-init-expr (analyze-expression** ctx init-expr) analyzed-body (analyze-expression** (ctx-with-bindings ctx bindings) body)] (concat analyzed-array-expr analyzed-init-expr analyzed-body))) (defn analyze-this-as [ctx expr] (let [[binding-expr & body-exprs] (next (:children expr)) binding (extract-bindings ctx binding-expr expr {})] (analyze-children (ctx-with-bindings ctx binding) body-exprs))) (defn analyze-as-> [ctx expr] (let [children (next (:children expr)) [as-expr name-expr & forms-exprs] children analyzed-as-expr (analyze-expression** ctx as-expr) binding (extract-bindings ctx name-expr expr {})] (concat analyzed-as-expr (analyze-children (ctx-with-bindings ctx binding) forms-exprs)))) (defn analyze-memfn [ctx expr] (analyze-children (utils/ctx-with-linter-disabled ctx :unresolved-symbol) (next (:children expr)))) (defn analyze-import-libspec [ctx ns-name expr] (let [libspec-expr (if (= :quote (tag expr)) (first (:children expr)) expr) analyzed (namespace-analyzer/analyze-import ctx ns-name libspec-expr)] (namespace/reg-imports! ctx ns-name analyzed))) (defn analyze-import [ctx expr] (let [ns-name (-> ctx :ns :name) children (next (:children expr))] (run! #(analyze-import-libspec ctx ns-name %) children))) (defn- narrowing-from-condition "When `condition` is `(pred local)` with `pred` a known core type predicate and `local` a binding, returns [sym tag]: the binding to narrow and the type it is narrowed to when the condition holds. Returns nil otherwise." [ctx condition] (when (identical? :list (tag condition)) (let [[f arg & more] (:children condition)] (when (and f arg (nil? more) (identical? :token (tag f)) (identical? :token (tag arg))) ;; predicate->tag and bindings lookups already constrain fsym and asym (when-let [t (get types/predicate->tag (:value f))] (let [asym (:value arg)] (when (and (get (:bindings ctx) asym) ;; resolution is the costly check, so gate it behind the rest (namespace/core-symbol-in-scope? ctx (:value f))) [asym t]))))))) (defn narrow-binding "Returns ctx with binding `sym` narrowed to `tag` for the current scope. The tag is stored in the binding's metadata, which binding equality ignores." [ctx [sym tag]] (update-in ctx [:bindings sym] vary-meta assoc :narrowed-tag tag)) (defn analyze-if "Analyzes if special form for arity errors" [ctx expr lint-as?] (let [args (rest (:children expr))] (when-let [[expr msg linter] (case (count args) (0 1) [expr "Too few arguments to if." :syntax] (2 3) nil [expr "Too many arguments to if." :syntax])] (findings/reg-finding! ctx (node->line (:filename ctx) expr linter msg))) (let [[condition & clauses] args [then else] clauses narrowing (when-not (linter-disabled? ctx :type-mismatch) (narrowing-from-condition ctx condition))] (analyze-condition ctx condition (not (or lint-as? (:clj-kondo.impl/generated expr)))) (let [branch-ctx (in-branch-ctx ctx)] (if narrowing (let [branch-ctx (assoc branch-ctx :len (count clauses))] (concat (analyze-expression** (-> branch-ctx (assoc :idx 0) (narrow-binding narrowing)) then) (when else (analyze-expression** (assoc branch-ctx :idx 1) else)))) (analyze-children branch-ctx clauses false)))))) (defn analyze-if-not "Analyzes if-not macro" [ctx expr lint-as?] (let [[condition & clauses] (rest (:children expr))] (analyze-condition ctx condition (not (or lint-as? (:clj-kondo.impl/generated expr)))) (analyze-children (in-branch-ctx ctx) clauses false))) (defn analyze-is [ctx expr lint-as?] (let [[condition & body] (rest (:children expr))] (when condition (analyze-condition ctx condition (not (or lint-as? (:clj-kondo.impl/generated expr))))) (analyze-children ctx body false))) (defn analyze-constructor "Analyzes (new Foo ...) constructor call." [ctx expr] (let [[_ ctor-node & children] (:children expr)] (analyze-expression** (assoc ctx :constructor-expr expr) ctor-node) (analyze-children ctx children))) (defn analyze-set! [ctx expr] (let [children (next (:children expr))] (if (and (identical? :cljs (:lang ctx)) (= 3 (count children))) ;; ignore second argument which is the field, e.g. (set! o -x 3) (analyze-children ctx (cons (first children) (nnext children))) (analyze-children ctx children)))) (defn analyze-with-redefs [ctx expr] (let [call (-> (:callstack ctx) first second) ;; can be with-redefs or binding children (next (:children expr)) binding-vector (assert-vector ctx call (first children)) _ (when binding-vector (lint-even-forms-bindings! ctx call binding-vector)) bindings (:children binding-vector) lhs (take-nth 2 bindings) rhs (take-nth 2 (rest bindings)) body (next children)] ;; NOTE: because of lazy evaluation we need to use dorun! (let [ctx (update ctx :callstack conj [nil :vector])] (dorun (analyze-children (utils/ctx-with-linter-disabled ctx :private-call) lhs)) (dorun (analyze-children ctx rhs))) (analyze-children ctx body))) (defn analyze-def-catch-all [ctx expr] (let [ns-name (-> ctx :ns :name) children (next (:children expr)) name-expr (->> (first children) (meta/lift-meta-content2 ctx)) name-sym (:value name-expr) body (next children) ctx (utils/ctx-with-linters-disabled ctx [:invalid-arity :unresolved-symbol :unresolved-namespace :type-mismatch :private-call :missing-docstring])] (when name-sym (namespace/reg-var! ctx ns-name name-sym expr (meta name-expr))) (run! #(analyze-usages2 ctx %) body))) (defn analyze-when [ctx expr op lint-as?] (let [children (next (:children expr)) condition (first children) body (next children) ;; when-not negates the condition, so narrow only for when narrowing (when (and (= 'when op) (not (linter-disabled? ctx :type-mismatch))) (narrowing-from-condition ctx condition))] ;; analyze-condition marks the condition node with :condition true, which ;; analyze-do / unused-value consult to avoid treating the test as an ;; implicit-do body of when/when-not. (analyze-condition ctx condition (not (or lint-as? (:clj-kondo.impl/generated expr)))) (if-not (seq body) (findings/reg-finding! ctx (node->line (:filename ctx) expr :missing-body-in-when "Missing body in when")) (analyze-children (in-branch-ctx (cond-> ctx narrowing (narrow-binding narrowing))) body false)))) (defn analyze-clojure-string-replace [ctx expr] (let [children (next (:children expr)) arg-types (:arg-types ctx)] (dorun (analyze-children ctx children false)) (when arg-types (let [types @arg-types types (rest (map :tag types)) match-type (types/keyword (first types)) matcher-type (second types) matcher-type (types/keyword matcher-type)] (when (and match-type matcher-type (not (identical? matcher-type :any))) (case match-type :string (when (not (types/match? matcher-type :nilable/string)) (findings/reg-finding! ctx (node->line (:filename ctx) (last children) :type-mismatch (str "String match arg requires string replacement arg, received: " (types/label matcher-type))))) :char (when (not (types/match? matcher-type :char)) (findings/reg-finding! ctx (node->line (:filename ctx) (last children) :type-mismatch (str "Char match arg requires char replacement arg, received: " (types/label matcher-type))))) :regex (when (not (or (types/match? matcher-type :nilable/string) (and (types/match? matcher-type :ifn) (not (identical? :keyword matcher-type))))) (findings/reg-finding! ctx (node->line (:filename ctx) (last children) :type-mismatch (str "Regex match arg requires string or function replacement arg, received: " (types/label matcher-type))))) nil)))))) (defn analyze-proxy-super [ctx expr] (let [bindings (:bindings ctx)] (when-let [this-binding (get bindings 'this)] (let [ns-name (-> ctx :ns :name)] (namespace/reg-used-binding! ctx ns-name this-binding nil)))) (analyze-children ctx (nnext (:children expr)) false)) (defn analyze-amap [ctx expr] (let [[_ array idx-binding ret-binding body] (:children expr) ctx (ctx-with-bindings ctx (into {} (map #(extract-bindings ctx % expr {}) [idx-binding ret-binding])))] (analyze-children ctx [array body] false))) (defn analyze-format-string [ctx format-str-node format-str args] (let [;; we aren't interested in %% or %n format-str (str/replace format-str #"%[%n]" "") percents (re-seq #"%.[^\s%]*" format-str) [indexed unindexed] (reduce (fn [[indexed unindexed] percent] (if-let [[_ pos] (re-find #"^%(\d+)\$" percent)] [(max indexed (Integer/parseInt pos)) unindexed] [indexed (cond-> unindexed (not= \< (.charAt ^String percent 1)) inc)])) [0 0] percents) percent-count (max indexed unindexed) arg-count (count args) counts-match? (= percent-count arg-count)] (when-not counts-match? (findings/reg-finding! ctx (node->line (:filename ctx) format-str-node :format (format "Format string expects %s arguments instead of %s." percent-count arg-count)))) (when (and (zero? percent-count) counts-match? (not (linter-disabled? ctx :redundant-format))) (findings/reg-finding! ctx (node->line (:filename ctx) format-str-node :redundant-format "Format string contains no format specifiers"))))) (defn analyze-format [ctx expr] (let [children (next (:children expr)) format-str-node (first children) format-str (string-from-token format-str-node)] (when format-str (analyze-format-string ctx format-str-node format-str (rest children))) (analyze-children ctx children false))) (defn analyze-formatted-logging [ctx expr resolved-as-name] (let [children (next (:children expr))] (loop [attempt 0 args (cond-> (seq children) (= 'logf resolved-as-name) rest)] (when-first [a args] (if-let [format-str (string-from-token a)] (analyze-format-string ctx a format-str (rest args)) (when (zero? attempt) ;; format string can be either the first or second argument (recur (inc attempt) (rest args)))))) (analyze-children ctx children false))) (defn analyze-hof [ctx expr resolved-as-name hof-ns-name hof-resolved-name] (let [children (next (:children expr)) core-ns? (or (= 'clojure.core hof-ns-name) (= 'cljs.core hof-ns-name)) [prepending-n f-pos f-args-n] (cond (and core-ns? (or (= 'update hof-resolved-name) (= 'update-in hof-resolved-name) (= 'send-via hof-resolved-name))) [2 2 3] (and core-ns? (or (= 'swap! hof-resolved-name) (= 'swap-vals! hof-resolved-name) (= 'send hof-resolved-name) (= 'send-off hof-resolved-name))) [1 1 2] :else [0 0 1]) [prepending f f-args] [(take prepending-n children) (nth children f-pos nil) (drop f-args-n children)] ;; _ (prn :prepending prepending :f f :f-args f-args) _ (analyze-children ctx prepending false) fana (analyze-expression** ctx f) t (tag f) fsym (utils/symbol-from-token f) binding (get (:bindings ctx) fsym) ;; a local passed by name has its fn info in :arities, a literal ;; carries it on its analysis meta. The shapes differ, the arity ;; data sits at different spots, but :pending-infer is top-level ;; in both finfo (if binding (get (:arities ctx) fsym) (meta fana)) arity (if binding finfo (:arity finfo)) ;; the hof invokes its fn argument right here: commit its dormant ;; constraints _ (when-let [pending (:pending-infer finfo)] (types/activate-pending! ctx pending)) ns (:ns ctx) var? (and fsym (not binding)) ns-name (:name ns) {resolved-namespace :ns resolved-name :name resolved-alias :alias unresolved? :unresolved? unresolved-ns :unresolved-ns clojure-excluded? :clojure-excluded? interop? :interop? resolved-core? :resolved-core? :as _m} (when var? (resolve-name ctx true ns-name fsym nil)) var? (and fsym (not binding)) arg-count (cond (one-of resolved-as-name [map mapv mapcat]) (count f-args) (one-of resolved-as-name [update update-in send send-off send-via swap! swap-vals!]) (inc (count f-args)) (one-of resolved-as-name [reduce map-indexed keep-indexed]) 2 :else 1) transducer-eligable? (one-of resolved-as-name [map filter remove mapcat map-indexed keep keep-indexed]) arg-count (if (and transducer-eligable? (zero? arg-count)) ;; transducer (when-not (and core-ns? (or (= 'map hof-resolved-name) (= 'mapcat hof-resolved-name))) 1) arg-count) ctx (update ctx :callstack (fn [cs] ;; the pseudo-frame for the hof'd fn shadows the hof ;; call's own entry, but the remaining args are still ;; positionally the hof's args, so its ::types/infer-call ;; moves along (cons (if-let [ic (some-> (first cs) meta ::types/infer-call)] (with-meta [resolved-namespace resolved-name] {::types/infer-call ic}) [resolved-namespace resolved-name]) cs)))] (cond var? (let [{:keys [row end-row col end-col]} (meta f)] (when (:analyze-var-usages? ctx) (namespace/reg-var-usage! ctx ns-name (utils/var-usage ;; :hof-call: arity-checked like a call, ;; but not a syntactic call {:type (if arg-count :hof-call :usage) :resolved-ns resolved-namespace :ns ns-name :name (with-meta (or resolved-name fsym) (meta fsym)) :alias resolved-alias :unresolved? unresolved? :in-comment (:in-comment ctx) :unresolved-ns unresolved-ns :clojure-excluded? clojure-excluded? :arity arg-count :row row :end-row end-row :col col :end-col end-col :base-lang (:base-lang ctx) :lang (:lang ctx) :filename (:filename ctx) ;; save some memory during dependencies :expr (when-not (:dependencies ctx) expr) :simple? (simple-symbol? fsym) :callstack (:callstack ctx) :condition (:condition expr) :config (:config ctx) :top-ns (:top-ns ctx) ;; :arg-types (:arg-types ctx) :interop? interop? :resolved-core? resolved-core? :in-def (:in-def ctx) :derived-location (:derived-location (meta expr))})))) (and arity arg-count) (let [{:keys [fixed-arities varargs-min-arity]} arity config (:config ctx) callstack (:callstack ctx)] (when-not (config/skip? config :invalid-arity callstack) (let [filename (:filename ctx)] (when-not (linter-disabled? ctx :invalid-arity) (when-not (arity-match? fixed-arities varargs-min-arity arg-count) (let [fst-ana (first fana) fn-name (or fsym (:name fst-ana))] (findings/reg-finding! ctx (node->line filename f :invalid-arity (linters/arity-error nil fn-name arg-count fixed-arities varargs-min-arity))))))))) (one-of t [:map :set :vector]) (let [expected (case t :map #{1 2} (:set :vector) #{1})] (when-not (contains? expected arg-count) (findings/reg-finding! ctx (node->line (:filename ctx) f :invalid-arity (linters/arity-error nil (str/capitalize (name t)) arg-count expected nil)))))) (when (and (not (linter-disabled? ctx :reduce-without-init)) (= 'reduce hof-resolved-name) (or (= 'clojure.core hof-ns-name) (= 'clojure.cljs hof-ns-name)) (= 2 (count children)) (not (one-of [resolved-namespace resolved-name] [[clojure.core +] [cljs.core +] [clojure.core *] [cljs.core *]])) (not (config/reduce-without-init-excluded? (:config ctx) (symbol (str resolved-namespace) (str resolved-name))))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :reduce-without-init "Reduce called without explicit initial value."))) (concat fana (analyze-children ctx f-args false)))) (defn- analyze-associative [ctx children fn-name ks] (loop [[k & ks] (filter (fn [node] (or (utils/constant? node) (utils/symbol-token? node))) ks) k-count {}] (when (= 1 (k-count k)) ;; Only register finding on first duplicate (findings/reg-finding! ctx (assoc (meta k) :filename (:filename ctx) :type :duplicate-key-args :message (str "Duplicate key arg supplied to " fn-name ": " k)))) (if (seq ks) (recur ks (update k-count k (fnil inc 0))) (analyze-children ctx children false)))) (defn analyze-assoc [ctx expr] (let [[fn-name & children] (:children expr) [_obj & ks+vs] children ks (take-nth 2 ks+vs)] (analyze-associative ctx children fn-name ks))) (defn analyze-dissoc [ctx expr] (let [[fn-name & children] (:children expr) [_obj & ks] children] (analyze-associative ctx children fn-name ks))) (defn analyze-map [ctx expr] (let [[fn-name & children] (:children expr) ks (take-nth 2 children)] (analyze-associative ctx children fn-name ks))) (defn analyze-hash-set [ctx expr] (let [[fn-name & children] (:children expr)] (analyze-associative ctx children fn-name children))) (defn analyze-ns-unmap [ctx base-lang lang ns-name expr] (let [[ns-expr sym-expr :as children] (rest (:children expr))] (when (= '*ns* (:value ns-expr)) (let [t (tag sym-expr)] (when (identical? :quote t) (let [sym-node (first (:children sym-expr)) sym (:value sym-node) sym-meta (meta sym-node)] (when (simple-symbol? sym) (let [nss (:namespaces ctx) excluded-meta (assoc-some sym-meta :name (:name sym) :name-row (:row sym-meta) :name-col (:col sym-meta) :name-end-row (:end-row sym-meta) :name-end-col (:end-col sym-meta) :filename (:filename ctx))] (swap! nss update-in [base-lang lang ns-name] (fn [ns] (-> ns (update :clojure-excluded (fnil conj #{}) (with-meta sym excluded-meta)) (update :vars dissoc sym) (update :var-counts dissoc sym)))))))))) (analyze-children ctx children))) (defn analyze-gen-class [ctx _expr base-lang lang current-ns] ;; for now we just ignore the form to not cause false positives ;; we can add more sophisticated linting, e.g. causing -init to be used (swap! (:namespaces ctx) assoc-in [base-lang lang current-ns :gen-class] true) nil) (defn analyze-gen-interface [ctx expr] ;; for now we just ignore the form to not cause false positives ;; we can add more sophisticated linting, e.g. causing -init to be used (let [ctx (utils/ctx-with-linter-disabled ctx :unresolved-symbol)] (analyze-children ctx expr))) (defn analyze-extend-type-children "Used for analyzing children of extend-protocol, extend-type, reify and specify! " [ctx children defined-by defined-by->lint-as] (analyze-protocol-impls ctx defined-by defined-by->lint-as (-> ctx :ns :name) children)) (defn analyze-reify [ctx expr defined-by defined-by->lint-as] (let [children (next (:children expr))] (analyze-extend-type-children ctx children defined-by defined-by->lint-as))) (defn analyze-extend-type [ctx expr defined-by defined-by->lint-as] (let [children (next (:children expr))] (analyze-extend-type-children ctx children defined-by defined-by->lint-as))) (defn analyze-specify! [ctx expr defined-by defined-by->lint-as] (let [children (next (:children expr)) expr (first children) _ (analyze-expression** ctx expr)] (analyze-extend-type ctx {:children children} defined-by defined-by->lint-as))) (defn analyze-cljs-exists? [ctx expr] (run! #(analyze-usages2 (utils/ctx-with-linters-disabled ctx [:unresolved-symbol :unresolved-namespace]) %) (next (:children expr)))) (defn- analyze-instance-invocation [ctx expr children] ;; see https://clojure.org/reference/java_interop#dot (findings/warn-reflection ctx expr) (let [[instance meth & args] children] ;; TODO, warning if no instance. Instance is required (when instance (analyze-expression** ctx instance)) (when meth (if (and (identical? :list (tag meth)) (not args)) (let [[meth & children] (:children meth)] (analysis/reg-instance-invocation! ctx meth) (analyze-children ctx children)) (analysis/reg-instance-invocation! ctx meth))) (when args (analyze-children ctx args)))) (def with-precision-bindings (zipmap '[CEILING, FLOOR, HALF_UP, HALF_DOWN, HALF_EVEN, UP, DOWN, UNNECESSARY] (repeat {}))) (defn- analyze-with-precision [ctx _expr children] (analyze-children (ctx-with-bindings ctx with-precision-bindings) children)) (defn- analyze-=-not= [ctx expr var-name] (let [[lhs rhs :as children] (rest (:children expr)) var=? (= '= var-name) ;; need to analyze children, to pick up on ignores in arguments res (analyze-children ctx children false)] (when (= 2 (count children)) (when (and var=? (or (true? (:value lhs)) (true? (:value rhs))) (not (or (:clj-kondo.impl/generated lhs) (:clj-kondo.impl/generated rhs)))) (findings/reg-finding! ctx (assoc (meta expr) :type :equals-true :message "Prefer (true? x) over (= true x)" :filename (:filename ctx)))) (let [cfg (-> ctx :config :linters :equals-expected-position) level (:level cfg) pos (:position cfg) only-in-test-assertion (:only-in-test-assertion cfg)] (when-let [expr (when-not (identical? :off level) (or (and (identical? :first pos) (utils/constant? rhs) (not (utils/constant? lhs)) (or (not only-in-test-assertion) (one-of (second (:callstack ctx)) [[cljs.test is] [clojure.test is]])) rhs) (and (identical? :last pos) (utils/constant? lhs) (not (utils/constant? rhs)) (or (not only-in-test-assertion) (one-of (second (:callstack ctx)) [[cljs.test is] [clojure.test is]])) lhs)))] (findings/reg-finding! ctx (assoc (meta expr) :type :equals-expected-position :message (str "Write expected value " (name pos)) :filename (:filename ctx)))) (when (and var=? (or (false? (:value lhs)) (false? (:value rhs)))) (findings/reg-finding! ctx (assoc (meta expr) :type :equals-false :message "Prefer (false? x) over (= false x)" :filename (:filename ctx)))) (when (and var=? (or (= "nil" (:string-value lhs)) (= "nil" (:string-value rhs))) (not (or (:clj-kondo.impl/generated lhs) (:clj-kondo.impl/generated rhs)))) (findings/reg-finding! ctx (assoc (meta expr) :type :equals-nil :message "Prefer (nil? x) over (= nil x)" :filename (:filename ctx)))))) res)) (defn- analyze-+- [ctx sym expr] (let [plus? (= '+ sym) minus? (= '- sym) [lhs rhs :as children] (rest (:children expr))] (when (and (= 2 (count children)) (or (and plus? (= 1 (:value lhs))) (= 1 (:value rhs)))) (when (or plus? minus?) (findings/reg-finding! ctx (assoc (meta expr) :type (if plus? :plus-one :minus-one) :message (if plus? "Prefer (inc x) over (+ 1 x)" "Prefer (dec x) over (- x 1)") :filename (:filename ctx))))) (analyze-children ctx children false))) (defn- analyze-var [ctx expr children] (when (utils/lint-condition? expr) (constant-condition-linter ctx expr)) (analyze-children (assoc ctx :private-access? true) children)) (defn- analyze-locking [ctx expr] (let [args (:arg-types ctx) children (rest (:children expr)) ret (analyze-children ctx children false) t (:tag (some-> args deref first)) obj (first children)] (let [only-object? (= 1 (count children)) no-symbol? (and (not (utils/symbol-from-token obj)) (= :list (tag obj))) interned-object? (and t (not= :any t) (or (one-of t [:keyword :string :boolean :number]) (contains? (types/is-a-relations t) :number)))] (when (or only-object? no-symbol? interned-object?) (findings/reg-finding! ctx (assoc (meta obj) :filename (:filename ctx) :type :locking-suspicious-lock :message (str "Suspicious lock object: " (cond only-object? "no body provided" interned-object? "use of interned object" no-symbol? "object is local to locking scope")))))) ret)) (defn- analyze-defstruct [ctx expr _defined-by _defined-by->lint-as] (let [[fn-name struct-name & fields] (:children expr) ns-name (-> ctx :ns :name)] (when-let [sym (utils/symbol-from-token struct-name)] (namespace/reg-var! ctx ns-name sym expr)) (analyze-associative ctx fields fn-name fields))) (defn- analyze-rest [ctx children] (when-not (identical? :off (-> ctx :config :linters :seq-rest :level)) ;; rest is usually less used than seq, hence avoiding the `analyze-seq` route (let [[parent-ns parent-fn :as parent] (second (:callstack ctx))] (when (and (one-of parent-ns [clojure.core cljs.core]) (= 'seq parent-fn)) (findings/reg-finding! ctx (node->line (:filename ctx) parent ; Makes more sense to warn on the parent expr :seq-rest "Prefer (next x) over (seq (rest x))"))))) (analyze-children ctx children false)) (defn analyze-unknown-ns-call ;; catch-all for calls no built-in analyzer handles [ctx children resolved-namespace resolved-name unresolved?] (let [next-ctx (cond-> ctx (one-of [resolved-namespace resolved-name] [[clojure.core.async thread] [clojure.core dosync] [clojure.core future] [clojure.core lazy-seq] [clojure.core lazy-cat]]) (-> (assoc-in [:recur-arity :fixed-arity] 0) (assoc :seen-recur? (volatile! nil)) (dissoc :protocol-fn)) ;; an unresolved call could be a macro, ;; treat its args as conditionally ;; evaluated, like a when body unresolved? (in-branch-ctx))] (analyze-children next-ctx children false))) (defn analyze-test-ns-call ;; clojure.test / cljs.test / test.check branches of analyze-known-ns-call [ctx expr children resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?] (case [resolved-as-namespace resolved-as-name] ([clojure.test deftest] [clojure.test deftest-] [cljs.test deftest]) (do (lint-inline-def! ctx expr) (test/analyze-deftest ctx expr defined-by defined-by->lint-as)) [cljs.test async] (test/analyze-cljs-test-async ctx expr) ([clojure.test are] [cljs.test are]) (test/analyze-are ctx resolved-namespace expr) ([clojure.test is] [cljs.test is]) (analyze-is ctx expr lint-as?) ([clojure.test.check.properties for-all]) (analyze-like-let ctx expr) [clojure.test.check.clojure-test defspec] (do (lint-inline-def! ctx expr) (test/analyze-defspec ctx expr defined-by defined-by->lint-as)) (analyze-unknown-ns-call ctx children resolved-namespace resolved-name unresolved?))) (defn analyze-spec-ns-call ;; spec.alpha / spec.gen.alpha branches of analyze-known-ns-call [ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?] (case [resolved-as-namespace resolved-as-name] [cljs.spec.alpha def] (spec/analyze-def ctx expr 'cljs.spec.alpha/def) [clojure.spec.alpha def] (spec/analyze-def ctx expr 'clojure.spec.alpha/def) ([clojure.spec.alpha fdef] [cljs.spec.alpha fdef]) (spec/analyze-fdef (assoc ctx :analyze-children analyze-children) expr) ([clojure.spec.alpha keys] [cljs.spec.alpha keys]) (spec/analyze-keys ctx expr) ([clojure.spec.gen.alpha lazy-combinators] [clojure.spec.gen.alpha lazy-prims] [cljs.spec.gen.alpha lazy-combinators] [cljs.spec.gen.alpha lazy-prims]) (analyze-declare ctx expr defined-by defined-by->lint-as) (analyze-unknown-ns-call ctx children resolved-namespace resolved-name unresolved?))) (defn analyze-re-frame-ns-call ;; re-frame.core branches of analyze-known-ns-call [ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name unresolved?] (case [resolved-as-namespace resolved-as-name] ([re-frame.core reg-event-db] [re-frame.core reg-event-ctx] [re-frame.core reg-sub-raw] [re-frame.core reg-fx] [re-frame.core reg-cofx]) (re-frame/analyze-reg ctx expr (symbol (str resolved-namespace) (str resolved-name))) ([re-frame.core subscribe]) (re-frame/analyze-subscribe ctx expr (str resolved-namespace)) ([re-frame.core dispatch] [re-frame.core dispatch-sync]) (re-frame/analyze-dispatch ctx expr (str resolved-namespace)) ([re-frame.core reg-sub]) (re-frame/analyze-reg-sub ctx expr (symbol (str resolved-namespace) (str resolved-name))) ([re-frame.core reg-event-fx]) (re-frame/analyze-reg-event-fx ctx expr (symbol (str resolved-namespace) (str resolved-name))) ([re-frame.core inject-cofx]) (re-frame/analyze-inject-cofx ctx expr (str resolved-namespace)) (analyze-unknown-ns-call ctx children resolved-namespace resolved-name unresolved?))) (defn analyze-lib-ns-call ;; remaining library-specific branches of analyze-known-ns-call [ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?] (case [resolved-as-namespace resolved-as-name] [clj-kondo.lint-as def-catch-all] (analyze-def-catch-all ctx expr) [schema.core fn] (analyze-schema ctx 'fn expr 'schema.core/fn defined-by->lint-as) [schema.core def] (analyze-schema ctx 'def expr 'schema.core/def defined-by->lint-as) [schema.core defn] (analyze-schema ctx 'defn expr 'schema.core/defn defined-by->lint-as) [schema.core defmethod] (analyze-schema ctx 'defmethod expr 'schema.core/defmethod defined-by->lint-as) [schema.core defrecord] (analyze-schema ctx 'defrecord expr 'schema.core/defrecord defined-by->lint-as) [schema.core defprotocol] (analyze-schema ctx 'defprotocol expr 'schema.core/defprotocol defined-by->lint-as) ([clojure.core.match match] [cljs.core.match match]) (match/analyze-match ctx expr) [clojure.string replace] (analyze-clojure-string-replace ctx expr) [potemkin import-vars] (potemkin/analyze-import-vars ctx expr utils/ctx-with-linters-disabled 'potemkin/import-vars defined-by->lint-as) ([potemkin import-fn] [potemkin import-macro] [potemkin import-def]) (potemkin/analyze-import-fn ctx expr utils/ctx-with-linters-disabled defined-by defined-by->lint-as) ([clojure.core.async alt!] [clojure.core.async alt!!] [cljs.core.async alt!] [cljs.core.async alt!!]) (core-async/analyze-alt! (assoc ctx :analyze-expression** analyze-expression** :extract-bindings extract-bindings) expr) ([clojure.core.async defblockingop] [clojure.core.async defparkingop]) (analyze-defn ctx expr defined-by defined-by->lint-as) ([clojure.core.reducers defcurried]) (analyze-defn ctx expr defined-by defined-by->lint-as) ([clojure.template do-template]) (analyze-expression** ctx (macroexpand/expand-do-template ctx expr)) ([clojure.core locking]) (analyze-locking ctx expr) ([datahike.api q] [datascript.core q] [datomic.api q] [datomic.client.api q] [datalevin.core q] [datomic-type-extensions.api q]) (do (datalog/analyze-datalog ctx expr) (analyze-children ctx children false)) ([compojure.core GET] [compojure.core POST] [compojure.core PUT] [compojure.core DELETE] [compojure.core HEAD] [compojure.core OPTIONS] [compojure.core PATCH] [compojure.core ANY] [compojure.core context] [compojure.core rfn]) (compojure/analyze-compojure-macro ctx expr resolved-as-name) ([clojure.java.jdbc with-db-transaction] [clojure.java.jdbc with-db-connection] [clojure.java.jdbc with-db-metadata] [next.jdbc with-transaction]) (jdbc/analyze-like-jdbc-with ctx expr) ([clojure.tools.logging debugf] [clojure.tools.logging infof] [clojure.tools.logging errorf] [clojure.tools.logging logf] [clojure.tools.logging spyf] [clojure.tools.logging tracef] [clojure.tools.logging warnf]) (analyze-formatted-logging ctx expr resolved-as-name) [clojure.data.xml alias-uri] (xml/analyze-alias-uri ctx expr) [clojure.data.xml.impl export-api] (xml/analyze-export-api ctx expr) [cljs.core simple-benchmark] (analyze-like-let ctx expr) [babashka.process $] (babashka/analyze-$ ctx expr) (analyze-unknown-ns-call ctx children resolved-namespace resolved-name unresolved?))) (defn analyze-known-ns-call ;; dispatch on the namespace first, then per-family on [ns name] [ctx expr children resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?] (case resolved-as-namespace (clojure.test cljs.test clojure.test.check.properties clojure.test.check.clojure-test) (analyze-test-ns-call ctx expr children resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?) (clojure.spec.alpha cljs.spec.alpha clojure.spec.gen.alpha cljs.spec.gen.alpha) (analyze-spec-ns-call ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?) re-frame.core (analyze-re-frame-ns-call ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name unresolved?) (clj-kondo.lint-as schema.core clojure.core.match cljs.core.match clojure.string potemkin clojure.core.async cljs.core.async clojure.core.reducers clojure.template clojure.core cljs.core datahike.api datascript.core datomic.api datomic.client.api datalevin.core datomic-type-extensions.api compojure.core clojure.java.jdbc next.jdbc clojure.tools.logging clojure.data.xml clojure.data.xml.impl babashka.process) (analyze-lib-ns-call ctx expr children resolved-as-namespace resolved-as-name resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?) (analyze-unknown-ns-call ctx children resolved-namespace resolved-name unresolved?))) (defn analyze-known-call [ctx expr children config ns-name lang base-lang resolved-as-clojure-var-name resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name top-level? defined-by defined-by->lint-as unresolved?] (case resolved-as-clojure-var-name (assoc assoc! sorted-map-by struct-map) (analyze-assoc ctx expr) (dissoc dissoc! disj disj! sorted-set-by) (analyze-dissoc ctx expr) (array-map hash-map sorted-map) (analyze-map ctx expr) (hash-set sorted-set create-struct) (analyze-hash-set ctx expr) ns (when top-level? [(analyze-ns-decl ctx expr)]) in-ns (if top-level? [(analyze-in-ns ctx expr)] (analyze-children ctx children)) alias [(analyze-alias ctx expr)] declare (analyze-declare ctx expr defined-by defined-by->lint-as) (def defonce defmulti goog-define) (do (lint-inline-def! ctx expr) (analyze-def ctx expr defined-by defined-by->lint-as)) (defn defn- defmacro definline) (do (lint-inline-def! ctx expr) (analyze-defn ctx expr defined-by defined-by->lint-as)) defmethod (analyze-defmethod ctx expr) (definterface defprotocol) (analyze-defprotocol ctx expr defined-by defined-by->lint-as) (defrecord deftype) (analyze-defrecord ctx expr defined-by defined-by->lint-as) (defstruct) (analyze-defstruct ctx expr defined-by defined-by->lint-as) comment (let [cfg (:config-in-comment config) ctx (if cfg (assoc ctx :config (config/merge-config! config cfg)) ctx) ctx (assoc ctx :in-comment true)] (analyze-children ctx children)) -> (analyze-expression** ctx (macroexpand/expand-> ctx expr)) ->> (analyze-expression** ctx (macroexpand/expand->> ctx expr)) (some-> some->>) (analyze-expression** ctx (macroexpand/expand-some-> ctx expr resolved-as-name)) doto (analyze-expression** ctx (macroexpand/expand-doto ctx expr)) reify (analyze-reify ctx expr defined-by defined-by->lint-as) (extend-protocol extend-type) (analyze-extend-type ctx expr defined-by defined-by->lint-as) (specify!) (analyze-specify! ctx expr defined-by defined-by->lint-as) (.) (analyze-instance-invocation ctx expr children) (..) (analyze-expression** ctx (macroexpand/expand-double-dot ctx expr)) (proxy defcurried) ;; don't lint calls in these expressions, only register them as used vars (analyze-children (utils/ctx-with-linters-disabled ctx [:invalid-arity :unresolved-symbol :type-mismatch]) children) (proxy-super) (analyze-proxy-super ctx expr) (amap) (analyze-amap ctx expr) (cond-> cond->>) (analyze-expression** ctx (macroexpand/expand-cond-> ctx expr resolved-as-name)) (let let*) (analyze-let ctx expr) (for doseq dotimes with-open with-local-vars) (analyze-like-let ctx expr) letfn (analyze-letfn ctx expr) (if-let if-some when-let when-some when-first) (analyze-conditional-let ctx resolved-as-clojure-var-name expr lint-as?) do (analyze-do ctx expr) (fn fn* bound-fn) (analyze-fn ctx expr) case (analyze-case ctx expr) loop (analyze-loop ctx expr) recur (analyze-recur ctx expr) quote nil try (analyze-try ctx expr) as-> (analyze-as-> ctx expr) areduce (analyze-areduce ctx expr) this-as (analyze-this-as ctx expr) await (do (when (and (= 'cljs.core resolved-as-namespace) (not (:async-fn? ctx))) (findings/reg-finding! ctx (node->line (:filename ctx) expr :await-without-async-fn "Use of await is only allowed in functions with ^:async metadata."))) (analyze-children ctx children)) memfn (analyze-memfn ctx expr) (format printf) (analyze-format ctx expr) (use require) (if top-level? (namespace-analyzer/analyze-require ctx expr) (analyze-children ctx children)) import (if top-level? (analyze-import ctx expr) (analyze-children ctx children)) if (analyze-if ctx expr lint-as?) if-not (analyze-if-not ctx expr lint-as?) new (analyze-constructor ctx expr) set! (analyze-set! ctx expr) (= not=) (analyze-=-not= ctx expr resolved-as-clojure-var-name) (+ -) (analyze-+- ctx resolved-name expr) (with-redefs binding) (analyze-with-redefs ctx expr) (when when-not) (analyze-when ctx expr resolved-as-clojure-var-name lint-as?) ;; the first operand, the first cond test and the ;; condp pred and dispatch expr always evaluate, ;; everything after is conditional (cond and or) (concat (analyze-children ctx (take 1 children) false) (analyze-children (in-branch-ctx ctx) (rest children) false)) condp (concat (analyze-children ctx (take 2 children) false) (analyze-children (in-branch-ctx ctx) (drop 2 children) false)) (map mapv filter filterv remove reduce every? not-every? some not-any? mapcat iterate max-key min-key group-by partition-by map-indexed keep keep-indexed update update-in swap! swap-vals! send send-off send-via) (analyze-hof ctx expr resolved-as-name resolved-namespace resolved-name) (ns-unmap) (analyze-ns-unmap ctx base-lang lang ns-name expr) (gen-class) (analyze-gen-class ctx expr base-lang lang ns-name) (gen-interface) (analyze-gen-interface ctx expr) (exists?) (analyze-cljs-exists? ctx expr) (with-precision) (analyze-with-precision ctx expr children) (var) (analyze-var ctx expr children) (rest) (analyze-rest ctx children) ;; catch-all (analyze-known-ns-call ctx expr children resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name defined-by defined-by->lint-as unresolved?))) (defn analyze-call [{:keys [top-level? base-lang lang ns config dependencies] :as ctx} {:keys [arg-count full-fn-name row col expr] :as m}] (let [ns-name (:name ns) not-is-dot (and (not= '. full-fn-name) (not= '.. full-fn-name))] (cond (and not-is-dot (str/ends-with? full-fn-name ".") (simple-symbol? full-fn-name) (let [ns (namespace/get-namespace ctx (:base-lang ctx) lang ns-name)] (and (not (contains? (:referred-vars ns) full-fn-name)) (not (contains? (:vars ns) full-fn-name))))) (recur ctx (let [expr (macroexpand/expand-dot-constructor ctx expr)] (assoc m :expr expr :full-fn-name 'new :arg-count (inc (:arg-count m))))) (and not-is-dot (str/starts-with? full-fn-name ".")) (recur ctx (let [expr (macroexpand/expand-method-invocation ctx expr)] (assoc m :expr expr :full-fn-name '. :arg-count (inc (:arg-count m))))) :else (let [children (:children expr) name-node (first children) children (rest children) {resolved-namespace :ns resolved-name :name resolved-alias :alias unresolved? :unresolved? unresolved-ns :unresolved-ns clojure-excluded? :clojure-excluded? interop? :interop? resolved-core? :resolved-core? :as _m} (resolve-name ctx true ns-name full-fn-name expr) expr-meta (meta expr) resolved-var-sym (symbol (str resolved-namespace) (str resolved-name)) cfg (when-let [in-call-cfg (:config-in-call config)] (get in-call-cfg resolved-var-sym)) cfg (when cfg (config/expand-ignore cfg)) ctx (if cfg (update ctx :config config/merge-config! cfg) ctx) arg-types (when (and resolved-namespace resolved-name (not (linter-disabled? ctx :type-mismatch))) (atom [])) ctx (assoc ctx :arg-types arg-types)] (when (:in-or-default? ctx) (findings/reg-finding! ctx (assoc expr-meta :type :destructured-or-always-evaluates :filename (:filename ctx) :message "Default :or value is always evaluated."))) (cond unresolved-ns (let [fn-name (-> full-fn-name name symbol)] (when-not (:clj-kondo.impl/generated expr) (namespace/reg-unresolved-namespace! ctx ns-name (with-meta unresolved-ns (assoc (meta full-fn-name) :name fn-name)))) (analyze-children (in-branch-ctx (update ctx :callstack conj [:clj-kondo/unknown-namespace fn-name])) children)) :else (let [[resolved-as-namespace resolved-as-name lint-as?] (or (when-let [[ns n] (config/lint-as config resolved-var-sym)] [ns n true]) [resolved-namespace resolved-name false]) ;; See #1170, we deliberaly use resolved and not resolved-as ;; Users can get :lint-as like behavior for hooks by configuring ;; multiple fns to target the same hook code hook-fn (let [visited (:visited expr)] (when-not (and visited (= visited [resolved-namespace resolved-name])) (or (hooks/hook-fn ctx config resolved-namespace resolved-name expr-meta) (case [resolved-namespace resolved-name] ([clojure.test testing] [cljs.test testing]) (when (:analysis-context ctx) ;; only use testing hook when analysis is requested test/testing-hook) nil)))) transformed (when hook-fn ;;;; Expand macro using user-provided function (let [filename (:filename ctx)] (binding [utils/*ctx* ctx] (sci/binding [sci/out *out* sci/err *err* sci/file filename] (try (hook-fn {:node expr :cljc (identical? :cljc base-lang) :lang lang :filename filename :config config :ns ns-name :context (:context ctx)}) (catch Throwable e (findings/reg-finding! ctx (merge {:filename filename :row row :col col :type :hook :message (or (.getMessage e) (str e))} (select-keys (ex-data e) [:level :row :col]))) nil)))))) ctx (if-let [context (when transformed (:context transformed))] (assoc ctx :context context) ctx)] (if-let [expanded (and transformed (let [node (:node transformed)] (when-not (identical? expr node) node)))] (let [expanded (hooks/annotate expanded expr-meta) [new-name-node new-arg-count] (when (utils/list-node? expanded) (when-let [children (:children expanded)] [(first children) (dec (count children))])) same-call? (and new-name-node new-arg-count (= (tag name-node) (tag new-name-node)) (= full-fn-name (:value new-name-node)) (= arg-count new-arg-count)) expanded (assoc expanded :visited [resolved-namespace resolved-name])] ;;;; This registers the original call when the new node does not ;;;; refer to the same call, so we still get arity linting. ;;;; Only arity: the original arguments are never analyzed in ;;;; this position, so there are no arg types to check against. (when (and (:analyze-var-usages? ctx) (not same-call?)) (namespace/reg-var-usage! ctx ns-name (utils/var-usage {:type :call :resolved-ns resolved-namespace :ns ns-name :name (with-meta (or resolved-name full-fn-name) (meta full-fn-name)) :alias resolved-alias :unresolved? unresolved? :in-comment (:in-comment ctx) :unresolved-ns unresolved-ns :clojure-excluded? clojure-excluded? :arity arg-count :row row :end-row (:end-row expr-meta) :col col :end-col (:end-col expr-meta) :base-lang base-lang :lang lang :filename (:filename ctx) ;; save some memory during dependencies :expr (when-not dependencies expr) :simple? (simple-symbol? full-fn-name) :callstack (:callstack ctx) :condition (:condition expr) :config (:config ctx) :top-ns (:top-ns ctx) :interop? interop? :resolved-core? resolved-core? :idx (:idx ctx) :len (:len ctx) :derived-location (:derived-location expr-meta)}))) ;;;; This registers the namespace as used, to prevent unused warnings (namespace/reg-used-namespace! ctx ns-name resolved-namespace) (let [node expanded] (analyze-expression** (assoc-some ctx :defined-by (:defined-by transformed)) node))) ;;;; End macroexpansion (let [unknown-ns? (= :clj-kondo/unknown-namespace resolved-namespace) resolved-namespace* (if unknown-ns? ns-name resolved-namespace) ctx (if (and resolved-var-sym (not (= 'clojure.core/doto resolved-var-sym))) (let [cs-entry (with-meta [resolved-namespace* resolved-name] (cond-> expr-meta (:clj-kondo.impl/generated expr) (assoc :clj-kondo.impl/generated true) ;; a local usage directly under this ;; call may constrain a param, see ;; types/infer-local-usage! (and arg-types (:param-infers ctx) (not unresolved?)) (assoc ::types/infer-call [resolved-namespace resolved-name arg-count])))] (update ctx :callstack (fn [cs] (cons cs-entry cs)))) (update ctx :callstack conj [nil nil])) resolved-as-clojure-var-name (when (one-of resolved-as-namespace [clojure.core cljs.core]) resolved-as-name) ctx (if resolved-as-clojure-var-name (assoc ctx :resolved-as-clojure-var-name resolved-as-clojure-var-name) ctx) defined-by (or (:defined-by ctx) (when (and resolved-name resolved-namespace) (symbol (name resolved-namespace) (name resolved-name)))) defined-by->lint-as (or (:defined-by->lint-as ctx) (when (and resolved-as-name resolved-as-namespace) (symbol (name resolved-as-namespace) (name resolved-as-name)))) analyzed (analyze-known-call ctx expr children config ns-name lang base-lang resolved-as-clojure-var-name resolved-as-namespace resolved-as-name lint-as? resolved-namespace resolved-name top-level? defined-by defined-by->lint-as unresolved?)] (if (= 'ns resolved-as-clojure-var-name) analyzed (let [in-def (:in-def ctx) id (:id expr) m (meta analyzed) context (when (:analysis-context ctx) (let [node-context (:context name-node) ctx-context (:context ctx) context (utils/deep-merge ctx-context node-context)] context)) fn-parent-loc (redundant-fn-wrapper ctx (:callstack ctx) children interop?) proto-call (utils/var-usage {:type :call :context context :resolved-ns resolved-namespace :ns ns-name :name (with-meta (or resolved-name full-fn-name) (meta full-fn-name)) :alias resolved-alias :unresolved? unresolved? :in-comment (:in-comment ctx) :unresolved-ns unresolved-ns :clojure-excluded? clojure-excluded? :arity arg-count :row row :end-row (:end-row expr-meta) :col col :end-col (:end-col expr-meta) :base-lang base-lang :lang lang :filename (:filename ctx) :expr (when-not dependencies expr) :callstack (:callstack ctx) :condition (:condition expr) :config (:config ctx) :top-ns (:top-ns ctx) :arg-types (:arg-types ctx) :simple? (simple-symbol? full-fn-name) :interop? interop? :resolved-core? resolved-core? :redundant-fn-wrapper-parent-loc fn-parent-loc :idx (:idx ctx) :len (:len ctx) :id id :in-def in-def :derived-location (:derived-location expr-meta)}) ret-tag (or (:ret m) (types/ret-tag-from-call ctx proto-call expr)) call (if ret-tag (assoc proto-call :ret ret-tag) proto-call)] (utils/reg-call ctx call id) (when (:analyze-var-usages? ctx) (namespace/reg-var-usage! ctx ns-name call)) (when (not unresolved?) (namespace/reg-used-namespace! ctx ns-name resolved-namespace)) (if m (with-meta (cons call analyzed) m) (cons call analyzed)))))))))))) (defn analyze-keyword-call [{:keys [base-lang lang ns] :as ctx} {:keys [arg-count full-fn-name row col expr]}] (let [ns-name (:name ns) children (:children expr) kw-node (first children) _ (usages/analyze-keyword ctx kw-node) children (rest children) expr-meta (meta expr) resolved-namespace :clj-kondo/unknown-namespace ctx (update ctx :callstack conj [nil :token]) arg-types (when-not (linter-disabled? ctx :type-mismatch) (atom [])) ctx (assoc ctx :arg-types arg-types) analyzed (let [next-ctx ctx] (analyze-children next-ctx children false)) in-def (:in-def ctx) id (:id expr) m (meta analyzed) proto-call {:type :call :resolved-ns resolved-namespace :ns ns-name :name full-fn-name :unresolved? true :unresolved-ns nil :arity arg-count :row row :end-row (:end-row expr-meta) :col col :end-col (:end-col expr-meta) :base-lang base-lang :lang lang :filename (:filename ctx) :arg-types (:arg-types ctx)} ret-tag (or (:ret m) (types/ret-tag-from-call ctx proto-call expr)) call (cond-> proto-call id (assoc :id id) in-def (assoc :in-def in-def) ret-tag (assoc :ret ret-tag))] (utils/reg-call ctx call id) (if m (with-meta (cons call analyzed) m) (cons call analyzed)))) ;; pulled out from lint-keyword-call! (defn- resolve-keyword [ctx kw namespaced?] (let [ns (:ns ctx) ?resolved-ns (if namespaced? (if-let [kw-ns (namespace kw)] (or (get (:qualify-ns ns) (symbol kw-ns)) ;; because we couldn't resolve the namespaced ;; keyword, we print it as is (str ":" (namespace kw))) ;; if the keyword is namespace, but there is no ;; namespace, it's the current ns (:name ns)) (namespace kw))] (if ?resolved-ns (keyword (str ?resolved-ns) (name kw)) kw))) (defn lint-keyword-call! [ctx kw namespaced? arg-count expr] (let [callstack (:callstack ctx) config (:config ctx)] (when-not (config/skip? config :invalid-arity callstack) (let [resolved-kw (resolve-keyword ctx kw namespaced?) kw-str (if (namespace resolved-kw) (str (namespace resolved-kw) "/" (name kw)) (str (name resolved-kw)))] (when (or (zero? arg-count) (> arg-count 2)) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity (format "keyword :%s is called with %s args but expects 1 or 2" kw-str arg-count)))))) (let [callstack (cons nil callstack) [enclosing-ns enclosing-name] (nth callstack 2 nil)] ;; a keyword wrapper directly in spec position can't be unwrapped: as a ;; bare keyword it would name a spec instead of a predicate. conformer is ;; the exception, since it takes plain functions (when-not (and (one-of enclosing-ns [clojure.spec.alpha cljs.spec.alpha]) (not= 'conformer enclosing-name)) (when-let [fn-parent-loc (redundant-fn-wrapper ctx callstack (rest (:children expr)) false)] (findings/reg-finding! ctx (assoc fn-parent-loc :filename (:filename ctx) :type :redundant-fn-wrapper :message "Redundant fn wrapper"))))))) (defn lint-symbol-call! [ctx _the-symbol arg-count expr] (let [callstack (:callstack ctx) config (:config ctx)] (when (or (zero? arg-count) (> arg-count 2)) (when-not (config/skip? config :invalid-arity callstack) (findings/reg-finding! ctx (node->line (:filename ctx) expr :invalid-arity (format "symbol is called with %s args but expects 1 or 2" arg-count))))))) ;; TODO: this should just be a case of :type-mismatch (defn reg-not-a-function! [ctx expr typ] (let [callstack (:callstack ctx) config (:config ctx)] (when-not (config/skip? config :not-a-function callstack) (findings/reg-finding! ctx (node->line (:filename ctx) expr :not-a-function (str "a " typ " is not a function")))))) (def default-cfg-in-tag {:linters {:unresolved-symbol {:level :off} :invalid-arity {:level :off}}}) (defn lint-discouraged-tags! [ctx tag-expr] (let [discouraged-tag-config (get-in ctx [:config :linters :discouraged-tag]) tag (:value tag-expr)] (when-not (or (identical? :off (:level discouraged-tag-config)) (empty? (dissoc discouraged-tag-config :level))) (when-let [cfg (get discouraged-tag-config tag)] (findings/reg-finding! ctx (assoc-some (node->line (:filename ctx) tag-expr :discouraged-tag (or (:message cfg) (str "Discouraged tag literal: " tag))) :level (:level cfg))))))) (defn analyze-reader-macro [ctx expr] (let [children (:children expr) tag-expr (first children) tag (:value tag-expr) ctx (if (and (identical? :cljs (:lang ctx)) (= 'js tag)) ctx (if-let [config (get-in ctx [:config :config-in-tag tag])] (update ctx :config utils/deep-merge default-cfg-in-tag config) (utils/ctx-with-linters-disabled ctx [:unresolved-symbol :invalid-arity :not-a-function]))) children (rest children)] (lint-discouraged-tags! ctx tag-expr) (analyze-children ctx children))) (defn- lint-unused-value [ctx expr] (let [idx (:idx ctx) len (:len ctx) callstack (:callstack ctx)] (when (and (symbol? (ffirst callstack)) idx len (< idx (dec len))) (let [parent-call (first (:callstack ctx)) core? (one-of (first parent-call) [clojure.core cljs.core]) core-sym (when core? (second parent-call)) generated? (:clj-kondo.impl/generated expr) redundant? (and (not generated?) (not (:condition expr)) core? (not (:clj-kondo.impl/generated (meta parent-call))) (one-of core-sym [do fn defn defn- let when-let loop binding with-open doseq try when when-not when-first when-some future]))] (when redundant? (findings/reg-finding! ctx (assoc (meta expr) :type :unused-value :message "Unused value" :filename (:filename ctx)))))))) #_(requiring-resolve 'clojure.set/union) (defn analyze-unquote [ctx expr t children] (let [level (:syntax-quote-level ctx)] (when-not (and level (pos? level)) (when-not (some #(= '[leiningen.core.project defproject] %) (:callstack ctx)) (findings/reg-finding! ctx (node->line (:filename ctx) expr :unquote-not-syntax-quoted (if (= :unquote t) "Unquote (~) not syntax-quoted" "Unquote-splicing (~@) not syntax-quoted"))))) (let [new-level (if level (dec level) -1) ctx (-> ctx (assoc :syntax-quote-level new-level))] (analyze-children ctx children)))) (defn analyze-reader-macro-expr [ctx expr] (when (and (not (identical? :cljc (:base-lang ctx))) (str/starts-with? (-> expr :children first str) "?")) (findings/reg-finding! ctx (assoc (meta expr) :filename (:filename ctx) :level :error :type :syntax :message "Reader conditionals are only allowed in .cljc files"))) (analyze-reader-macro ctx expr)) (defn analyze-namespaced-map-expr [ctx expr t] (lint-unused-value ctx expr) (usages/analyze-namespaced-map (-> ctx (assoc :analyze-expression** analyze-expression**) (update :callstack #(cons [nil t] %))) expr)) (defn analyze-map-expr [ctx expr t children] (lint-unused-value ctx expr) (key-linter/lint-map-keys ctx expr) (let [children (if (:data-readers ctx) (map (fn [child k] (assoc child :clj-kondo.internal/map-position k)) children (cycle [:key :val])) children) children (mapv #(assoc % :id (gensym)) children) analyzed (analyze-children (-> ctx mark-non-tail-recur (update :callstack #(cons [nil t] %))) children) expr (assoc expr :children children :analyzed analyzed) tag* (types/expr->tag ctx expr)] ;; a binding or fn body ending in this map reads its type ;; here, like a call's return, see init-tag (when-let [id (:id expr)] (swap! (:calls-by-id ctx) assoc id {:ret tag*})) (types/add-arg-type-from-expr ctx expr tag*) analyzed)) (defn analyze-expression** [{:keys [bindings lang] :as ctx} {:keys [children] :as expr}] ;; (prn :expr expr) (when expr (let [expr (if (or (not= :edn lang) (:quoted ctx)) (meta/lift-meta-content2 (dissoc ctx :arg-types) expr) expr) t (tag expr) {:keys [row col]} (meta expr) arg-count (count (rest children))] (utils/handle-ignore ctx expr) ;; map's type is added in :map handler below ;; namespaced map's type is added when going through analyze-expression** via analyze-namespaced-map ;; list and quote are handled specially because of return types ;; deref is handled via expansion (when-not (one-of t [:namespaced-map :map :list :quote :token :deref]) (types/add-arg-type-from-expr ctx expr)) (case t :quote (do (lint-unused-value ctx expr) (let [ctx (if (some-> (:syntax-quote-level ctx) pos?) ctx (assoc ctx :quoted true))] ;; we don't add a new arg types vector but just let the ;; single argument add its tag to the exising vector (analyze-children ctx children false))) :syntax-quote (do (lint-unused-value ctx expr) (analyze-usages2 (assoc ctx :arg-types nil) expr)) :var (do (lint-unused-value ctx expr) (analyze-var ctx expr (:children expr))) :reader-macro (analyze-reader-macro-expr ctx expr) (:unquote :unquote-splicing) (analyze-unquote ctx expr t children) :namespaced-map (analyze-namespaced-map-expr ctx expr t) :map (analyze-map-expr ctx expr t children) :set (do (lint-unused-value ctx expr) (key-linter/lint-set ctx expr) (analyze-children (-> ctx mark-non-tail-recur (update :callstack #(cons [nil t] %))) children)) :fn (do (lint-unused-value ctx expr) (when (and (:in-fn-literal ctx) (not (:clj-kondo.impl/generated expr))) (findings/reg-finding! ctx (assoc (meta expr) :filename (:filename ctx) :level :error :type :syntax :message "Nested #()s are not allowed"))) (when (identical? :edn lang) (findings/reg-finding! ctx (assoc (meta expr) :filename (:filename ctx) :level :error :type :syntax :message "#()s are not allowed in EDN"))) (let [expanded-node (macroexpand/expand-fn expr) m (meta expanded-node) has-first-arg? (:clj-kondo.impl/fn-has-first-arg m)] (recur (cond-> (assoc ctx :arg-types nil :in-fn-literal true) has-first-arg? (update :bindings assoc '% {})) expanded-node))) :token (let [edn? (= :edn lang)] (if (or edn? (:quoted ctx)) (do (types/add-arg-type-from-expr ctx expr) (if (:k expr) (do (usages/analyze-keyword ctx expr) (types/add-arg-type-from-expr ctx expr)) (when-let [sym (utils/symbol-from-token expr)] (when (and (:analyze-symbols? ctx) (qualified-symbol? sym)) (let [resolved-extra (or (when-not edn? (let [the-ns-name (-> ctx :ns :name) resolved (resolve-name ctx false the-ns-name sym expr)] (when-not (or (:unresolved? resolved) (:interop? resolved)) {:to (:ns resolved) :name (:name resolved)}))) {:name (symbol (name sym))})] (analysis/reg-symbol! ctx (:filename ctx) (-> ctx :ns :name) sym lang (merge (meta expr) resolved-extra))))))) (let [id (gensym) expr (assoc expr :id id) _ (analyze-usages2 ctx expr) usage (get @(:calls-by-id ctx) id)] (if usage (types/add-arg-type-from-usage ctx usage expr) (types/add-arg-type-from-expr ctx expr)) nil))) :list (if-let [function (some->> (first children) (meta/lift-meta-content2 (dissoc ctx :arg-types)))] (if (or (:quoted ctx) (= :edn lang)) (do (types/add-arg-type-from-expr ctx expr) (analyze-children (update ctx :callstack (fn [cs] (cons [:list nil] cs))) children)) (let [_ (utils/handle-ignore ctx function) t (tag function)] (case t (:map :vector :set) (let [lint! (case t :map lint-map-call! :vector lint-vector-call! :set lint-set-call!)] (lint! ctx arg-count expr) (types/add-arg-type-from-expr ctx expr) (analyze-children (update ctx :callstack conj [nil t]) children)) :quote (let [quoted-child (-> function :children first)] (types/add-arg-type-from-expr ctx expr) (cond (utils/symbol-token? quoted-child) (lint-symbol-call! ctx quoted-child arg-count expr) (identical? :list (:tag quoted-child)) (reg-not-a-function! ctx quoted-child "list") (utils/boolean-token? quoted-child) (reg-not-a-function! ctx quoted-child "boolean") (string-from-token quoted-child) (reg-not-a-function! ctx quoted-child "string") (utils/char-token? quoted-child) (reg-not-a-function! ctx quoted-child "character") (utils/number-token? quoted-child) (reg-not-a-function! ctx quoted-child "number")) (analyze-children (update ctx :callstack conj [nil t]) children)) :token (if-let [k (:k function)] (do (lint-keyword-call! ctx k (:namespaced? function) arg-count expr) (let [[id expr] (if-let [id (:id expr)] [id expr] (let [id (gensym)] [id (assoc expr :id id)])) ret (analyze-keyword-call ctx {:arg-count arg-count :full-fn-name (resolve-keyword ctx k (:namespaced? function)) :row row :col col :expr expr}) maybe-call (some #(when (= id (:id %)) %) ret)] (if maybe-call (types/add-arg-type-from-call ctx maybe-call expr) (types/add-arg-type-from-expr ctx expr)) ret)) (if-let [full-fn-name (utils/symbol-from-token function)] (let [simple? (simple-symbol? full-fn-name) full-fn-name (if simple? (namespace/normalize-sym-name ctx full-fn-name) full-fn-name) full-fn-name (with-meta full-fn-name (meta function)) binding (and simple? (get bindings full-fn-name))] (if binding (if-let [ret-tag (:ret (analyze-binding-call ctx full-fn-name binding expr))] (types/add-arg-type-from-expr ctx expr ret-tag) (types/add-arg-type-from-expr ctx expr)) (let [id (or (:id expr) (gensym)) expr (assoc expr :id id) ret (analyze-call ctx {:arg-count arg-count :full-fn-name full-fn-name :row row :col col :expr expr}) _ (dorun ret) ;; realize all returned expressions ;; to not be bitten by laziness maybe-call (some #(when (= id (:id %)) %) ret)] (if (identical? :call (:type maybe-call)) (types/add-arg-type-from-call ctx maybe-call expr) (types/add-arg-type-from-expr ctx expr)) ret))) (cond (utils/boolean-token? function) (do (reg-not-a-function! ctx function "boolean") (analyze-children (update ctx :callstack conj [nil t]) (rest children))) (string-from-token function) (do (reg-not-a-function! ctx function "string") (analyze-children (update ctx :callstack conj [nil t]) (rest children))) (utils/char-token? function) (do (reg-not-a-function! ctx function "character") (analyze-children (update ctx :callstack conj [nil t]) (rest children))) (utils/number-token? function) (do (reg-not-a-function! ctx function "number") (analyze-children (update ctx :callstack conj [nil t]) (rest children))) :else (do (types/add-arg-type-from-expr (update ctx :callstack conj [nil t]) expr) (analyze-children ctx children))))) ;; catch-all (do (types/add-arg-type-from-expr ctx expr) (let [ctx (update ctx :callstack conj [nil t])] (analyze-children ctx children)))))) (types/add-arg-type-from-expr ctx expr :list)) :regex (do (lint-unused-value ctx expr) (when (identical? :edn lang) (findings/reg-finding! ctx (assoc (meta expr) :filename (:filename ctx) :level :error :type :syntax :message "Regex literals are not allowed in EDN"))) (analyze-children (update ctx :callstack #(cons [nil t] %)) children)) :vector (do (lint-unused-value ctx expr) (analyze-children (-> ctx mark-non-tail-recur (update :callstack #(cons [nil t] %))) children)) :deref (recur ctx (with-meta (seq/list-node [(token/token-node (case lang :clj 'clojure.core/deref :cljs 'cljs.core/deref 'clojure.core/deref)) (first (:children expr))]) (meta expr))) ;; catch-all (analyze-children (update ctx :callstack #(cons [nil t] %)) children))))) ;; Hack to make a few functions available in a common namespace without ;; introducing circular depending namespaces. NOTE: alter-var-root! didn't work ;; with GraalVM (vswap! common assoc 'analyze-expression** analyze-expression** 'analyze-children analyze-children 'analyze-like-let analyze-like-let 'ctx-with-bindings ctx-with-bindings 'extract-bindings extract-bindings 'analyze-defn analyze-defn 'analyze-usages2 analyze-usages2) (defn analyze-expression* "NOTE: :used-namespaces is used in the cache to load namespaces that were actually used." [ctx expression] (loop [ctx (assoc ctx :bindings {} :top-level? true) ns (:ns ctx) [first-parsed & rest-parsed :as all] (analyze-expression** ctx expression)] (if (seq all) (case (:type first-parsed) nil (recur ctx ns rest-parsed) (:ns :in-ns) (let [ns-name (:name first-parsed) local-config (:config first-parsed) global-config (:global-config ctx) new-config (or local-config global-config)] (swap! (:used-namespaces ctx) update (:base-lang ctx) into (:used-namespaces first-parsed)) (recur (-> ctx (assoc :config new-config) (update :top-ns (fn [n] (or n ns-name)))) first-parsed rest-parsed)) :import-vars (do (namespace/reg-proxied-namespaces! ctx (:name ns) (:used-namespaces first-parsed)) (swap! (:used-namespaces ctx) update (:base-lang ctx) into (:used-namespaces first-parsed)) (recur ctx ns rest-parsed)) ;; catch-all ;; TODO: don't merge inline-configs we've already seen (let [extra-configs (seq @(:inline-configs ctx)) config (:config ctx) config (if extra-configs (apply config/merge-config! config extra-configs) config)] ;; TODO: was is java.lang.System here! (when-not (:interop? first-parsed) (swap! (:used-namespaces ctx) update (:base-lang ctx) conj (:resolved-ns first-parsed))) (recur (assoc ctx :config config) ns rest-parsed))) (assoc ctx :ns ns)))) (defn analyze-expressions "Analyzes expressions and collects defs and calls into a map. To optimize cache lookups later on, calls are indexed by the namespace they call to, not the ns where the call occurred." [{:keys [base-lang lang config] :as ctx} expressions] (let [init-ns (when-not (= :edn lang) (analyze-ns-decl (-> ctx (assoc-in [:config :analysis] false) (dissoc :analysis) (assoc :synthetic-ns-init true) (utils/ctx-with-linter-disabled :namespace-name-mismatch)) (if (= "project.clj" (fs/file-name (:filename ctx))) (parse-string "(ns leiningen.core.project)") (parse-string "(ns user)")))) init-ctx (assoc ctx :ns init-ns :calls-by-id (atom {}) :top-ns nil :global-config config)] (swap! (:used-namespaces ctx) update base-lang into (:used-namespaces init-ns)) (reduce analyze-expression* init-ctx expressions))) ;;;; processing of string input (defn- ->findings "Convert an exception thrown from rewrite-clj into a sequence clj-kondo :finding" [^Exception ex ^String filename] (let [{:keys [findings line col] :as d} (ex-data ex)] (cond (seq findings) (for [finding findings] (merge {:type :syntax :filename filename} finding)) ;; The edn parser in tools.reader throw ex-data with the following shape: ;; {:type :reader-exception, :ex-kind :reader-error, :file nil, :line 1, :col 4} (identical? :reader-exception (:type d)) [{:type :syntax :filename filename :row line :col col :message (.getMessage ex)}] :else [{:filename filename :col 0 :row 0 :type :syntax :message (str "Can't parse " filename ", " (or (.getMessage ex) (str ex)))}]))) (defn- lint-line-length [ctx config filename input] (let [re-find (:re-find-memo ctx) findings (atom []) line-length-conf (-> config :linters :line-length)] (when (not (identical? :off (:level line-length-conf))) (when-let [max-line-length (:max-line-length line-length-conf)] (let [exclude-urls (:exclude-urls line-length-conf) exclude-pattern (:exclude-pattern line-length-conf)] (with-open [rdr (io/reader (java.io.StringReader. input))] (run! (fn [[row line]] (let [line-length (count line)] (when (and (< max-line-length line-length) (or (not exclude-urls) (not (str/includes? line "http"))) (or (not exclude-pattern) (not (re-find exclude-pattern line)))) (swap! findings conj {:message (str "Line is longer than " max-line-length " characters.") :filename filename :type :line-length :row (inc row) :end-row (inc row) :col (inc max-line-length) :end-col (count line)})))) (map-indexed vector (line-seq rdr))))))) @findings)) (defn warn-on-reflection-opts [ctx config filename input lang] (when (identical? :clj lang) (let [cfg (-> config :linters :warn-on-reflection)] (when-not (identical? :off (:level cfg)) (let [has-setting? (str/includes? input "*warn-on-reflection*") only-on-interop (when-not has-setting? (:warn-only-on-interop cfg))] (when (and (not has-setting?) (not only-on-interop)) (findings/reg-finding! ctx {:message "Var *warn-on-reflection* is not set in this namespace." :filename filename :type :warn-on-reflection :row 1 :col 1 :end-row 1 :end-col 1})) [only-on-interop (str/includes? input "*warn-on-reflection*")]))))) (defn analyze-input "Analyzes input and returns analyzed defs, calls. Also invokes some linters and returns their findings." [{:keys [config file-analyzed-fn total-files files] :as ctx} filename uri input lang dev?] (when (:debug ctx) (utils/stderr "[clj-kondo] Linting file:" filename)) (let [ctx (assoc ctx :filename filename) reader-exceptions (atom [])] (binding [utils/*ctx* ctx *reader-exceptions* reader-exceptions] (try (let [[only-warn-on-interop warn-on-reflect-enabled? :as reflect-opts] (warn-on-reflection-opts ctx config filename input lang) ctx (if reflect-opts (assoc ctx :warn-on-reflect-enabled warn-on-reflect-enabled? :warn-only-on-interop only-warn-on-interop) ctx) ctx (assoc ctx :inline-configs (atom []) :gen-macros (atom []) :main-ns (atom nil)) features (when (identical? :cljc lang) (config/cljc-features config )) parsed (binding [*reader-features* features] (p/parse-string input)) fname (fs/file-name filename) ctx (case fname ("data_readers.clj" "data_readers.cljc") (utils/ctx-with-linters-disabled (assoc ctx :data-readers true) [:unresolved-symbol :unresolved-namespace :private-call]) ctx) line-length-findings (lint-line-length ctx config filename input)] (case lang :cljc (doseq [lang features] (let [ctx (assoc ctx :base-lang :cljc :lang lang :filename filename)] (analyze-expressions ctx (:children (select-lang ctx parsed lang))))) (:clj :cljs :edn) (let [ctx (assoc ctx :base-lang lang :lang lang :filename filename :uri uri)] (analyze-expressions ctx (:children parsed)) ;; analyze-expressions should go first in order to process ignores (when (identical? :edn lang) (case fname "deps.edn" (deps-edn/lint-deps-edn ctx (first (:children parsed))) "bb.edn" (deps-edn/lint-bb-edn ctx (first (:children parsed))) "config.edn" (when (and (fs/exists? filename) (= ".clj-kondo" (-> (fs/parent filename) (fs/file-name)))) (lint-config/lint-config ctx (first (:children parsed)))) nil)) nil)) (when-let [cfg-dir (-> ctx :config :cfg-dir)] (when-let [main-ns @(:main-ns ctx)] (let [configs (-> ctx :inline-configs deref seq) gen-macros? (-> ctx :gen-macros deref seq boolean) auto-load? (not (false? (:auto-load-configs config))) inline-file (io/file cfg-dir "inline-configs" (str (namespace-munge main-ns) (when-let [ext (fs/extension (:filename ctx))] (str "." ext))) "config.edn")] (if auto-load? (do (when configs (cache/with-named-lock (str (io/file ".cache" ".config-lock")) cfg-dir 10 (binding [*print-namespace-maps* false] (spit (doto inline-file (io/make-parents)) (apply config/merge-config! configs))))) (when-not gen-macros? (gen-macros/delete-for-file! ctx lang)) (when (and (not configs) (fs/exists? inline-file)) (fs/delete-tree (fs/parent inline-file)))) (do (gen-macros/delete-for-file! ctx lang) (when (fs/exists? inline-file) (fs/delete-tree (fs/parent inline-file)))))))) (doseq [f line-length-findings] (findings/reg-finding! ctx f))) (catch Exception e (if dev? (throw e) (run! #(findings/reg-finding! ctx %) (->findings e filename)))) (catch Error e (if dev? (throw e) (findings/reg-finding! ctx {:filename filename :col 0 :row 0 :type :file :message (str "Could not process file: " (or (.getMessage e) (str e)))}))) (finally (swap! files inc) (let [output-cfg (:output config)] (when (and (= :text (:format output-cfg)) (:progress output-cfg)) (binding [*out* *err*] (print ".") (flush)))) (when file-analyzed-fn (file-analyzed-fn {:filename filename :uri uri :total-files total-files :files-done @files})) (doseq [e @reader-exceptions] (if dev? (throw e) (run! #(findings/reg-finding! ctx %) (->findings e filename))))))))) ;;;; Scratch (comment (parse-string "#js [1 2 3]"))