2020-04-27 18:27:48 +00:00
|
|
|
#lang syndicate/test-implementation
|
2018-04-29 10:55:32 +00:00
|
|
|
;; Suite of four related tests.
|
|
|
|
;; See .../syndicate/examples/actor/example-responsibility-transfer-2.rkt
|
|
|
|
|
|
|
|
(test-case
|
|
|
|
[(spawn #:name 'factory-1
|
|
|
|
(on (asserted (list 'X 1))
|
|
|
|
(spawn #:name 'service-1
|
|
|
|
#:assertions [(observe (list 'X 1))] ;; (A)
|
|
|
|
(stop-when (retracted (list 'X 1))) ;; (B)
|
|
|
|
(on (message 'dummy)))
|
|
|
|
(stop-current-facet)))
|
|
|
|
(spawn (on (asserted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v asserted.\n" supplier)
|
|
|
|
(assert! (list 'X supplier)))
|
|
|
|
(on (retracted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v retracted.\n" supplier)))]
|
|
|
|
no-crashes
|
2018-05-06 09:55:02 +00:00
|
|
|
(expected-output (list "Supply 1 asserted.")))
|
2018-04-29 10:55:32 +00:00
|
|
|
|
|
|
|
(test-case
|
|
|
|
[(spawn #:name 'factory-1
|
|
|
|
(on (asserted (list 'X 1))
|
|
|
|
(spawn #:name 'service-1
|
|
|
|
;; #:assertions [(observe (list 'X 1))] ;; (A)
|
|
|
|
(stop-when (retracted (list 'X 1))) ;; (B)
|
|
|
|
(on (message 'dummy)))
|
|
|
|
(stop-current-facet)))
|
|
|
|
(spawn (on (asserted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v asserted.\n" supplier)
|
|
|
|
(assert! (list 'X supplier)))
|
|
|
|
(on (retracted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v retracted.\n" supplier)))]
|
|
|
|
no-crashes
|
2018-05-06 09:55:02 +00:00
|
|
|
(expected-output (list "Supply 1 asserted."
|
|
|
|
"Supply 1 retracted."
|
|
|
|
"Supply 1 asserted.")))
|
2018-04-29 10:55:32 +00:00
|
|
|
|
|
|
|
(test-case
|
|
|
|
[(spawn #:name 'factory-1
|
|
|
|
(on (asserted (list 'X 1))
|
|
|
|
(spawn #:name 'service-1
|
|
|
|
#:assertions [(observe (list 'X 1))] ;; (A)
|
|
|
|
;; (stop-when (retracted (list 'X 1))) ;; (B)
|
|
|
|
(on (message 'dummy)))
|
|
|
|
(stop-current-facet)))
|
|
|
|
(spawn (on (asserted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v asserted.\n" supplier)
|
|
|
|
(assert! (list 'X supplier)))
|
|
|
|
(on (retracted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v retracted.\n" supplier)))]
|
|
|
|
no-crashes
|
2018-05-06 09:55:02 +00:00
|
|
|
(expected-output (list "Supply 1 asserted."
|
|
|
|
"Supply 1 retracted.")))
|
2018-04-29 10:55:32 +00:00
|
|
|
|
|
|
|
(test-case
|
|
|
|
[(spawn #:name 'factory-1
|
|
|
|
(on (asserted (list 'X 1))
|
|
|
|
(spawn #:name 'service-1
|
|
|
|
;; #:assertions [(observe (list 'X 1))] ;; (A)
|
|
|
|
;; (stop-when (retracted (list 'X 1))) ;; (B)
|
|
|
|
(on (message 'dummy)))
|
|
|
|
(stop-current-facet)))
|
|
|
|
(spawn (on (asserted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v asserted.\n" supplier)
|
|
|
|
(assert! (list 'X supplier)))
|
|
|
|
(on (retracted (observe (list 'X $supplier)))
|
|
|
|
(printf "Supply ~v retracted.\n" supplier)))]
|
|
|
|
no-crashes
|
2018-05-06 09:55:02 +00:00
|
|
|
(expected-output (list "Supply 1 asserted."
|
|
|
|
"Supply 1 retracted.")))
|