72 lines
3.0 KiB
Racket
72 lines
3.0 KiB
Racket
|
#lang imperative-syndicate/test-implementation
|
||
|
;; 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
|
||
|
(expected-output "Supply 1 asserted."))
|
||
|
|
||
|
(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
|
||
|
(expected-output "Supply 1 asserted."
|
||
|
"Supply 1 retracted."
|
||
|
"Supply 1 asserted."))
|
||
|
|
||
|
(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
|
||
|
(expected-output "Supply 1 asserted."
|
||
|
"Supply 1 retracted."))
|
||
|
|
||
|
(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
|
||
|
(expected-output "Supply 1 asserted."
|
||
|
"Supply 1 retracted."))
|