Stand up basic testing

This commit is contained in:
Scott Richmond 2023-12-24 15:23:53 -05:00
parent b723532d1a
commit b6eeaa1d3e
3 changed files with 53 additions and 11 deletions

View File

@ -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)

View File

@ -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)
) )

View File

@ -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