Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Provide middleware point to handle *cljs-warnings*
* Add in a default warning middleware with that same behavior as the current warning handler.
* Centralize the default warning behavior, make side-effects from each invocation of warning controllable through middleware.
* fix no-warn macro, make sure undeclared-ns-form is passed to warning for the right forms
* Make analyzer default-warning-handler respect *cljs-warnings*
* Fix default-warning-handler implementation and all the callers
* Change cljs.analyzer/confirm-var-exists: Don't call warning unless :undeclared-var warning is set, AND the var hasn't been def'd
* Add some basic all-warn no-warn analyzer tests
  • Loading branch information
sgrove authored and swannodette committed Nov 4, 2013
1 parent 69f0060 commit abd4450
Show file tree
Hide file tree
Showing 5 changed files with 107 additions and 48 deletions.
105 changes: 65 additions & 40 deletions src/clj/cljs/analyzer.clj
Expand Up @@ -30,13 +30,50 @@
(def ^:dynamic *constant-table* (atom {}))

(def ^:dynamic *cljs-warnings*
{:undeclared false
{:undeclared-var false
:undeclared-ns false
:undeclared-ns-form true
:redef true
:dynamic true
:fn-var true
:fn-arity true
:fn-deprecated true
:protocol-deprecated true})
:protocol-deprecated true
:undeclared-protocol-symbol true
:invalid-protocol-symbol true})

(declare message namespaces)

(defn ^:private default-warning-handler [warning-type env & [extra]]
(when (warning-type *cljs-warnings*)
(let [s (condp = warning-type
:undeclared-var (str "WARNING: Use of undeclared Var " (:prefix extra) "/" (:suffix extra))
:undeclared-ns (str "WARNING: No such namespace: " (:ns-sym extra))
:dynamic (str "WARNING: " (:name extra) " not declared ^:dynamic")
:redef (str "WARNING: " (:sym extra) " already refers to: " (symbol (str (:ns extra)) (str (:sym extra)))
" being replaced by: " (symbol (str (:ns-name extra)) (str (:sym extra))))
:fn-var (str "WARNING: " (symbol (str (:ns-name extra)) (str (:sym extra)))
" no longer fn, references are stale")
:fn-arity (str "WARNING: Wrong number of args (" (:argc extra) ") passed to " (or (:ctor extra)
(:name extra)))
:fn-deprecated (str "WARNING: " (-> extra :fexpr :info :name) " is deprecated.")
:undeclared-ns-form (str "WARNING: Referred " (:type extra) " " (:lib extra) "/" (:sym extra) " does not exist")
:protocol-deprecated (str "WARNING: Protocol " (:protocol extra) " is deprecated")
:undeclared-protocol-symbol (str "WARNING: Can't resolve protocol symbol " (:protocol extra))
:invalid-protocol-symbol (str "WARNING: Symbol " (:protocol extra) " is not a protocol"))]
(when s
(binding [*out* *err*]
(println (message env s)))))))

(def ^:dynamic *cljs-warning-handlers*
[default-warning-handler])

(defn with-warning-handlers [handlers]
(binding [*cljs-warning-handlers* handlers]))

(defmacro with-warning-handlers [handlers & body]
`(binding [*cljs-warning-handlers* ~handlers]
~@body))

(defn munge-path [ss]
(clojure.lang.Compiler/munge (str ss)))
Expand Down Expand Up @@ -79,15 +116,14 @@
(swap! namespaces assoc key val))

(defmacro no-warn [& body]
`(binding [*cljs-warnings*
{:undeclared false
:redef false
:dynamic false
:fn-var false
:fn-arity false
:fn-deprecated false
:protocol-deprecated false}]
~@body))
(let [no-warnings (zipmap (keys *cljs-warnings*) (repeat false))]
`(binding [*cljs-warnings* ~no-warnings]
~@body)))

(defmacro all-warn [& body]
(let [all-warnings (zipmap (keys *cljs-warnings*) (repeat true))]
`(binding [*cljs-warnings* ~all-warnings]
~@body)))

(defn get-line [x env]
(or (-> x meta :line) (:line env)))
Expand Down Expand Up @@ -141,9 +177,9 @@
(str s (when (:line env)
(str " at line " (:line env) " " *cljs-file*))))

(defn warning [env s]
(binding [*out* *err*]
(println (message env s))))
(defn warning [warning-type env extra]
(doseq [handler *cljs-warning-handlers*]
(handler warning-type env extra)))

