Fix monitoring: I had neglected to use the wrapped main spec!
This commit is contained in:
parent
1ffd0afe66
commit
e67bffdcc3
22
os2.rkt
22
os2.rkt
|
@ -238,24 +238,30 @@
|
||||||
(define (make-send-message body [role 'publisher]) (send-message body role))
|
(define (make-send-message body [role 'publisher]) (send-message body role))
|
||||||
(define (make-kill [pid #f] #:reason [reason #f]) (kill pid reason))
|
(define (make-kill [pid #f] #:reason [reason #f]) (kill pid reason))
|
||||||
|
|
||||||
(define (make-spawn main [k #f]
|
(define (make-spawn raw-spec [k #f]
|
||||||
#:monitor? [monitor? #f]
|
#:monitor? [monitor? #f]
|
||||||
#:debug-name [debug-name #f]
|
#:debug-name [debug-name #f]
|
||||||
#:state-contract [state-contract any/c])
|
#:state-contract [state-contract any/c])
|
||||||
|
(match-define (boot-specification raw-main raw-contract)
|
||||||
|
(cond [(boot-specification? raw-spec) raw-spec]
|
||||||
|
[else (boot-specification raw-spec any/c)]))
|
||||||
(define maybe-monitored-main
|
(define maybe-monitored-main
|
||||||
(if monitor?
|
(if monitor?
|
||||||
(let ((unmonitored-main (if (procedure? main) main (lambda (self-pid) main))))
|
(let ((unmonitored-main (if (procedure? raw-main) raw-main (lambda (self-pid) raw-main))))
|
||||||
(lambda (self-pid)
|
(lambda (self-pid)
|
||||||
(define m (monitor self-pid debug-name))
|
(define m (monitor self-pid debug-name))
|
||||||
(prefix-transition (unmonitored-main self-pid)
|
(prefix-transition (unmonitored-main self-pid)
|
||||||
(role (list 'canary m) (topic-publisher m) #:state state))))
|
(role (list 'canary m) (topic-publisher m) #:state state))))
|
||||||
main))
|
raw-main))
|
||||||
|
(define final-contract
|
||||||
|
(cond [(eq? raw-contract any/c) state-contract]
|
||||||
|
[(eq? state-contract any/c) raw-contract]
|
||||||
|
[else (error 'spawn
|
||||||
|
"Cannot apply #:state-contract to already-contracted boot-specification")]))
|
||||||
(define spec
|
(define spec
|
||||||
(if (eq? state-contract any/c)
|
(if (eq? final-contract any/c)
|
||||||
main
|
maybe-monitored-main
|
||||||
(if (boot-specification? main)
|
(boot-specification maybe-monitored-main final-contract)))
|
||||||
(error 'spawn "Cannot apply #:state-contract to already-contracted boot-specification")
|
|
||||||
(boot-specification main state-contract))))
|
|
||||||
(spawn spec k debug-name))
|
(spawn spec k debug-name))
|
||||||
|
|
||||||
(define (extend-transition t . more-actions)
|
(define (extend-transition t . more-actions)
|
||||||
|
|
Loading…
Reference in New Issue