diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index ed0cca9..ae73192 100644 --- a/src/ludus/interpreter.cljc +++ b/src/ludus/interpreter.cljc @@ -822,6 +822,50 @@ 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 [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] (case (:type ast) @@ -871,11 +915,12 @@ (interpret-ast last ctx)) :script - (let [exprs (:data ast) - inner (pop exprs) - last (peek exprs)] - (run! #(interpret-ast % ctx) inner) - (interpret-ast last ctx)) + (interpret-script ast ctx) + ; (let [exprs (:data ast) + ; inner (pop exprs) + ; last (peek exprs)] + ; (run! #(interpret-ast % ctx) inner) + ; (interpret-ast last ctx)) ;; note that, excepting tuples and structs, ;; runtime representations are bare @@ -893,6 +938,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 +1014,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) diff --git a/src/ludus/node.cljc b/src/ludus/node.cljc index 3c91609..3817216 100644 --- a/src/ludus/node.cljc +++ b/src/ludus/node.cljc @@ -30,42 +30,52 @@ (defn clean-out [value] #?(:clj value :cljs (clj->js value))) -(defn run [source] - (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 {}) - result_str (show/show user_result) - 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) - clj_result (ld->clj ludus_result) - ] - (cond - (not-empty (:errors user_tokens)) - (clean-out {:errors (:errors user_tokens)}) +(defn run + ([source] (run source false)) + ([source testing?] + (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 {} 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 {} false) + ludus_result (assoc post_result :result result_str :test test_results) + clj_result (ld->clj ludus_result) + ] + (cond + (not-empty (:errors user_tokens)) + (clean-out {:errors (:errors user_tokens)}) - (= :err (:status user_parsed)) - (clean-out {:errors [(error/parse-error user_parsed)]}) + (= :err (:status user_parsed)) + (clean-out {:errors [(error/parse-error user_parsed)]}) - (::data/error user_result) - (clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)])) + (::data/error user_result) + (clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)])) - :else - (clean-out clj_result) - ) - )) + :else + (clean-out clj_result) + ) + )) + ) + +(defn test-run [source] (run source true)) + +(do -(comment (def source " - - :a (_) - + test \"foo\" false + test \"bar\" true + test \"baz\" { + let quux = florp + } ") - (-> source run :errors println) + (-> source run :test println) + ) diff --git a/src/ludus/repl.clj b/src/ludus/repl.clj index 75c253e..ec5fc09 100644 --- a/src/ludus/repl.clj +++ b/src/ludus/repl.clj @@ -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