Stand up basic testing
This commit is contained in:
parent
b723532d1a
commit
b6eeaa1d3e
|
@ -822,6 +822,39 @@
|
||||||
msg-string (show/show msg-value)]
|
msg-string (show/show msg-value)]
|
||||||
(throw (ex-info msg-string {:ast ast}))))
|
(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 [name msg]
|
||||||
|
(vswap! test-results conj [::data/tuple name msg]))
|
||||||
|
|
||||||
|
(defn- eval-test [ast ctx]
|
||||||
|
(let [name (-> ast :data first :data first)
|
||||||
|
expr (-> ast :data second)]
|
||||||
|
(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)))))
|
||||||
|
(catch #?(:clj Throwable :cljs js/Object) e
|
||||||
|
(add-test-result name (str "Failed!: Ludus panciked with " (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)
|
||||||
|
nil)))
|
||||||
|
|
||||||
(defn interpret-ast [ast ctx]
|
(defn interpret-ast [ast ctx]
|
||||||
(case (:type ast)
|
(case (:type ast)
|
||||||
|
|
||||||
|
@ -893,6 +926,8 @@
|
||||||
; :struct-literal
|
; :struct-literal
|
||||||
; (interpret-struct ast ctx)
|
; (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}))))
|
(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]
|
(defn get-line [source line]
|
||||||
|
@ -967,8 +1002,10 @@
|
||||||
(println (ex-message e))
|
(println (ex-message e))
|
||||||
{:result :error :ctx (volatile! orig-ctx)})))))
|
{: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))})]
|
(let [base-ctx (volatile! {::parent (volatile! (merge ludus-prelude ctx))})]
|
||||||
|
(vreset! testing? test?)
|
||||||
|
(vreset! test-results [::data/list])
|
||||||
(try
|
(try
|
||||||
;(println "Running source: " source)
|
;(println "Running source: " source)
|
||||||
(interpret-ast parsed base-ctx)
|
(interpret-ast parsed base-ctx)
|
||||||
|
|
|
@ -36,13 +36,14 @@
|
||||||
(let [user_scanned (s/scan source "user input")
|
(let [user_scanned (s/scan source "user input")
|
||||||
user_tokens (:tokens user_scanned)
|
user_tokens (:tokens user_scanned)
|
||||||
user_parsed (p/apply-parser g/script user_tokens)
|
user_parsed (p/apply-parser g/script user_tokens)
|
||||||
user_result (i/interpret-safe source user_parsed {::i/testing? testing?})
|
user_result (i/interpret-safe source user_parsed {} testing?)
|
||||||
result_str (show/show user_result)
|
result_str (show/show user_result)
|
||||||
|
test_results @i/test-results
|
||||||
post_scanned (s/scan pre/postlude "postlude")
|
post_scanned (s/scan pre/postlude "postlude")
|
||||||
post_tokens (:tokens post_scanned)
|
post_tokens (:tokens post_scanned)
|
||||||
post_parsed (p/apply-parser g/script post_tokens)
|
post_parsed (p/apply-parser g/script post_tokens)
|
||||||
post_result (i/interpret-safe source post_parsed {})
|
post_result (i/interpret-safe source post_parsed {} false)
|
||||||
ludus_result (assoc post_result :result result_str)
|
ludus_result (assoc post_result :result result_str :test test_results)
|
||||||
clj_result (ld->clj ludus_result)
|
clj_result (ld->clj ludus_result)
|
||||||
]
|
]
|
||||||
(cond
|
(cond
|
||||||
|
@ -61,16 +62,20 @@
|
||||||
))
|
))
|
||||||
)
|
)
|
||||||
|
|
||||||
(defn test [source] (run source true))
|
(defn test-run [source] (run source true))
|
||||||
|
|
||||||
(comment
|
(do
|
||||||
(def source "
|
(def source "
|
||||||
|
test \"foo\" false
|
||||||
:a (_)
|
test \"bar\" true
|
||||||
|
test \"baz\" {
|
||||||
|
let quux = florp
|
||||||
|
}
|
||||||
|
(:foo, :bar)
|
||||||
")
|
")
|
||||||
|
|
||||||
(-> source run :errors println)
|
(-> source run :test println)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -101,7 +101,7 @@
|
||||||
(println (p/err-msg parsed))
|
(println (p/err-msg parsed))
|
||||||
(recur))
|
(recur))
|
||||||
(let [{result :result ctx :ctx}
|
(let [{result :result ctx :ctx}
|
||||||
(interpreter/interpret-repl parsed orig-ctx)]
|
(interpreter/interpret-repl parsed orig-ctx true)]
|
||||||
(if (= result :error)
|
(if (= result :error)
|
||||||
(recur)
|
(recur)
|
||||||
(do
|
(do
|
||||||
|
|
Loading…
Reference in New Issue
Block a user