Detect macro arity errors and make calls order aware (#35, #36)

In the process #33 also got fixed.

src/clj_kondo/impl/macroexpand.clj

@@ -32,10 +32,15 @@
                    children))
 
 (defn expand-fn [{:keys [:children] :as expr}]
-  (let [fn-body (list-node children)
+  (let [{:keys [:row :col] :as m} (meta expr)
+        fn-body (with-meta (list-node children)
+                  {:row row
+                   :col (inc col)})
         args (find-fn-args children)
         arg-list (vector-node args)]
-    (list-node [(token-node 'fn) arg-list fn-body])))
+    (with-meta
+      (list-node [(token-node 'fn) arg-list fn-body])
+      m)))
 
 (defn expand-all [expr]
   (clojure.walk/prewalk

src/clj_kondo/impl/vars.clj

@@ -8,9 +8,9 @@
 
 ;;;; function arity
 
-(defn arg-name [{:keys [:children] :as rw-expr}]
+(defn arg-name [{:keys [:children] :as expr}]
   ;; TODO: use strip-meta
-  (if-let [n (:value rw-expr)]
+  (if-let [n (:value expr)]
     ;; normal argument
     n
     ;; this is an argument with metadata
@@ -34,19 +34,7 @@
       {:arg-names arg-names
        :fixed-arity arity})))
 
-(defn defn? [rw-expr]
-  (some-call rw-expr defn defn-))
-
-(defn let? [rw-expr]
-  (some-call rw-expr let))
-
-(defn anon-fn? [rw-expr]
-  (some-call rw-expr fn))
-
-(defn ns-decl? [rw-expr]
-  (some-call rw-expr ns))
-
-(defn require-clause? [{:keys [:children] :as rw-expr}]
+(defn require-clause? [{:keys [:children] :as expr}]
   (= :require (:k (first children))))
 
 (defn analyze-require-subclause [{:keys [:children] :as expr}]
@@ -95,10 +83,10 @@
                          {}
                          subclauses)}))
 
-(defn fn-call? [rw-expr]
-  (let [tag (node/tag rw-expr)]
+(defn fn-call? [expr]
+  (let [tag (node/tag expr)]
     (and (= :list tag)
-         (symbol? (:value (first (:children rw-expr)))))))
+         (symbol? (:value (first (:children expr)))))))
 
 (defn strip-meta* [children]
   (loop [[child & rest-children] children
@@ -139,19 +127,21 @@
         arities (map analyze-arity arg-decls)
         fixed-arities (set (keep :fixed-arity arities))
         var-args-min-arity (:min-arity (first (filter :varargs? arities)))
-        defn (if fn-name
-               (cond-> {:type :defn
-                        :name fn-name}
-                 (seq fixed-arities) (assoc :fixed-arities fixed-arities)
-                 private? (assoc :private? private?)
-                 var-args-min-arity (assoc :var-args-min-arity var-args-min-arity))
-               (let [{:keys [:row :col]} (meta expr)]
-                 {:type :debug
-                  :level :info
-                  :message "Could not parse defn form"
-                  :debug? true
-                  :row row
-                  :col col}))]
+        defn
+        (let [{:keys [:row :col]} (meta expr)]
+          (if fn-name
+            (cond-> {:type :defn
+                     :name fn-name
+                     :row row
+                     :col col}
+              (seq fixed-arities) (assoc :fixed-arities fixed-arities)
+              private? (assoc :private? private?)
+              var-args-min-arity (assoc :var-args-min-arity var-args-min-arity))
+            {:type :debug
+             :level :info
+             :message "Could not parse defn form"
+             :row row
+             :col col}))]
     (cons defn
           (mapcat
            #(parse-arities %
@@ -164,17 +154,17 @@
   ([expr] (parse-arities expr #{}))
   ([{:keys [:children] :as expr} bindings]
    (cond
-     (ns-decl? expr)
+     (some-call expr ns)
      [(analyze-ns-decl expr)]
-     (defn? expr)
+     (some-call expr defn defn- defmacro)
      (parse-defn expr bindings)
      (some-call expr ->> cond-> cond->> some-> some->> . .. deftype
                 proxy extend-protocol doto reify)
      []
-     (let? expr)
+     (some-call expr let)
      (let [let-bindings (->> children second :children (map :value) (filter symbol?) set)]
        (mapcat #(parse-arities % (set/union bindings let-bindings)) (rest children)))
-     (anon-fn? expr)
+     (some-call expr fn)
      ;; TODO better arity analysis like in normal fn
      (let [fn-name (-> children second :value)
            arg-vec (first (filter #(= :vector (node/tag %)) (rest children)))
@@ -190,6 +180,7 @@
          parse-rest
          (cons
           (let [{:keys [:row :col]} (meta expr)]
+            (when-not col (println expr row col))
             {:type :call
              :name fn-name
              :arity args
@@ -229,11 +220,13 @@
                results)
         (recur rest-parsed
                ns
-               (if-not (contains? #{:defn :call} (:type first-parsed))
+               (case (:type first-parsed)
+                 :debug
                  (update-in results
                             [:findings]
                             conj
-                            first-parsed)
+                            (assoc first-parsed
+                                   :filename filename))
                  (let [qname (qualify-name ns (:name first-parsed))
                        first-parsed (assoc first-parsed
                                            :qname (:name qname)
@@ -261,8 +254,7 @@
                                          :level :info
                                          :message (str "Unrecognized call to "
                                                        (:name first-parsed))
-                                         :type :unqualified-call
-                                         :debug? true))))))))
+                                         :type :debug))))))))
       results)))
 
 (defn core-lookup
@@ -295,6 +287,13 @@
                                              (core-lookup clojure-core-defns cljs-core-defns
                                                           lang fn-name)))]
                        :when called-fn
+                       :let [valid-order? (if (= (:ns call)
+                                                 fn-ns)
+                                            (or (> (:row call) (:row called-fn))
+                                                (and (= (:row call) (:row called-fn))
+                                                     (> (:col call) (:col called-fn))))
+                                            true)]
+                       :when valid-order?
                        :let [arity (:arity call)
                              filename (:filename call)
                              fixed-arities (:fixed-arities called-fn)

src/clj_kondo/main.clj

@@ -18,8 +18,8 @@
 
 (defn- print-findings [findings print-debug?]
   (doseq [{:keys [:filename :type :message
-                  :level :row :col :debug?] :as finding} findings
-          :when (if debug?
+                  :level :row :col] :as finding} findings
+          :when (if (= :debug type)
                   print-debug?
                   true)]
     (println (str filename ":" row ":" col ": " (name level) ": " message))))
@@ -147,12 +147,6 @@ Options:
          (when-let [parent (.getParentFile dir)]
            (recur parent)))))))
 
-;;;; cache
-
-(def ^:private cache-format "v1")
-(def ^:private cache-dir
-  (str ".cache/" cache-format))
-
 ;;;; synchronize namespaces with cache
 
 (defn- sync-cache [idacs cache-dir]
@@ -207,8 +201,8 @@ Options:
         cache-opt (get opts "--cache")
         cache-dir (when cache-opt
                     (or (when-let [cd (first (get opts "--cache"))]
-                          (io/file cd cache-format))
-                        (io/file (config-dir) cache-dir)))
+                          (io/file cd version))
+                        (io/file (config-dir) ".cache" version)))
         files (get opts "--lint")
         debug? (get opts "--debug")]
     {:opts opts

test/clj_kondo/impl/cache_test.clj

@@ -9,6 +9,8 @@
 
 (programs rm mkdir echo)
 
+(def cache-version @#'main/version)
+
 (deftest cache-test
   (doseq [lang [:clj :cljs]]
     (let [tmp-dir (System/getProperty "java.io.tmpdir")
@@ -24,7 +26,8 @@
       (-main "--lint" test-source-dir "--cache" test-cache-dir)
       (testing
           "var foo is found in cache of namespace foo"
-          (is (some? (get (cache/from-cache (io/file test-cache-dir "v1") lang 'foo)
+        (is (some? (get (cache/from-cache (io/file test-cache-dir cache-version)
+                                          lang 'foo)
                           'foo/foo))))
       (testing "linting only bar and using the cache option"
         (let [bar-file (.getPath (io/file test-source-dir (str "bar."
@@ -38,7 +41,6 @@
   (let [tmp-dir (System/getProperty "java.io.tmpdir")
         test-cache-dir-file (io/file tmp-dir "test-cache-dir")
         test-cache-dir-path (.getPath test-cache-dir-file)]
-    #_(.mkdirs (io/file test-cache-dir-file "v1"))
     (testing "with-cache returns value"
       (is (= 6 (cache/with-cache test-cache-dir-path 0
                  (+ 1 2 3)))))

test/clj_kondo/impl/macroexpand_test.clj

@@ -0,0 +1,32 @@
+(ns clj-kondo.impl.macroexpand-test
+  (:require
+   [clj-kondo.impl.macroexpand :as macroexpand]
+   [clj-kondo.impl.utils :refer [parse-string]]
+   [clojure.test :as t :refer [deftest is testing]]
+   [rewrite-clj.node.protocols :refer [tag]]))
+
+(defn location [node]
+  (let [m (meta node)]
+    (when (and (:row m) (:col m))
+      m)))
+
+(deftest expand->-test
+  (testing
+      "Expanded -> expression preserves location"
+    (is
+     (every? location
+             (filter #(= :list (tag %))
+                     (tree-seq :children :children
+                               (macroexpand/expand->
+                                (parse-string "(-> 1 inc inc)"))))))))
+
+(deftest expand-fn-test
+  (testing
+      "Expanded function literals have a location for the function they call"
+      (is
+       (every? location
+               (filter #(= :list (tag %))
+                       (tree-seq :children :children
+                                 (macroexpand/expand-fn
+                                  (parse-string "#(valid? %)"))))))))
+

test/clj_kondo/impl/vars_test.clj

@@ -20,11 +20,11 @@
   (clojure.lang.ChunkBuffer. capacity))"))))))
 
 (deftest parse-defn-test
-  (is
-   (= (vars/parse-defn (parse-string "(defn ^:static ^clojure.lang.ChunkBuffer chunk-buffer ^clojure.lang.ChunkBuffer [capacity]
-  (clojure.lang.ChunkBuffer. capacity))") [])
-      '[{:type :defn, :name chunk-buffer, :fixed-arities #{1}}
-        {:type :call, :name clojure.lang.ChunkBuffer., :arity 1, :row 2, :col 3}])))
+  (is (every? true?
+              (map submap?
+                   '[{:type :defn, :name chunk-buffer, :fixed-arities #{1}}
+                     {:type :call, :name clojure.lang.ChunkBuffer., :arity 1, :row 2, :col 3}](vars/parse-defn (parse-string "(defn ^:static ^clojure.lang.ChunkBuffer chunk-buffer ^clojure.lang.ChunkBuffer [capacity]
+  (clojure.lang.ChunkBuffer. capacity))") [])))))
 
 (deftest analyze-ns-test
   (is

test/clj_kondo/main_test.clj

@@ -139,6 +139,16 @@
 (inc 1 2 3)
 ")
 
+(def order-example "
+;; call to def special form with docstring
+(def x \"the number one\" 1)
+(defmacro def [k spec-form])
+;; valid call to macro
+(def ::foo int?)
+;; invalid call to macro
+(def ::foo int? string?)
+")
+
 (deftest invalid-arity-test
 
   (let [linted (lint! invalid-arity-examples)]
@@ -160,7 +170,11 @@
 
   (testing "macroexpansion of fn literal"
     (is (= 1 (count (lint! "(defn inc [x] (+ x 1)) #(-> % inc (inc 1))")))))
-  )
+
+  (testing "only invalid calls after (re-)definition are caught"
+    (let [linted (lint! order-example)]
+      (is (= 1 (count linted)))
+      (is (= 8 (:row (first (lint! order-example))))))))
 
 (def private-call-examples "
 (ns ns1)