Avoid premature termination of parent facet.
Scenario: - In script of facet X, (react (stop-when E (react ...))) - This creates facet Y, child of X. - Facet X has no endpoints, only its child facet Y. - When the stop-when fires, without this patch, facet X will be terminated because the *inner* react above hasn't executed yet. - With this patch, the check for a useless X is done after the stop-when has had a chance to run; and so X will survive for now.
This commit is contained in:
parent
837ab77002
commit
c9996d53ae
|
@ -227,6 +227,7 @@
|
||||||
*query-priority*
|
*query-priority*
|
||||||
*query-handler-priority*
|
*query-handler-priority*
|
||||||
*normal-priority*
|
*normal-priority*
|
||||||
|
*gc-priority*
|
||||||
*idle-priority*
|
*idle-priority*
|
||||||
#:count priority-count))
|
#:count priority-count))
|
||||||
|
|
||||||
|
@ -1098,8 +1099,12 @@
|
||||||
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
||||||
(schedule-action! delta-aggregate))))
|
(schedule-action! delta-aggregate))))
|
||||||
|
|
||||||
|
(schedule-script!
|
||||||
|
#:priority *gc-priority*
|
||||||
|
(lambda ()
|
||||||
(when (facet-live-but-inert? parent-fid)
|
(when (facet-live-but-inert? parent-fid)
|
||||||
(terminate-facet! parent-fid))))
|
(log-info "terminating ~v because it's dead and child ~v terminated" parent-fid fid)
|
||||||
|
(terminate-facet! parent-fid))))))
|
||||||
|
|
||||||
(define (add-stop-script! script-proc)
|
(define (add-stop-script! script-proc)
|
||||||
(update-facet! (current-facet-id)
|
(update-facet! (current-facet-id)
|
||||||
|
|
|
@ -0,0 +1,17 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; Demonstrate let-event.
|
||||||
|
;; Should print "Complete.".
|
||||||
|
|
||||||
|
(spawn* (let-event [(message 'one)
|
||||||
|
(message 'two)
|
||||||
|
(message 'three)]
|
||||||
|
(send! 'complete)))
|
||||||
|
|
||||||
|
(spawn (on-start (send! 'one)
|
||||||
|
(flush!) ;; needed to give the other actor time to
|
||||||
|
;; become responsive to the next message (!)
|
||||||
|
(send! 'two)
|
||||||
|
(flush!)
|
||||||
|
(send! 'three))
|
||||||
|
(stop-when (message 'complete)
|
||||||
|
(printf "Complete.\n")))
|
Loading…
Reference in New Issue