Testing hits all the desiderata.
This commit is contained in:
parent
b6eeaa1d3e
commit
b5d57cd96c
|
@ -829,19 +829,21 @@
|
|||
|
||||
(def test-results (volatile! [::data/list]))
|
||||
|
||||
(defn- add-test-result [name msg]
|
||||
(vswap! test-results conj [::data/tuple name msg]))
|
||||
(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 name "Passed!")
|
||||
(add-test-result name (str "Failed: expected truthy value but got " (show/show 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 name (str "Failed!: Ludus panciked with " (ex-message 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])
|
||||
|
@ -851,9 +853,18 @@
|
|||
|
||||
(defn- interpret-test [ast ctx]
|
||||
(let [testing? @testing?]
|
||||
(if testing?
|
||||
(eval-test ast ctx)
|
||||
nil)))
|
||||
(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)
|
||||
|
@ -904,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
|
||||
|
|
|
@ -65,13 +65,13 @@
|
|||
(defn test-run [source] (run source true))
|
||||
|
||||
(do
|
||||
|
||||
(def source "
|
||||
test \"foo\" false
|
||||
test \"bar\" true
|
||||
test \"baz\" {
|
||||
let quux = florp
|
||||
}
|
||||
(:foo, :bar)
|
||||
")
|
||||
|
||||
(-> source run :test println)
|
||||
|
|
Loading…
Reference in New Issue
Block a user