Skip to content

Commit 9696bac

Browse files
authored
Add specs to analyzer, add spec based tests (#238)
* clojure.spec specs for the AST based on the AST reference * unit tests for all the AST node types + spec assertions * fix minor cases where the AST diverges from the AST reference
1 parent 79414ff commit 9696bac

File tree

4 files changed

+637
-8
lines changed

4 files changed

+637
-8
lines changed

deps.edn

+2-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,8 @@
1313
:main-opts ["-i" "src/test/cljs_cli/cljs_cli/test_runner.clj"
1414
"-e" "(cljs-cli.test-runner/-main)"]}
1515
:compiler.test {:extra-paths ["src/test/cljs" "src/test/cljs_build" "src/test/cljs_cp"
16-
"src/test/clojure" "src/test/self"]}
16+
"src/test/clojure" "src/test/self"]
17+
:extra-deps {org.clojure/spec.alpha {:mvn/version "0.5.238"}}}
1718
:compiler.test.run {:main-opts ["-i" "src/test/clojure/cljs/test_runner.clj"
1819
"-e" "(cljs.test-runner/-main)"]}
1920
:runtime.test.build {:extra-paths ["src/test/cljs"]

src/main/clojure/cljs/analyzer.cljc

+19-7
Original file line numberDiff line numberDiff line change
@@ -1880,7 +1880,12 @@
18801880
(assoc locals e
18811881
{:name e
18821882
:line (get-line e env)
1883-
:column (get-col e env)})
1883+
:column (get-col e env)
1884+
;; :local is required for {:op :local ...} nodes
1885+
;; but previously we had no way to figure this out
1886+
;; for `catch` locals, by adding it here we can recover
1887+
;; it later
1888+
:local :catch})
18841889
locals)
18851890
catch (when cblock
18861891
(disallowing-recur (analyze (assoc catchenv :locals locals) cblock)))
@@ -2143,6 +2148,7 @@
21432148
{:line line :column column})
21442149
param {:op :binding
21452150
:name name
2151+
:form name
21462152
:line line
21472153
:column column
21482154
:tag tag
@@ -2205,8 +2211,10 @@
22052211
shadow (or (handle-symbol-local name (get locals name))
22062212
(get-in env [:js-globals name]))
22072213
fn-scope (:fn-scope env)
2208-
name-var {:name name
2209-
:op :binding
2214+
name-var {:op :binding
2215+
:env env
2216+
:form name
2217+
:name name
22102218
:local :fn
22112219
:info {:fn-self-name true
22122220
:fn-scope fn-scope
@@ -2326,8 +2334,10 @@
23262334
(let [ret-tag (-> n meta :tag)
23272335
fexpr (no-warn (analyze env (n->fexpr n)))
23282336
be (cond->
2329-
{:name n
2330-
:op :binding
2337+
{:op :binding
2338+
:name n
2339+
:form n
2340+
:env env
23312341
:fn-var true
23322342
:line (get-line n env)
23332343
:column (get-col n env)
@@ -2416,7 +2426,9 @@
24162426
col (get-col name env)
24172427
shadow (or (handle-symbol-local name (get-in env [:locals name]))
24182428
(get-in env [:js-globals name]))
2419-
be {:name name
2429+
be {:op :binding
2430+
:name name
2431+
:form name
24202432
:line line
24212433
:column col
24222434
:init init-expr
@@ -2425,7 +2437,6 @@
24252437
:shadow shadow
24262438
;; Give let* bindings same shape as var so
24272439
;; they get routed correctly in the compiler
2428-
:op :binding
24292440
:env {:line line :column col}
24302441
:info {:name name
24312442
:shadow shadow}
@@ -2565,6 +2576,7 @@
25652576
(throw (error env "Wrong number of args to quote")))
25662577
(let [expr (analyze-const env x)]
25672578
{:op :quote
2579+
:literal? true
25682580
:expr expr
25692581
:env env
25702582
:form form
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,288 @@
1+
;; Copyright (c) Rich Hickey. All rights reserved.
2+
;; The use and distribution terms for this software are covered by the
3+
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4+
;; which can be found in the file epl-v10.html at the root of this distribution.
5+
;; By using this software in any fashion, you are agreeing to be bound by
6+
;; the terms of this license.
7+
;; You must not remove this notice, or any other, from this software.
8+
9+
(ns cljs.analyzer.spec-tests
10+
(:require [cljs.analyzer :as ana]
11+
[cljs.analyzer.api :as ana-api :refer [no-warn]]
12+
[cljs.compiler.api :as comp-api]
13+
[cljs.analyzer-tests :refer [analyze ns-env]]
14+
[cljs.analyzer.specs :as a]
15+
[clojure.test :as test :refer [deftest is]]
16+
[clojure.spec.alpha :as s])
17+
(:import [java.io StringReader]))
18+
19+
(deftest test-binding
20+
(let [node (analyze ns-env '(let [x 1] x))
21+
binding (-> node :bindings first)]
22+
(is (= :binding (:op binding)))
23+
(is (s/valid? ::a/node binding))))
24+
25+
(deftest test-case
26+
(let [let-node (no-warn (analyze ns-env '(case x 1 :foo 2 :bar)))
27+
node (-> let-node :body :ret)]
28+
(is (= :case (:op node)))
29+
(is (s/valid? ::a/node node))
30+
(let [nodes (-> node :nodes)
31+
case-node (first nodes)]
32+
(is (= :case-node (:op case-node)))
33+
(is (s/valid? ::a/node case-node))
34+
(let [case-tests (:tests case-node)
35+
case-test (first case-tests)
36+
case-then (:then case-node)]
37+
(is (= :case-test (:op case-test)))
38+
(is (s/valid? ::a/node case-test))
39+
(is (= :case-then (:op case-then)))
40+
(is (s/valid? ::a/node case-then))))))
41+
42+
(deftest test-const
43+
(is (s/valid? ::a/node (analyze ns-env 1)))
44+
(is (s/valid? ::a/node (analyze ns-env 1.2)))
45+
(is (s/valid? ::a/node (analyze ns-env true)))
46+
(is (s/valid? ::a/node (analyze ns-env "foo")))
47+
(let [node (analyze ns-env [])]
48+
(is (= :vector (:op node)))
49+
(is (s/valid? ::a/node node)))
50+
(is (s/valid? ::a/node (analyze ns-env [1 2 3])))
51+
(is (s/valid? ::a/node (analyze ns-env {})))
52+
(let [node (analyze ns-env {1 2 3 4})]
53+
(is (= :map (:op node)))
54+
(is (s/valid? ::a/node node)))
55+
(is (s/valid? ::a/node (analyze ns-env #{})))
56+
(let [node (analyze ns-env #{1 2 3})]
57+
(is (= :set (:op node)))
58+
(is (s/valid? ::a/node node))))
59+
60+
(deftest test-def
61+
(let [node (no-warn (analyze ns-env '(def x)))]
62+
(is (= :def (:op node)))
63+
(is (s/valid? ::a/node node)))
64+
(is (s/valid? ::a/node (analyze ns-env '(def x 1))))
65+
(is (s/valid? ::a/node (analyze ns-env '(def x (fn [])))))
66+
(is (s/valid? ::a/node (analyze ns-env '(def x (fn [y] y))))))
67+
68+
(deftest test-defn
69+
(is (s/valid? ::a/node (analyze ns-env '(defn x []))))
70+
(is (s/valid? ::a/node (analyze ns-env '(defn x [] 1))))
71+
(is (s/valid? ::a/node (analyze ns-env '(defn x [y] y)))))
72+
73+
(deftest test-defrecord
74+
(let [node (no-warn (analyze ns-env '(defrecord A [])))
75+
body (:body node)]
76+
(is (= :defrecord (-> body :statements first :ret :op)))
77+
(is (s/valid? ::a/node node))))
78+
79+
(deftest test-deftype
80+
(let [node (no-warn (analyze ns-env '(deftype A [])))]
81+
(is (= :deftype (-> node :statements first :op)))
82+
(is (s/valid? ::a/node node))))
83+
84+
(deftest test-do
85+
(let [node (analyze ns-env '(do))]
86+
(is (= :do (:op node)))
87+
(is (s/valid? ::a/node node)))
88+
(is (s/valid? ::a/node (analyze ns-env '(do 1))))
89+
(is (s/valid? ::a/node (analyze ns-env '(do 1 2 3)))))
90+
91+
(deftest test-fn
92+
(let [node (no-warn (analyze ns-env '(fn [])))]
93+
(is (= :fn (:op node)))
94+
(is (s/valid? ::a/node node)))
95+
(is (s/valid? ::a/node (analyze ns-env '(fn [] 1))))
96+
(is (s/valid? ::a/node (analyze ns-env '(fn [x]))))
97+
(is (s/valid? ::a/node (analyze ns-env '(fn [x] 1)))))
98+
99+
(deftest test-fn-method
100+
(let [node (analyze ns-env '(fn ([]) ([x] x)))
101+
methods (:methods node)
102+
fn0 (first methods)
103+
fn1 (second methods)]
104+
(is (= :fn-method (:op fn0)))
105+
(is (s/valid? ::a/node fn0))
106+
(is (= :fn-method (:op fn1)))
107+
(is (s/valid? ::a/node fn1))))
108+
109+
(deftest test-host-call
110+
(let [node (analyze ns-env '(.substring "foo" 0 1))]
111+
(is (= :host-call (:op node)))
112+
(is (s/valid? ::a/node node)))
113+
(let [node (analyze ns-env '(. "foo" (substring 0 1)))]
114+
(is (= :host-call (:op node)))
115+
(is (s/valid? ::a/node node))))
116+
117+
(deftest test-host-field
118+
(let [node (analyze ns-env '(.-length "foo"))]
119+
(is (= :host-field (:op node)))
120+
(is (s/valid? ::a/node node)))
121+
(let [node (analyze ns-env '(. "foo" -length))]
122+
(is (= :host-field (:op node)))
123+
(is (s/valid? ::a/node node))))
124+
125+
(deftest test-if
126+
(let [node (analyze ns-env '(if true true))]
127+
(is (= :if (:op node)))
128+
(is (s/valid? ::a/node node)))
129+
(is (s/valid? ::a/node (analyze ns-env '(if true true false)))))
130+
131+
(deftest test-invoke
132+
(let [node (no-warn (analyze ns-env '(count "foo")))]
133+
(is (= :invoke (:op node)))
134+
(is (s/valid? ::a/node node))))
135+
136+
(deftest test-js
137+
(let [node (analyze ns-env '(js* "~{}" 1))]
138+
(is (= :js (:op node)))
139+
(is (s/valid? ::a/node node))))
140+
141+
(deftest test-js-array
142+
(let [node (analyze ns-env
143+
(ana-api/with-state (ana-api/empty-state)
144+
(first (ana-api/forms-seq (StringReader. "#js [1 2 3]")))))]
145+
(is (= :js-array (:op node)))
146+
(is (s/valid? ::a/node node))))
147+
148+
(deftest test-js-object
149+
(let [node (analyze ns-env
150+
(ana-api/with-state (ana-api/empty-state)
151+
(first (ana-api/forms-seq (StringReader. "#js {:foo 1 :bar 2}")))))]
152+
(is (= :js-object (:op node)))
153+
(is (s/valid? ::a/node node))))
154+
155+
(deftest test-js-var
156+
(let [node (analyze ns-env 'js/String)]
157+
(is (= :js-var (:op node)))
158+
(is (s/valid? ::a/node node))))
159+
160+
(deftest test-let
161+
(let [node (analyze ns-env '(let []))]
162+
(is (= :let (:op node)))
163+
(is (s/valid? ::a/node node)))
164+
(is (s/valid? ::a/node (analyze ns-env '(let [x 1]))))
165+
(is (s/valid? ::a/node (analyze ns-env '(let [x 1] x)))))
166+
167+
(deftest test-letfn
168+
(let [node (analyze ns-env '(letfn [(foo [] (bar)) (bar [] (foo))]))]
169+
(is (= :letfn (:op node)))
170+
(is (s/valid? ::a/node node))))
171+
172+
;; list, no longer needed, subsumed by :quote
173+
174+
(deftest test-local
175+
(let [node (analyze ns-env '(fn [x] x))
176+
fn-method (-> node :methods first)
177+
body (-> fn-method :body)
178+
ret (:ret body)]
179+
(is (= :local (:op ret)))
180+
(is (s/valid? ::a/node node))))
181+
182+
(deftest test-loop
183+
(let [node (analyze ns-env '(loop []))]
184+
(is (= :loop (:op node)))
185+
(is (s/valid? ::a/node node)))
186+
(let [node (analyze ns-env '(loop [x 1] x))]
187+
(is (s/valid? ::a/node node)))
188+
(let [node (analyze ns-env '(loop [x 1] (recur (inc x))))]
189+
(is (s/valid? ::a/node node)))
190+
(let [node (no-warn
191+
(analyze ns-env
192+
'(loop [x 100]
193+
(if (pos? x)
194+
(recur (dec x))
195+
x))))]
196+
(is (s/valid? ::a/node node))))
197+
198+
(deftest test-map
199+
(let [node (no-warn (analyze ns-env '{:foo 1 :bar 2}))]
200+
(is (= :map (:op node)))
201+
(is (s/valid? ::a/node node))))
202+
203+
(deftest test-new
204+
(let [node (no-warn (analyze ns-env '(new String)))]
205+
(is (= :new (:op node)))
206+
(is (s/valid? ::a/node node)))
207+
(is (s/valid? ::a/node (analyze ns-env '(new js/String))))
208+
(is (s/valid? ::a/node (no-warn (analyze ns-env '(String.)))))
209+
(is (s/valid? ::a/node (analyze ns-env '(js/String.)))))
210+
211+
(deftest test-no-op
212+
(let [node (binding [ana/*unchecked-if* true]
213+
(no-warn (analyze ns-env '(set! *unchecked-if* false))))]
214+
(is (= :no-op (:op node)))
215+
(is (s/valid? ::a/node node))))
216+
217+
(deftest test-ns
218+
(let [node (no-warn
219+
(binding [ana/*cljs-ns* 'cljs.user]
220+
(analyze ns-env '(ns foo (:require [goog.string])))))]
221+
(is (= :ns (:op node)))
222+
(is (s/valid? ::a/node node))))
223+
224+
(deftest test-ns*
225+
(let [node (no-warn
226+
(binding [ana/*cljs-ns* 'cljs.user]
227+
(analyze ns-env '(ns* (:require '[goog.string])))))]
228+
(is (= :ns* (:op node)))
229+
(is (s/valid? ::a/node node))))
230+
231+
(deftest test-quote
232+
(let [node (analyze ns-env ''(1 2 3))]
233+
(is (= :quote (:op node)))
234+
(is (s/valid? ::a/node node))))
235+
236+
(deftest test-recur
237+
(let [node (no-warn (analyze ns-env '(fn [x] (recur (inc x)))))]
238+
(is (s/valid? ::a/node node))))
239+
240+
(deftest test-set
241+
(let [node (analyze ns-env #{1 2 3})]
242+
(is (= :set (:op node)))
243+
(is (s/valid? ::a/node node))))
244+
245+
(deftest test-set!
246+
(let [node (no-warn (analyze ns-env '(set! x 1)))]
247+
(is (= :set! (:op node)))
248+
(is (s/valid? ::a/node node))))
249+
250+
(deftest test-the-var
251+
(let [node (comp-api/with-core-cljs {}
252+
#(analyze ns-env '(var first)))]
253+
(is (= :the-var (:op node)))
254+
(is (s/valid? ::a/node node))))
255+
256+
(deftest test-throw
257+
(let [node (no-warn (analyze ns-env '(throw (js/Error. "foo"))))]
258+
(is (= :throw (:op node)))
259+
(is (s/valid? ::a/node node))))
260+
261+
(deftest test-try
262+
(let [node (no-warn (analyze ns-env '(try 1 (catch :default e) (finally))))]
263+
(is (= :try (:op node)))
264+
(is (s/valid? ::a/node node))))
265+
266+
(deftest test-var
267+
(let [node (no-warn (analyze ns-env '(fn [] x)))
268+
fn-method (-> node :methods first)
269+
body (-> fn-method :body)
270+
ret (:ret body)]
271+
(is (= :var (:op ret)))
272+
(is (s/valid? ::a/node node))))
273+
274+
(deftest test-vector
275+
(let [node (no-warn (analyze ns-env '[1 2]))]
276+
(is (= :vector (:op node)))
277+
(is (s/valid? ::a/node node))))
278+
279+
(deftest test-with-meta
280+
(let [node (analyze ns-env ^{:meta 2} {:foo 1})]
281+
(is (= :with-meta (:op node)))
282+
(is (s/valid? ::a/node node))))
283+
284+
(comment
285+
286+
(test/run-tests)
287+
288+
)

0 commit comments

Comments
 (0)