(defn error
([env s] (error env s nil))
Expand All @@ -164,12 +200,11 @@
(throw (error ~env (.getMessage err#) err#))))))

(defn confirm-var-exists [env prefix suffix]
(when (:undeclared *cljs-warnings*)
(when (:undeclared-var *cljs-warnings*)
(let [crnt-ns (-> env :ns :name)]
(when (= prefix crnt-ns)
(when-not (-> @namespaces crnt-ns :defs suffix)
(warning env
(str "WARNING: Use of undeclared Var " prefix "/" suffix)))))))
(warning :undeclared-var env {:prefix prefix :suffix suffix}))))))

(defn resolve-ns-alias [env name]
(let [sym (symbol name)]
Expand All @@ -182,8 +217,7 @@
;; confirm that the library at least exists
(nil? (io/resource (ns->relpath ns-sym)))
(:undeclared *cljs-warnings*))
(warning env
(str "WARNING: No such namespace: " ns-sym))))
(warning :undeclared-ns env {:ns-sym ns-sym})))

(defn core-name?
"Is sym visible from core in the current compilation namespace?"
Expand Down Expand Up @@ -257,8 +291,7 @@
ev (resolve-existing-var env name)]
(when (and (:dynamic *cljs-warnings*)
ev (not (-> ev :dynamic)))
(warning env
(str "WARNING: " (:name ev) " not declared ^:dynamic"))))))
(warning :dynamic env {:ev ev})))))

(declare analyze analyze-symbol analyze-seq)

Expand Down Expand Up @@ -359,9 +392,7 @@
(get-in @namespaces [ns-name :uses sym]))
(let [ev (resolve-existing-var (dissoc env :locals) sym)]
(when (:redef *cljs-warnings*)
(warning env
(str "WARNING: " sym " already refers to: " (symbol (str (:ns ev)) (str sym))
" being replaced by: " (symbol (str ns-name) (str sym)))))
(warning :redef env {:ev ev :sym sym :ns-name ns-name}))
(swap! namespaces update-in [ns-name :excludes] conj sym)
(update-in env [:ns :excludes] conj sym))
env)
Expand All @@ -382,9 +413,7 @@
(when (and (:fn-var *cljs-warnings*)
(not (-> sym meta :declared))
(and (:fn-var v) (not fn-var?)))
(warning env
(str "WARNING: " (symbol (str ns-name) (str sym))
" no longer fn, references are stale"))))
(warning :fn-var env {:ns-name ns-name :sym sym})))
(swap! namespaces assoc-in [ns-name :defs sym]
(merge
{:name name}
Expand Down Expand Up @@ -636,9 +665,8 @@
argexprs (vec (map #(analyze enve %) args))
known-num-fields (:num-fields (resolve-existing-var env ctor))
argc (count args)]
(when (and known-num-fields (not= known-num-fields argc))
(warning env
(str "WARNING: Wrong number of args (" argc ") passed to " ctor)))
(when (and known-num-fields (not= known-num-fields argc) (:fn-arity *cljs-warnings*))
(warning :fn-arity env {:argc argc :ctor ctor}))

{:env env :op :new :form form :ctor ctorexpr :args argexprs
:children (into [ctorexpr] argexprs)})))
Expand Down Expand Up @@ -694,17 +722,15 @@

(defn check-uses [uses env]
(doseq [[sym lib] uses]
(when (and (:undeclared *cljs-warnings*)
(when (and (:undeclared-ns *cljs-warnings*)
(= (get-in @namespaces [lib :defs sym] ::not-found) ::not-found))
(warning env
(str "WARNING: Referred var " lib "/" sym " does not exist")))))
(warning :undeclared-ns-form env {:type :var :lib lib :sym sym}))))

(defn check-use-macros [use-macros env]
(doseq [[sym lib] use-macros]
(when (and (:undeclared *cljs-warnings*)
(when (and (:undeclared-ns *cljs-warnings*)
(nil? (.findInternedVar ^clojure.lang.Namespace (find-ns lib) sym)))
(warning env
(str "WARNING: Referred macro " lib "/" sym " does not exist")))))
(warning :undeclared-ns env {:type :macro :lib lib :sym sym}))))

