Merge branch 'test-exprs'
This commit is contained in:
commit
770c84d081
|
@ -822,6 +822,50 @@
|
|||
msg-string (show/show msg-value)]
|
||||
(throw (ex-info msg-string {:ast ast}))))
|
||||
|
||||
; TODO:
|
||||
; this "are we testing?" variable should only obtain on direct-runs,
|
||||
; not in scripts evaluated using `import`
|
||||
(def testing? (volatile! false))
|
||||
|
||||
(def test-results (volatile! [::data/list]))
|
||||
|
||||
(defn- add-test-result [line name status msg]
|
||||
(vswap! test-results conj [::data/tuple line name status msg]))
|
||||
|
||||
(defn- eval-test [ast ctx]
|
||||
(let [name (-> ast :data first :data first)
|
||||
line (-> ast :token :line)
|
||||
expr (-> ast :data second)]
|
||||
(println "Testing " name)
|
||||
(try
|
||||
(let [result (interpret-ast expr ctx)]
|
||||
(if result
|
||||
(add-test-result line name :pass result)
|
||||
(add-test-result line name :fail result)))
|
||||
(catch #?(:clj Throwable :cljs js/Object) e
|
||||
(add-test-result line name :panic (ex-message e))
|
||||
; {::data/error true
|
||||
; :token (get-in (ex-data e) [:ast :token])
|
||||
; :line (get-in (ex-data e) [:ast :token :line])
|
||||
; :message (ex-message e)}
|
||||
)
|
||||
)))
|
||||
|
||||
(defn- interpret-test [ast ctx]
|
||||
(let [testing? @testing?]
|
||||
(if testing? (eval-test ast ctx))
|
||||
::test))
|
||||
|
||||
(def script-result (volatile! nil))
|
||||
|
||||
(defn- interpret-script [ast ctx]
|
||||
(let [lines (:data ast)
|
||||
result (volatile! nil)]
|
||||
(doseq [line lines]
|
||||
(let [line-result (interpret-ast line ctx)]
|
||||
(if (not= ::test line-result) (vreset! result line-result))))
|
||||
@result))
|
||||
|
||||
(defn interpret-ast [ast ctx]
|
||||
(case (:type ast)
|
||||
|
||||
|
@ -871,11 +915,12 @@
|
|||
(interpret-ast last ctx))
|
||||
|
||||
:script
|
||||
(let [exprs (:data ast)
|
||||
inner (pop exprs)
|
||||
last (peek exprs)]
|
||||
(run! #(interpret-ast % ctx) inner)
|
||||
(interpret-ast last ctx))
|
||||
(interpret-script ast ctx)
|
||||
; (let [exprs (:data ast)
|
||||
; inner (pop exprs)
|
||||
; last (peek exprs)]
|
||||
; (run! #(interpret-ast % ctx) inner)
|
||||
; (interpret-ast last ctx))
|
||||
|
||||
;; note that, excepting tuples and structs,
|
||||
;; runtime representations are bare
|
||||
|
@ -893,6 +938,8 @@
|
|||
; :struct-literal
|
||||
; (interpret-struct ast ctx)
|
||||
|
||||
:test-expr (interpret-test ast ctx)
|
||||
|
||||
(throw (ex-info (str "Unknown AST node type " (get ast :type :none) " on line " (get-in ast [:token :line])) {:ast ast}))))
|
||||
|
||||
(defn get-line [source line]
|
||||
|
@ -967,8 +1014,10 @@
|
|||
(println (ex-message e))
|
||||
{:result :error :ctx (volatile! orig-ctx)})))))
|
||||
|
||||
(defn interpret-safe [source parsed ctx]
|
||||
(defn interpret-safe [source parsed ctx test?]
|
||||
(let [base-ctx (volatile! {::parent (volatile! (merge ludus-prelude ctx))})]
|
||||
(vreset! testing? test?)
|
||||
(vreset! test-results [::data/list])
|
||||
(try
|
||||
;(println "Running source: " source)
|
||||
(interpret-ast parsed base-ctx)
|
||||
|
|
|
@ -30,17 +30,20 @@
|
|||
(defn clean-out [value]
|
||||
#?(:clj value :cljs (clj->js value)))
|
||||
|
||||
(defn run [source]
|
||||
(defn run
|
||||
([source] (run source false))
|
||||
([source testing?]
|
||||
(let [user_scanned (s/scan source "user input")
|
||||
user_tokens (:tokens user_scanned)
|
||||
user_parsed (p/apply-parser g/script user_tokens)
|
||||
user_result (i/interpret-safe source user_parsed {})
|
||||
user_result (i/interpret-safe source user_parsed {} testing?)
|
||||
result_str (show/show user_result)
|
||||
test_results @i/test-results
|
||||
post_scanned (s/scan pre/postlude "postlude")
|
||||
post_tokens (:tokens post_scanned)
|
||||
post_parsed (p/apply-parser g/script post_tokens)
|
||||
post_result (i/interpret-safe source post_parsed {})
|
||||
ludus_result (assoc post_result :result result_str)
|
||||
post_result (i/interpret-safe source post_parsed {} false)
|
||||
ludus_result (assoc post_result :result result_str :test test_results)
|
||||
clj_result (ld->clj ludus_result)
|
||||
]
|
||||
(cond
|
||||
|
@ -57,15 +60,22 @@
|
|||
(clean-out clj_result)
|
||||
)
|
||||
))
|
||||
)
|
||||
|
||||
(defn test-run [source] (run source true))
|
||||
|
||||
(do
|
||||
|
||||
(comment
|
||||
(def source "
|
||||
|
||||
:a (_)
|
||||
|
||||
test \"foo\" false
|
||||
test \"bar\" true
|
||||
test \"baz\" {
|
||||
let quux = florp
|
||||
}
|
||||
")
|
||||
|
||||
(-> source run :errors println)
|
||||
(-> source run :test println)
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
|
|
@ -101,7 +101,7 @@
|
|||
(println (p/err-msg parsed))
|
||||
(recur))
|
||||
(let [{result :result ctx :ctx}
|
||||
(interpreter/interpret-repl parsed orig-ctx)]
|
||||
(interpreter/interpret-repl parsed orig-ctx true)]
|
||||
(if (= result :error)
|
||||
(recur)
|
||||
(do
|
||||
|
|
Loading…
Reference in New Issue
Block a user