about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2014-08-28 20:42:15 -0700
committerKartik K. Agaram <vc@akkartik.com>2014-08-28 20:43:11 -0700
commitaa66c8327de1b6ccae47cd107d8f99241da97487 (patch)
treebb28ee68d1591d2419368bc5a17e141d63b44101
parenta1ef15119620a5f76071a1f3a829424a62864265 (diff)
downloadmu-aa66c8327de1b6ccae47cd107d8f99241da97487.tar.gz
88 - a different trace testing helper
Verifies a set of lines in order.
-rw-r--r--mu.arc43
1 files changed, 30 insertions, 13 deletions
diff --git a/mu.arc b/mu.arc
index 3769b803..b8f6137b 100644
--- a/mu.arc
+++ b/mu.arc
@@ -10,20 +10,37 @@
         initialization-fns*))
 
 (on-init
-  (= traces* nil))
+  (= traces* (queue)))
 (def trace (label . args)
-  (push (list label (apply tostring:prn args))
-        traces*))
-(def assert-trace-contains (label string)
-  (assert (pos (fn ((curr-label curr-msg))
-                 (and (is label curr-label)
-                      (posmatch string curr-msg)))
-               traces*)
-          (tostring
-            (prn "Couldn't find " (tostring write.string) " in label:")
-            (each (curr-label curr-msg) traces*
-              (if (is label curr-label)
-                (prn "  " curr-msg))))))
+  (enq (list label (apply tostring:prn args))
+       traces*))
+
+(def check-trace-contents (msg expected-contents)
+  (unless (trace-contents-match expected-contents)
+    (prn "F - " msg)
+    (prn "  trace contents")
+    (print-trace-contents-mismatch expected-contents)))
+
+(def trace-contents-match (expected-contents)
+  (each (label msg) (as cons traces*)
+    (when (and expected-contents
+               (is label expected-contents.0.0)
+               (posmatch expected-contents.0.1 msg))
+      (pop expected-contents)))
+  (no expected-contents))
+
+(def print-trace-contents-mismatch (expected-contents)
+  (each (label msg) (as cons traces*)
+    (whenlet (expected-label expected-msg)  expected-contents.0
+      (if (and (is label expected-label)
+               (posmatch expected-msg msg))
+        (do (pr "  * ")
+            (pop expected-contents))
+        (pr "    "))
+      (pr label ": " msg)))
+  (prn "  couldn't find")
+  (each (expected-label expected-msg)  expected-contents
+    (prn "  ! " expected-label ": " expected-msg)))
 
 (mac init-fn (name . body)
   `(enq (fn () (= (function* ',name) ',body))