From b723532d1a354867db5c051a50a0a6484e9bb203 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Sun, 24 Dec 2023 14:22:16 -0500 Subject: [PATCH 1/3] Add testing status to run --- src/ludus/node.cljc | 53 +++++++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/src/ludus/node.cljc b/src/ludus/node.cljc index 3c91609..aced522 100644 --- a/src/ludus/node.cljc +++ b/src/ludus/node.cljc @@ -30,33 +30,38 @@ (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 {::i/testing? testing?}) + 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)}) - (= :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 [source] (run source true)) (comment (def source " From b6eeaa1d3e419ac6536c98b4aeb22c4986a4e86b Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Sun, 24 Dec 2023 15:23:53 -0500 Subject: [PATCH 2/3] Stand up basic testing --- src/ludus/interpreter.cljc | 39 +++++++++++++++++++++++++++++++++++++- src/ludus/node.cljc | 23 +++++++++++++--------- src/ludus/repl.clj | 2 +- 3 files changed, 53 insertions(+), 11 deletions(-) diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index ed0cca9..40513e2 100644 --- a/src/ludus/interpreter.cljc +++ b/src/ludus/interpreter.cljc @@ -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) diff --git a/src/ludus/node.cljc b/src/ludus/node.cljc index aced522..0a743cd 100644 --- a/src/ludus/node.cljc +++ b/src/ludus/node.cljc @@ -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) + ) 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 From b5d57cd96cab3bde9e369f856687b1d4c746282d Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Sun, 24 Dec 2023 15:53:40 -0500 Subject: [PATCH 3/3] Testing hits all the desiderata. --- src/ludus/interpreter.cljc | 38 +++++++++++++++++++++++++------------- src/ludus/node.cljc | 2 +- 2 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/ludus/interpreter.cljc b/src/ludus/interpreter.cljc index 40513e2..ae73192 100644 --- a/src/ludus/interpreter.cljc +++ b/src/ludus/interpreter.cljc @@ -829,19 +829,21 @@ (def test-results (volatile! [::data/list])) -(defn- add-test-result [name msg] - (vswap! test-results conj [::data/tuple name msg])) +(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 name "Passed!") - (add-test-result name (str "Failed: expected truthy value but got " (show/show 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 name (str "Failed!: Ludus panciked with " (ex-message 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]) @@ -851,9 +853,18 @@ (defn- interpret-test [ast ctx] (let [testing? @testing?] - (if testing? - (eval-test ast ctx) - nil))) + (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) @@ -904,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 diff --git a/src/ludus/node.cljc b/src/ludus/node.cljc index 0a743cd..3817216 100644 --- a/src/ludus/node.cljc +++ b/src/ludus/node.cljc @@ -65,13 +65,13 @@ (defn test-run [source] (run source true)) (do + (def source " test \"foo\" false test \"bar\" true test \"baz\" { let quux = florp } - (:foo, :bar) ") (-> source run :test println)