From 96d24fbb4bf07d82b64f1f0e3cc67c7986b492cb Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 6 May 2018 11:06:36 +0100 Subject: [PATCH] New test case --- syndicate/test/core/spawn-and-send.rkt | 46 ++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 syndicate/test/core/spawn-and-send.rkt diff --git a/syndicate/test/core/spawn-and-send.rkt b/syndicate/test/core/spawn-and-send.rkt new file mode 100644 index 0000000..e258ff2 --- /dev/null +++ b/syndicate/test/core/spawn-and-send.rkt @@ -0,0 +1,46 @@ +#lang imperative-syndicate/test-implementation +;; Test the "spawn and send" idiom, where event ordering is exploited +;; to ensure a listener is ready by the time a sent message is ready +;; for delivery. +;; +;; I'm still not 100% convinced this is the way things really ought to +;; work. In old-Syndicate, the assertion of interest was exactly the +;; same as installation of a handler-procedure, and the one could not +;; occur before the other. Here, the installation of the handler +;; happens *before* declaration of interest: in particular, no +;; separate `#:assertions` clause is needed to ensure routing of the +;; `(item)` message to the newly spawned `server` process. In +;; old-Syndicate, the spawner of `server` would have to include +;; `(observe (item))` in order for the `(item)` not to be dropped by +;; the `server`. Perhaps this new-Syndicate should include handlers in +;; patches, somehow, so that the declaration-of-interest and +;; installation-of-handler move together? Then the `#:assertions` +;; would really be `#:transient-endpoints` and would include `(assert +;; ...)` and `(on ...)`, which is a bit jolly strange, so perhaps the +;; current behaviour is better after all? + +(test-case + [(message-struct item ()) + (message-struct server-present (how)) + (spawn #:name 'main + (on (message (item)) + (printf "Item received by main\n")) + (during (server-present $how) + (on-start (printf "Server is present: ~a\n" how)) + (on-stop (printf "Server is not present: ~a\n" how))) + (on-start (printf "Spawning server\n") + (spawn #:name 'server + #:assertions [(server-present 'outside)] + (assert (server-present 'inside)) + (on (message (item)) + (printf "Item received by server\n"))) + (printf "Sending item\n") + (send! (item))))] + no-crashes + (expected-output (list "Spawning server" + "Sending item" + "Server is present: outside") + (set "Item received by main" + "Item received by server") + (list "Server is present: inside" + "Server is not present: outside")))