72 lines
3.0 KiB
Racket
72 lines
3.0 KiB
Racket
#lang 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 (list "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 (list "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 (list "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 (list "Supply 1 asserted."
|
|
"Supply 1 retracted.")))
|