From 1de69c4d37f5cce96d44934e8dd521c1853f44c1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 30 Apr 2019 18:10:17 -0600
Subject: [PATCH] cs & thread: repair retention of subcustodians

A subcustodian was incorrectly registered as weak for its parent,
which means that an unreferenced custodian could get lost when
shutting down an ancestor.
---
 racket/src/thread/custodian.rkt | 14 +++++++++++---
 racket/src/thread/sink.rkt      |  6 ++++++
 2 files changed, 17 insertions(+), 3 deletions(-)
 create mode 100644 racket/src/thread/sink.rkt

diff --git a/racket/src/thread/custodian.rkt b/racket/src/thread/custodian.rkt
index a4dee3f39b..d31d2722d8 100644
--- a/racket/src/thread/custodian.rkt
+++ b/racket/src/thread/custodian.rkt
@@ -6,7 +6,8 @@
          "host.rkt"
          "evt.rkt"
          "semaphore.rkt"
-         "parameter.rkt")
+         "parameter.rkt"
+         "sink.rkt")
 
 (provide current-custodian
          make-custodian
@@ -76,7 +77,13 @@
   (check who custodian? parent)
   (define c (create-custodian))
   (set-custodian-place! c (custodian-place parent))
-  (define cref (do-custodian-register parent c do-custodian-shutdown-all #f #t #t))
+  (define cref (do-custodian-register parent c
+                                      ;; Retain children procs as long as proc for `c`
+                                      (let ([children (custodian-children c)])
+                                        (lambda (c)
+                                          (reference-sink children)
+                                          (do-custodian-shutdown-all c)))
+                                      #f #f #t))
   (set-custodian-parent-reference! c cref)
   (unless cref (raise-custodian-is-shut-down who parent))
   c)
@@ -134,7 +141,8 @@
      (define gc-roots (custodian-gc-roots c))
      (when gc-roots
        (hash-remove! gc-roots obj))
-     (host:enable-interrupts))))
+     (host:enable-interrupts))
+    (void)))
 
 ;; Hook for thread scheduling:
 (define post-shutdown-action void)
diff --git a/racket/src/thread/sink.rkt b/racket/src/thread/sink.rkt
new file mode 100644
index 0000000000..1fe5311c2b
--- /dev/null
+++ b/racket/src/thread/sink.rkt
@@ -0,0 +1,6 @@
+#lang racket/base
+
+(provide reference-sink)
+
+(define (reference-sink v)
+  (ephemeron-value (make-ephemeron #f (void)) (void) v))