Stand up basic testing
This commit is contained in:
parent
b723532d1a
commit
b6eeaa1d3e
|
@ -822,6 +822,39 @@
|
|||
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 [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]
|
||||
(case (:type ast)
|
||||
|
||||
|
@ -893,6 +926,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 +1002,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)
|
||||
|
|
|
@ -36,13 +36,14 @@
|
|||
(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 {::i/testing? testing?})
|
||||
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
|
||||
|
@ -61,16 +62,20 @@
|
|||
))
|
||||
)
|
||||
|
||||
(defn test [source] (run source true))
|
||||
(defn test-run [source] (run source true))
|
||||
|
||||
(comment
|
||||
(do
|
||||
(def source "
|
||||
|
||||
:a (_)
|
||||
|
||||
test \"foo\" false
|
||||
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))
|
||||
(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