534 - this is how we test blocking channels

Time to write some tests for the chessboard app.

2 files changed, 27 insertions, 4 deletions

diff --git a/blocking.arc.t b/blocking.arc.t
new file mode 100644
index 00000000..c20e38e8
--- /dev/null
+++ b/blocking.arc.t
@@ -0,0 +1,25 @@
+(selective-load "mu.arc" section-level)
+
+(reset)
+(new-trace "blocking-example")
+(add-code
+  '((function reader [
+      (default-space:space-address <- new space:literal 30:literal/capacity)
+      (x:tagged-value 1:channel-address/space:global <- read 1:channel-address/space:global)
+     ])
+    (function main [
+      (default-space:space-address <- new space:literal 30:literal/capacity)
+      (1:channel-address <- init-channel 3:literal)
+      (2:integer/routine <- fork reader:fn default-space:space-address/globals 50:literal/limit)
+      ; write nothing to the channel
+;?       (sleep until-routine-done:literal 2:integer/routine)
+     ])))
+;? (= dump-trace* (obj whitelist '("schedule" "run")))
+(run 'main)
+;? (prn "completed:")
+;? (each r completed-routines*
+;?   (prn " " r))
+(if (ran-to-completion 'reader)
+  (prn "F - reader waits for input"))
+
+(reset)
diff --git a/mu.arc b/mu.arc
index 2b612941..9afccfef 100644
--- a/mu.arc
+++ b/mu.arc
@@ -1381,10 +1381,8 @@
 (def ran-to-completion (f)
   ; if a routine calling f ran to completion there'll be no sign of it in any
   ; completed call-stacks.
-  ; hack: only checks top call in each call stack
-  (no (find [aand stack._
-                  (is f top._!fn-name)]
-            completed-routines*)))
+  (~find [some [is f _!fn-name] stack._]
+         completed-routines*))
 
 ;; system software
 ; create once, load before every test