syndicate-rkt/syndicate/test/core/supervise.rkt

53 lines
1.9 KiB
Racket

#lang syndicate/test-implementation
;; Simple tests of supervision functionality.
(require syndicate/supervise)
(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")))