47 lines
2.3 KiB
Racket
47 lines
2.3 KiB
Racket
|
#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")))
|