ffi/unsafe/custodian: handle already-shutdown custodians

pkgs/racket-doc/scribblings/foreign/custodian.scrbl

@@ -17,7 +17,9 @@ registering shutdown callbacks with custodians.}
 
 Registers @racket[callback] to be applied (in atomic mode and an
 unspecified Racket thread) to @racket[v] when @racket[custodian] is
-shutdown. The result is a pointer that can be supplied to
+shutdown. If @racket[custodian] is already shut down, the result is
+@racket[#f] and @racket[v] is not registered. Otherwise, the result is
+a pointer that can be supplied to
 @racket[unregister-custodian-shutdown] to remove the registration.
 
 If @racket[at-exit?] is true, then @racket[callback] is applied when
@@ -43,26 +45,35 @@ be no longer registered to the custodian, while the finalizer for
 
 
 @defproc[(unregister-custodian-shutdown [v any/c]
-                                        [registration _cpointer])
+                                        [registration cpointer?])
          void?]{
 
 Cancels a custodian-shutdown registration, where @racket[registration]
 is a previous result from @racket[register-custodian-shutdown] applied
-to @racket[v].}
+to @racket[v]. If @racket[registration] is @racket[#f], then no action
+is taken.}
 
 @defproc[(register-finalizer-and-custodian-shutdown
                  [v any/c]
                  [callback (any/c . -> . any)]
                  [custodian custodian? (current-custodian)]
                  [#:at-exit? at-exit? any/c #f]
-                 [#:weak? weak? any/c #f])
-         void?]{
+                 [#:weak? weak? any/c #f]
+                 [#:custodian-unavailable unavailable-callback ((-> void?) -> any) (lambda (reg-fnl) (reg-fnl))])
+         any]{
 
 Registers @racket[callback] to be applied (in atomic mode) to
 @racket[v] when @racket[custodian] is shutdown or when @racket[v] is
 about to be collected by the garbage collector, whichever happens
 first. The @racket[callback] is only applied to @racket[v] once.
 
+If @racket[custodian] is already shut down, then
+@racket[unavailable-callback] is applied in tail position to a
+function that registers a finalizer. By default, a finalizer is
+registered anyway, but usually a better choice is to report an error.
+If @racket[custodian] is not already shut down, then the result
+from @racket[register-finalizer-and-custodian-shutdown] is @|void-const|.
+
 @history[#:added "6.1.1.6"]}
 
 

pkgs/racket-test/tests/racket/ffi-custodian.rkt

@@ -60,3 +60,20 @@
 (for ([i 10])
   (unless (go)
     (error "shutdown failed")))
+
+;; ----------------------------------------
+;; Check that already-shutdown custodians are handled
+
+(when (register-custodian-shutdown 88 void c)
+  (error "should have been #f due to shutdown"))
+(unless (eq? 'cb
+             (register-finalizer-and-custodian-shutdown
+              88 void c
+              #:custodian-unavailable (lambda (proc)
+                                        (unless (and (procedure? proc)
+                                                     (procedure-arity-includes? proc 0))
+                                          (error "should have received a thunk"))
+                                        'cb)))
+  (error "custodian-shutdown callback wasn't called"))
+
+(unregister-custodian-shutdown 'anything #f)

racket/collects/ffi/unsafe/custodian.rkt

@@ -20,11 +20,13 @@
   (unsafe-custodian-register custodian obj proc at-exit? weak?))
 
 (define (unregister-custodian-shutdown obj mref)
-  (unsafe-custodian-unregister obj mref))
+  (when mref
+    (unsafe-custodian-unregister obj mref)))
 
 (define (register-finalizer-and-custodian-shutdown value callback
                                                    [custodian (current-custodian)]
-                                                   #:at-exit? [at-exit? #f])
+                                                   #:at-exit? [at-exit? #f]
+                                                   #:custodian-unavailable [custodian-unavailable (lambda (r) (r))])
   (define done? #f)
   (define (do-callback obj) ; called in atomic mode
     (unless done?
@@ -32,9 +34,14 @@
       (callback obj)))
   (define registration
     (register-custodian-shutdown value do-callback custodian #:at-exit? at-exit?))
-  (register-finalizer value
-    (lambda (obj)
-      (call-as-atomic
-       (lambda ()
-         (unregister-custodian-shutdown obj registration)
-         (do-callback obj))))))
+  (define (do-finalizer)
+    (register-finalizer
+     value
+     (lambda (obj)
+       (call-as-atomic
+        (lambda ()
+          (unregister-custodian-shutdown obj registration)
+          (do-callback obj))))))
+  (if registration
+      (do-finalizer)
+      (custodian-unavailable do-finalizer)))

racket/src/racket/src/thread.c

@@ -1378,6 +1378,9 @@ static Scheme_Object *unsafe_custodian_register(int argc, Scheme_Object *argv[])
   if (!SCHEME_PROCP(callback))
     scheme_wrong_contract("unsafe-custodian-register", "procedure?", 2, argc, argv);
 
+  if (!scheme_custodian_is_available(custodian))
+    return scheme_false;
+
   if (at_exit)
     mr = scheme_add_managed_close_on_exit(custodian, v, call_registered_callback, callback);
   else