(defmethod parse 'ns
[_ env [_ name & args :as form] _]
Expand Down Expand Up @@ -958,12 +984,11 @@
(when (and (not (some #{argc} (map count method-params)))
(or (not variadic)
(and variadic (< argc max-fixed-arity))))
(warning env
(str "WARNING: Wrong number of args (" argc ") passed to " name)))))
(warning :fn-arity env {:name name
:argc argc}))))
(if (and (:fn-deprecated *cljs-warnings*) (-> fexpr :info :deprecated)
(not (-> form meta :deprecation-nowarn)))
(warning env
(str "WARNING: " (-> fexpr :info :name) " is deprecated.")))
(warning :fn-deprecated env {:fexpr fexpr}))
{:env env :op :invoke :form form :f fexpr :args argexprs
:tag (or (-> fexpr :info :tag) (-> form meta :tag)) :children (into [fexpr] argexprs)})))

Expand Down
6 changes: 5 additions & 1 deletion src/clj/cljs/closure.clj
Expand Up @@ -973,7 +973,11 @@
(:optimize-constants opts)
ana/*track-constants*)
ana/*cljs-warnings*
(assoc ana/*cljs-warnings* :undeclared (true? (opts :warnings)))]
(let [enabled? (true? (opts :warnings))]
(merge ana/*cljs-warnings*
{:undeclared-var enabled?
:undeclared-ns enabled?
:undeclared-ns-form enabled?}))]
(let [compiled (-compile source all-opts)
const-table (when ana/*track-constants*
(comp/emit-constants-table-to-file @ana/*constant-table*
Expand Down
9 changes: 3 additions & 6 deletions src/clj/cljs/core.clj
Expand Up @@ -606,21 +606,18 @@
(if-let [var (cljs.analyzer/resolve-existing-var (dissoc env :locals) p)]
(do
(when-not (:protocol-symbol var)
(cljs.analyzer/warning env
(core/str "WARNING: Symbol " p " is not a protocol")))
(cljs.analyzer/warning :invalid-protocol-symbol env {:protocol p}))
(when (core/and (:protocol-deprecated cljs.analyzer/*cljs-warnings*)
(-> var :deprecated)
(not (-> p meta :deprecation-nowarn)))
(cljs.analyzer/warning env
(core/str "WARNING: Protocol " p " is deprecated")))
(cljs.analyzer/warning :protocol-deprecated env {:protocol p}))
(when (:protocol-symbol var)
(swap! cljs.analyzer/namespaces
(fn [ns]
(update-in ns [(:ns var) :defs (symbol (name p)) :impls]
conj type)))))
(when (:undeclared cljs.analyzer/*cljs-warnings*)
(cljs.analyzer/warning env
(core/str "WARNING: Can't resolve protocol symbol " p))))))
(cljs.analyzer/warning :undeclared-protocol-symbol env {:protocol p})))))

(defn resolve-var [env sym]
(let [ret (-> (dissoc env :locals)
Expand Down
4 changes: 3 additions & 1 deletion src/clj/cljs/repl.clj
Expand Up @@ -157,7 +157,9 @@
(binding [ana/*cljs-ns* 'cljs.user
*cljs-verbose* verbose
ana/*cljs-warnings* (assoc ana/*cljs-warnings*
:undeclared warn-on-undeclared)
:undeclared-var warn-on-undeclared
:undeclared-ns warn-on-undeclared
:undeclared-ns-form warn-on-undeclared)
ana/*cljs-static-fns* static-fns]
(when analyze-path
(analyze-source analyze-path))
Expand Down
31 changes: 31 additions & 0 deletions test/clj/cljs/analyzer_tests.clj
@@ -1,2 +1,33 @@
(ns cljs.analyzer-tests
(:require [cljs.analyzer :as a])
(:use clojure.test))

;;******************************************************************************
;; cljs-warnings tests
;;******************************************************************************

(defn make-counter []
(let [counter (atom 0)]
{:counter counter
:f (fn [& args]
(swap! counter inc))}))

(def warning-forms
{:undeclared-var (let [v (gensym)] `(~v 1 2 3))
:fn-arity '(do (defn x [a b] (+ a b))
(x 1 2 3 4))})

(defn warn-count [form]
(let [{:keys [counter f]} (make-counter)
tracker (fn [warning-type env & [extra]]
(println "Warning: " warning-type)
(println "\tenabled? " (warning-type a/*cljs-warnings*)))]
(a/with-warning-handlers [f]
(a/analyze (a/empty-env) form))
@counter))

(deftest no-warn
(is (every? zero? (map (fn [[name form]] (a/no-warn (warn-count form))) warning-forms))))

(deftest all-warn
(is (every? #(= 1 %) (map (fn [[name form]] (a/all-warn (warn-count form))) warning-forms))))

0 comments on commit abd4450

Please sign in to comment.