From 0b8ea67bb3e36a38822cc449b65e4babb579a46d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 22 May 2021 17:30:28 -0600
Subject: [PATCH] Chez Scheme: use an ordered finalizer for mutexes and
 condition variables

That way, a mutex or conditional variable can be referenced by
something else that has a finalizer and that might use the mutex or
condition variable.

Closes #3842
---
 .../tests/racket/os-async-channel.rkt         | 25 +++++++++++++++++--
 racket/src/ChezScheme/mats/thread.ms          |  2 +-
 racket/src/ChezScheme/s/prims.ss              |  4 +--
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/os-async-channel.rkt b/pkgs/racket-test/tests/racket/os-async-channel.rkt
index 5d91f676d7..f07ecab75b 100644
--- a/pkgs/racket-test/tests/racket/os-async-channel.rkt
+++ b/pkgs/racket-test/tests/racket/os-async-channel.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
-(require ffi/unsafe/os-thread
+(require ffi/unsafe
+         ffi/unsafe/os-thread
          ffi/unsafe/os-async-channel)
 
 (when (os-thread-enabled?)
@@ -37,5 +38,25 @@
          (printf "Done in ~a gets\n" steps)]
         [else
          (os-async-channel-put ch 0)
-         (loop new-counter (add1 steps))]))))
+         (loop new-counter (add1 steps))])))
 
+  ;; ----------------------------------------
+
+  ;; make sure an os-async-channel can be used in a finalizer
+  
+  (define finalized? #f)
+  
+  (let ()  ;; if `begin`, no problem
+    (define c (make-os-async-channel))
+    (register-finalizer (list c)
+                        (lambda (cs)
+                          (os-async-channel-put (car cs) #f)
+                          (set! finalized? #t))))
+
+  (for ([i 100])
+    (unless finalized?
+      (sync (system-idle-evt))
+      (collect-garbage)))
+
+  (unless finalized?
+    (error "finalizer never called")))
diff --git a/racket/src/ChezScheme/mats/thread.ms b/racket/src/ChezScheme/mats/thread.ms
index 12870933cb..28b6dedac6 100644
--- a/racket/src/ChezScheme/mats/thread.ms
+++ b/racket/src/ChezScheme/mats/thread.ms
@@ -1457,7 +1457,7 @@
                         (format "~a is defunct" what)))])
         (thunk)
         (error #f "error expected")))
-    (let ([g (make-guardian)])
+    (let ([g (make-guardian #t)])
       (g (make-mutex))
       (collect)
       (let ([m (g)])
diff --git a/racket/src/ChezScheme/s/prims.ss b/racket/src/ChezScheme/s/prims.ss
index c276e1ddb0..eecb0fecb3 100644
--- a/racket/src/ChezScheme/s/prims.ss
+++ b/racket/src/ChezScheme/s/prims.ss
@@ -1952,8 +1952,8 @@
       (condition-guardian c)
       c)))
 
-(define mutex-guardian (make-guardian))
-(define condition-guardian (make-guardian))
+(define mutex-guardian (make-guardian #t))
+(define condition-guardian (make-guardian #t))
 
 (set! fork-thread
   (lambda (t)