Failing test case: need visibility-restriction in broker clients
This commit is contained in:
parent
eb33fdbd59
commit
9e923e1c63
|
@ -0,0 +1,103 @@
|
|||
#lang imperative-syndicate/test-implementation
|
||||
;; Analogous to the `core/nesting-confusion.rkt` test case.
|
||||
|
||||
(require (only-in imperative-syndicate/lang activate))
|
||||
(require imperative-syndicate/broker)
|
||||
|
||||
(assertion-struct researcher (name topic))
|
||||
|
||||
(define test-address (broker-loopback-connection "test"))
|
||||
|
||||
(define no-mention-of-discard
|
||||
(lambda ()
|
||||
(not (memf (lambda (line) (string-contains? line "#s(discard)"))
|
||||
(collected-lines)))))
|
||||
|
||||
(define-syntax-rule (correct-topics-and-researchers)
|
||||
(expected-output (set "Added researcher: Alice"
|
||||
"Added researcher: Eve"
|
||||
"Added researcher: Tony"
|
||||
"Added topic: Bicycling"
|
||||
"Added topic: Computering"
|
||||
"Added topic: Cryptography"
|
||||
"Added topic: Evil")))
|
||||
|
||||
(test-case
|
||||
[(activate imperative-syndicate/broker)
|
||||
|
||||
(spawn #:name 'tony
|
||||
(assert (server-envelope "test" (researcher "Tony" "Computering")))
|
||||
(assert (server-envelope "test" (researcher "Tony" "Bicycling"))))
|
||||
(spawn #:name 'alice
|
||||
(assert (server-envelope "test" (researcher "Alice" "Cryptography")))
|
||||
(assert (server-envelope "test" (researcher "Alice" "Bicycling"))))
|
||||
(spawn #:name 'eve
|
||||
(assert (server-envelope "test" (researcher "Eve" "Cryptography")))
|
||||
(assert (server-envelope "test" (researcher "Eve" "Computering")))
|
||||
(assert (server-envelope "test" (researcher "Eve" "Evil"))))
|
||||
|
||||
(spawn #:name 'all-topics
|
||||
(during (broker-connected test-address)
|
||||
(during (from-broker test-address (researcher _ $topic))
|
||||
(on-start (printf "Added topic: ~a\n" topic))
|
||||
(on-stop (printf "Removed topic: ~a\n" topic)))))
|
||||
(spawn #:name 'all-researchers
|
||||
(during (broker-connected test-address)
|
||||
(during (from-broker test-address (researcher $name _))
|
||||
(on-start (printf "Added researcher: ~a\n" name))
|
||||
(on-stop (printf "Removed researcher: ~a\n" name)))))]
|
||||
no-crashes
|
||||
no-mention-of-discard
|
||||
(correct-topics-and-researchers))
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(assertion-struct claim (detail))
|
||||
|
||||
(define (asserts-then-retractions)
|
||||
(and (equal? (length (collected-lines)) 4)
|
||||
(equal? (list->set (take (collected-lines) 2)) (set "Specific claim asserted"
|
||||
"Nonspecific claim 123 asserted"))
|
||||
(equal? (list->set (drop (collected-lines) 2)) (set "Specific claim retracted"
|
||||
"Nonspecific claim 123 retracted"))))
|
||||
|
||||
(test-case
|
||||
[(activate imperative-syndicate/broker)
|
||||
|
||||
(spawn #:name 'claimant
|
||||
(assert (server-envelope "test" (claim 123)))
|
||||
(on-start (for [(i 100)] (flush!)) (stop-current-facet)))
|
||||
(spawn #:name 'monitor
|
||||
(during (broker-connected test-address)
|
||||
(during (from-broker test-address (claim 123))
|
||||
(on-start (printf "Specific claim asserted\n"))
|
||||
(on-stop (printf "Specific claim retracted\n")))
|
||||
(during (from-broker test-address (claim $detail))
|
||||
(on-start (printf "Nonspecific claim ~v asserted\n" detail))
|
||||
(on-stop (printf "Nonspecific claim ~v retracted\n" detail)))))]
|
||||
no-crashes
|
||||
asserts-then-retractions)
|
||||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(test-case
|
||||
[(activate imperative-syndicate/broker)
|
||||
|
||||
(spawn #:name 'inner-monitor
|
||||
(during (broker-connected test-address)
|
||||
(during (from-broker test-address (claim $detail))
|
||||
(on-start (printf "Inner saw claim asserted\n"))
|
||||
(on-stop (printf "Inner saw claim retracted\n")))))
|
||||
(spawn #:name 'claimant
|
||||
(assert (server-envelope "test" (claim 123)))
|
||||
(on-start (printf "Outer claimant started\n"))
|
||||
(on-stop (printf "Outer claimant stopped\n"))
|
||||
(on-start (for [(i 100)] (flush!))
|
||||
(printf "Stopping outer claimant\n")
|
||||
(stop-current-facet)))]
|
||||
no-crashes
|
||||
(expected-output (list "Outer claimant started"
|
||||
"Inner saw claim asserted"
|
||||
"Stopping outer claimant"
|
||||
"Outer claimant stopped"
|
||||
"Inner saw claim retracted")))
|
Loading…
Reference in New Issue