Merge branch 'test-exprs'

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)
+    (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,
     ;; 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)

src/ludus/node.cljc

@@ -30,42 +30,52 @@
 (defn clean-out [value]
  	#?(:clj value :cljs (clj->js value)))
 
-(defn run [source]
+(defn run 
- 	(let [user_scanned (s/scan source "user input")
+  ([source] (run source false))
-      		user_tokens (:tokens user_scanned)
+  ([source testing?]
-      		user_parsed (p/apply-parser g/script user_tokens)
+   (let [user_scanned (s/scan source "user input")
-      		user_result (i/interpret-safe source user_parsed {})
+         user_tokens (:tokens user_scanned)
-      		result_str (show/show user_result)
+         user_parsed (p/apply-parser g/script user_tokens)
-      		post_scanned (s/scan pre/postlude "postlude")
+         user_result (i/interpret-safe source user_parsed {} testing?)
-      		post_tokens (:tokens post_scanned)
+         result_str (show/show user_result)
-      		post_parsed (p/apply-parser g/script post_tokens)
+         test_results @i/test-results
-      		post_result (i/interpret-safe source post_parsed {})
+         post_scanned (s/scan pre/postlude "postlude")
-      		ludus_result (assoc post_result :result result_str)
+         post_tokens (:tokens post_scanned)
-      		clj_result (ld->clj ludus_result)
+         post_parsed (p/apply-parser g/script post_tokens)
-      		]
+         post_result (i/interpret-safe source post_parsed {} false)
-    (cond
+         ludus_result (assoc post_result :result result_str :test test_results)
-     	(not-empty (:errors user_tokens))
+         clj_result (ld->clj ludus_result)
-     	(clean-out {:errors (:errors user_tokens)})
+         ]
+     (cond
+       (not-empty (:errors user_tokens))
+       (clean-out {:errors (:errors user_tokens)})
 
-     	(= :err (:status user_parsed))
+       (= :err (:status user_parsed))
-     	(clean-out {:errors [(error/parse-error user_parsed)]})
+       (clean-out {:errors [(error/parse-error user_parsed)]})
 
-     	(::data/error user_result)
+       (::data/error user_result)
-     	(clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)]))
+       (clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)]))
 
-     	:else
+       :else
-     	(clean-out clj_result)
+       (clean-out clj_result)
-     	)
+       )
-   	))
+     ))
+  )
+
+(defn test-run [source] (run source true))
+
+(do
 
-(comment
   (def source "
-
+    test \"foo\" false
-    :a (_)
+    test \"bar\" true
-
+    test \"baz\" {
+      let quux = florp
+    }
     ")
 
-  (-> source run :errors println)
+  (-> source run :test println)
+
   )
 
 

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