2020-04-27 18:27:48 +00:00
|
|
|
#lang syndicate/test-implementation
|
2019-01-28 01:14:01 +00:00
|
|
|
;; Simple tests of supervision functionality.
|
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
(require syndicate/supervise)
|
2019-01-28 01:14:01 +00:00
|
|
|
|
|
|
|
(test-case
|
|
|
|
[(supervise #:name 'ward
|
|
|
|
(on-start (printf "Starting ward\n"))
|
|
|
|
(on-stop (printf "Stopping ward\n"))
|
|
|
|
(on (message 'crash)
|
|
|
|
(printf "Crashing\n")
|
|
|
|
(error 'ward "Eep!"))
|
|
|
|
(stop-when (message 'quit)
|
|
|
|
(printf "Bye!\n")))
|
|
|
|
|
|
|
|
(define (monitor-interest-in thing)
|
|
|
|
(spawn #:name (list 'monitor-interest-in thing)
|
|
|
|
(during (observe thing)
|
|
|
|
(on-start (printf "Interest in ~v appeared\n" thing))
|
|
|
|
(on-stop (printf "Interest in ~v disappeared\n" thing)))))
|
|
|
|
|
|
|
|
(monitor-interest-in 'crash)
|
|
|
|
(monitor-interest-in 'quit)
|
|
|
|
|
|
|
|
(spawn* #:name 'main
|
|
|
|
(until (asserted (observe 'crash)))
|
|
|
|
(send! 'crash)
|
|
|
|
(flush!)
|
|
|
|
(flush!)
|
|
|
|
(flush!)
|
|
|
|
;; ^ give it time to actually terminate
|
|
|
|
;; v then wait for the next instance to appear
|
|
|
|
(until (asserted (observe 'quit)))
|
|
|
|
(send! 'quit))]
|
|
|
|
|
|
|
|
(it "should cause ward to produce an exception"
|
|
|
|
(actor-died? 'ward "Eep!"))
|
|
|
|
(it "should cause exactly one crash in total"
|
|
|
|
(= (length (collected-exns)) 1))
|
|
|
|
(expected-output (list "Starting ward")
|
|
|
|
(set "Interest in 'crash appeared"
|
|
|
|
"Interest in 'quit appeared")
|
|
|
|
(list "Crashing")
|
|
|
|
(set "Interest in 'quit disappeared"
|
|
|
|
"Interest in 'crash disappeared")
|
|
|
|
(list "Starting ward")
|
|
|
|
(set "Interest in 'crash appeared"
|
|
|
|
"Interest in 'quit appeared")
|
|
|
|
(list "Stopping ward"
|
|
|
|
"Bye!")
|
|
|
|
(set "Interest in 'quit disappeared"
|
|
|
|
"Interest in 'crash disappeared")))
|