2021-06-01 15:19:24 +00:00
|
|
|
; SPDX-License-Identifier: LGPL-3.0-or-later
|
2021-06-04 09:35:27 +00:00
|
|
|
; SPDX-FileCopyrightText: 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-01 15:19:24 +00:00
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
#lang syndicate/test-implementation
|
2019-05-03 16:53:24 +00:00
|
|
|
;; A client observing some part of the server's dataspace should cause
|
|
|
|
;; creation of an assertion of observation in that server's dataspace.
|
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
(require (only-in syndicate/lang activate))
|
|
|
|
(require syndicate/distributed)
|
2019-05-03 16:53:24 +00:00
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
(require (submod syndicate/distributed/heartbeat for-testing))
|
2019-06-20 11:19:45 +00:00
|
|
|
(heartbeats-enabled? #f)
|
|
|
|
|
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
|
2020-04-27 18:27:48 +00:00
|
|
|
[(activate 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!")))
|