twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Testing hits all the desiderata.

Browse Source
This commit is contained in:
Scott Richmond 2023-12-24 15:53:40 -05:00
parent b6eeaa1d3e
commit b5d57cd96c
2 changed files with 26 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/ludus/interpreter.cljc
View File

@ -829,19 +829,21 @@
(def test-results (volatile! [::data/list])) (def test-results (volatile! [::data/list]))
(defn- add-test-result [name msg] (defn- add-test-result [line name status msg]
(vswap! test-results conj [::data/tuple name msg])) (vswap! test-results conj [::data/tuple line name status msg]))
(defn- eval-test [ast ctx] (defn- eval-test [ast ctx]
(let [name (-> ast :data first :data first) (let [name (-> ast :data first :data first)
line (-> ast :token :line)
expr (-> ast :data second)] expr (-> ast :data second)]
(println "Testing " name)
(try (try
(let [result (interpret-ast expr ctx)] (let [result (interpret-ast expr ctx)]
(if result (if result
(add-test-result name "Passed!") (add-test-result line name :pass result)
(add-test-result name (str "Failed: expected truthy value but got " (show/show result))))) (add-test-result line name :fail result)))
(catch #?(:clj Throwable :cljs js/Object) e (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 ; {::data/error true
; :token (get-in (ex-data e) [:ast :token]) ; :token (get-in (ex-data e) [:ast :token])
; :line (get-in (ex-data e) [:ast :token :line]) ; :line (get-in (ex-data e) [:ast :token :line])
@ -851,9 +853,18 @@
(defn- interpret-test [ast ctx] (defn- interpret-test [ast ctx]
(let [testing? @testing?] (let [testing? @testing?]
(if testing? (if testing? (eval-test ast ctx))
(eval-test ast ctx) ::test))
nil)))
(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] (defn interpret-ast [ast ctx]
(case (:type ast) (case (:type ast)
@ -904,11 +915,12 @@
(interpret-ast last ctx)) (interpret-ast last ctx))
:script :script
(let [exprs (:data ast) (interpret-script ast ctx)
inner (pop exprs) ; (let [exprs (:data ast)
last (peek exprs)] ; inner (pop exprs)
(run! #(interpret-ast % ctx) inner) ; last (peek exprs)]
(interpret-ast last ctx)) ; (run! #(interpret-ast % ctx) inner)
; (interpret-ast last ctx))
;; note that, excepting tuples and structs, ;; note that, excepting tuples and structs,
;; runtime representations are bare ;; runtime representations are bare

2
src/ludus/node.cljc
View File

@ -65,13 +65,13 @@
(defn test-run [source] (run source true)) (defn test-run [source] (run source true))
(do (do
(def source " (def source "
test \"foo\" false test \"foo\" false
test \"bar\" true test \"bar\" true
test \"baz\" { test \"baz\" {
let quux = florp let quux = florp
} }
(:foo, :bar)
") ")
(-> source run :test println) (-> source run :test println)