Merge branch 'test-exprs'

This commit is contained in:
Scott Richmond 2023-12-24 15:58:52 -05:00
commit 770c84d081
3 changed files with 95 additions and 36 deletions

View File

@ -822,6 +822,50 @@
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 [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 line name :pass result)
(add-test-result line name :fail result)))
(catch #?(:clj Throwable :cljs js/Object) 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])
; :message (ex-message e)}
)
)))
(defn- interpret-test [ast ctx]
(let [testing? @testing?]
(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] (defn interpret-ast [ast ctx]
(case (:type ast) (case (:type ast)
@ -871,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
@ -893,6 +938,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 +1014,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

@ -30,17 +30,20 @@
(defn clean-out [value] (defn clean-out [value]
#?(:clj value :cljs (clj->js value))) #?(:clj value :cljs (clj->js value)))
(defn run [source] (defn run
([source] (run source false))
([source testing?]
(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 {}) 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
@ -57,15 +60,22 @@
(clean-out clj_result) (clean-out clj_result)
) )
)) ))
)
(defn test-run [source] (run source true))
(do
(comment
(def source " (def source "
test \"foo\" false
:a (_) test \"bar\" true
test \"baz\" {
let quux = florp
}
") ")
(-> 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