From c9996d53ae84bdbd7bdbd42c5b81b437cea8bc50 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 10 Aug 2017 15:08:48 -0400
Subject: [PATCH] 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.
---
 racket/syndicate/actor.rkt                    |  9 +++++++--
 racket/syndicate/examples/actor/let-event.rkt | 17 +++++++++++++++++
 2 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 racket/syndicate/examples/actor/let-event.rkt

diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt
index 2c7befd..eb818da 100644
--- a/racket/syndicate/actor.rkt
+++ b/racket/syndicate/actor.rkt
@@ -227,6 +227,7 @@
     *query-priority*
     *query-handler-priority*
     *normal-priority*
+    *gc-priority*
     *idle-priority*
     #:count priority-count))
 
@@ -1098,8 +1099,12 @@
          (current-actor-state (struct-copy actor-state a [mux new-mux]))
          (schedule-action! delta-aggregate))))
 
-    (when (facet-live-but-inert? parent-fid)
-      (terminate-facet! parent-fid))))
+    (schedule-script!
+     #:priority *gc-priority*
+     (lambda ()
+       (when (facet-live-but-inert? 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)
   (update-facet! (current-facet-id)
diff --git a/racket/syndicate/examples/actor/let-event.rkt b/racket/syndicate/examples/actor/let-event.rkt
new file mode 100644
index 0000000..ad2b6a6
--- /dev/null
+++ b/racket/syndicate/examples/actor/let-event.rkt
@@ -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")))