(ns com.tailrecursion.nanopass.pass-test
"Generated traversal must preserve structure, terminal data, and context."
(:require [clojure.test :refer [deftest is]]
[com.tailrecursion.nanopass :as np]
[com.tailrecursion.nanopass.pipeline :as pipeline]
[com.tailrecursion.nanopass.passes :as p]))
(deftest pipeline-state-and-evaluation
(let [events (atom [])
step (fn [state value]
(swap! events conj [state value])
[(inc state) (conj value state)])]
(is (= [2 [0 1]]
(->> [0 []]
(apply step)
(pipeline/map-value identity)
(apply step))))
(is (= [[0 []] [1 [0]]] @events)))
(doseq [value [nil false]]
(is (= [:state value] (pipeline/map-value identity [:state value]))))
(is (thrown-with-msg? clojure.lang.ExceptionInfo #"pass failed"
(pipeline/map-value (fn [_] (throw (ex-info "pass failed" {}))) [nil nil]))))
(deftest recursive-traversal
(let [literal {:op :literal :value '{:op :assign :name x}}
input (with-meta {:op :many :items {:a [literal {:op :read :name 'x}]}
:pair [literal {:op :read :name 'x}]
:unique #{{:op :read :name 'x}} :note "preserved"} {:line 42})
renamed (p/rename {'x 'y} (p/lower input))]
(is (= {:line 42} (meta renamed)))
(is (= "preserved" (:note renamed)))
(is (= literal (first (:pair renamed))))
(is (= 'y (get-in renamed [:items :a 1 :name])))
(is (= 'y (get-in renamed [:pair 1 :name])))
(is (= #{{:op :read :name 'y}} (:unique renamed)))
(is (= [8 renamed] (p/count-step 7 renamed)))
(is (= {:op :group :bindings [{:op :binding :name 'x
:value {:op :write :name 'x :value literal}}]
:body literal}
(p/lower {:op :group :bindings [{:op :binding :name 'x
:value {:op :assign :binding {:op :binding :name 'x :value literal}
:value literal}}]
:body literal}))))
(let [value {:op :many :items {} :pair [{:op :literal :value nil} nil] :unique #{}}]
(is (= value (p/lower value)))
(is (not (contains? (p/lower value) :note)))
(let [leaf {:op :literal :value nil}
assignment {:op :assign :binding {:op :binding :name 'x :value leaf} :value leaf}
output (p/lower (assoc value :child assignment :maybe nil))]
(is (= {:op :write :name 'x :value leaf} (:child output)))
(is (contains? output :maybe))
(is (nil? (:maybe output)))
(is (= :write (:op (:maybe (p/lower (assoc value :maybe assignment)))))))))
(deftest invalid-pass-definitions
(doseq [[kind form]
'[[:missing-clause (np/defpass broken {:from [f/Source Expr] :to [f/Core Expr]
:processors {Binding lower-binding}} [node])]
[:missing-processor (np/defpass broken {:from [f/Core Binding] :to [f/Core Binding]} [node])]
[:unknown-production (np/defpass broken {:from [f/Core Binding] :to [f/Core Binding]}
[node] :absent node)]
[:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr]}
[node] :read node :read node)]
[:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr] :body true}
[node] node node)]
[:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr] :body :yes}
[node] node)]
[:invalid-pass (np/defpass broken {:from [f/Core Expr]} [node] node)]
[:invalid-pass (np/defpasses)]
[:invalid-pass (np/defpasses (same {:from [f/Core Expr] :to [f/Core Expr]} [node])
(same {:from [f/Core Expr] :to [f/Core Expr]} [node]))]]]
(is (= kind (binding [*ns* (the-ns 'com.tailrecursion.nanopass.passes)]
(try (macroexpand-1 form) nil
(catch Exception e (-> (or (ex-cause e) e) ex-data :kind)))))
(pr-str form))))
(deftest optional-records
(is (= {} (p/lower-envelope {})))
(is (= {:maybe nil} (p/lower-envelope {:maybe nil})))
(let [leaf {:op :literal :value 1}
assignment {:op :assign :binding {:op :binding :name 'x :value leaf} :value leaf}]
(is (= {:child {:op :write :name 'x :value leaf}}
(p/lower-envelope {:child assignment}))))
(is (= {:line 17} (meta (p/lower-envelope (with-meta {} {:line 17}))))))