Commits

Moritz Heidkamp committed 74e3b6b

remove receiving-channel receivers when they're finalized

Comments (0)

Files changed (2)

       (queue-add! (channel-on-drain-handlers channel) thunk)))
 
 (define (make-receiving-channel source-channel on-receive)
-  (let ((receiving-channel (make-channel)))
+  (let* ((receiving-channel (make-channel))
+         (receiver (let ((rc* (make-weak-locative receiving-channel)))
+                     (lambda (message)
+                       (and-let* ((rc (locative->object rc*)))
+                         (on-receive rc message))))))
     (on-channel-receive
      source-channel
-     (lambda (message)
-       (on-receive receiving-channel message)))
+     receiver)
     (on-channel-close
      receiving-channel
      (lambda ()
        (channel-close! source-channel)))
-    receiving-channel))
+    (set-finalizer!
+     receiving-channel
+     (lambda (x)
+       (channel-receiver-remove! source-channel receiver)))))
 
 (define (channel-fold! channel proc seed)
   (let ((accumulator (make-mutex)))
 (load-relative "../channel")
 (load-relative "../channel.import")
 (import channel)
-(use srfi-18 test data-structures)
+(use srfi-18 test data-structures miscmacros)
 
 (test-begin)
 
+(define (gc!!)
+  (repeat 5 (gc #t)))
+
 (define (make-receiver)
   (let ((q (make-queue)))
     (case-lambda
     (define f (channel-fork! c))
     (test 1 (length (channel-forks c)))
     (set! f #f)
-    (gc #t)
+    (gc!!)
     (test 1 (length (channel-forks c)))
     (channel-enqueue! c 'x)
     (test 0 (length (channel-forks c)))))
 (test-group "make-receiving-channel"
   (define c (make-channel 1 2 3))
   (define sc (make-receiving-channel c (lambda (sc m)
-                                      (channel-enqueue! sc (+ 1 m)))))
+                                         (channel-enqueue! sc (+ 1 m)))))
   (test (channel-messages sc) '(2 3 4))
   (test (channel-messages c) '())
   (channel-enqueue! c 4)
   (test-assert (not (channel-closed? sc)))
   (channel-close! sc)
   (test-assert (channel-closed? c))
-  (test-assert (channel-closed? sc)))
+  (test-assert (channel-closed? sc))
+
+  (test-group "gc"
+    (define c (make-channel 1 2))
+    (define result (make-receiver))
+    (define rc (make-receiving-channel c (lambda (_ m) (result m))))
+    (test '(1 2) (result))
+    (set! rc #f)
+    (gc!!)
+    (channel-enqueue! c 3)
+    (test '(1 2) (result))))
 
 (test-group "channel-fold!"
   (define c (make-channel 1 2))