#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.")))