2019-05-03 16:53:24 +00:00
|
|
|
#lang imperative-syndicate/test-implementation
|
|
|
|
;; A client observing some part of the server's dataspace should cause
|
|
|
|
;; creation of an assertion of observation in that server's dataspace.
|
|
|
|
|
|
|
|
(require (only-in imperative-syndicate/lang activate))
|
2019-05-05 15:51:23 +00:00
|
|
|
(require imperative-syndicate/distributed)
|
2019-05-03 16:53:24 +00:00
|
|
|
|
|
|
|
(assertion-struct presence (who))
|
|
|
|
|
2019-05-05 15:37:03 +00:00
|
|
|
(define test-address (server-loopback-connection "test"))
|
2019-05-03 16:53:24 +00:00
|
|
|
|
|
|
|
(test-case
|
2019-05-05 15:51:23 +00:00
|
|
|
[(activate imperative-syndicate/distributed)
|
2019-05-03 16:53:24 +00:00
|
|
|
|
|
|
|
(spawn #:name 'producer
|
2019-05-05 15:37:03 +00:00
|
|
|
(during (server-connected test-address)
|
|
|
|
(assert (to-server test-address (presence 'producer)))))
|
2019-05-03 16:53:24 +00:00
|
|
|
|
|
|
|
(spawn #:name 'consumer
|
2019-05-05 15:37:03 +00:00
|
|
|
(during (server-connected test-address)
|
|
|
|
(on (asserted (from-server test-address (presence $who)))
|
2019-05-03 16:53:24 +00:00
|
|
|
(printf "~a joined\n" who))))
|
|
|
|
|
|
|
|
(spawn #:name 'metaconsumer
|
2019-05-05 15:37:03 +00:00
|
|
|
(during (server-connected test-address)
|
|
|
|
(on (asserted (from-server test-address (observe (presence _))))
|
2019-05-03 16:53:24 +00:00
|
|
|
(printf "Someone cares about presence!\n"))))
|
|
|
|
]
|
|
|
|
no-crashes
|
|
|
|
(expected-output (set "producer joined"
|
|
|
|
"Someone cares about presence!")))
|