Commits

Moritz Heidkamp  committed 2f499c3

propagate closing of receiving channels only when no other receivers are registered on their source channel

  • Participants
  • Parent commits 545664e

Comments (0)

Files changed (2)

 (define (channel-messages channel)
   (queue->list (channel-queue channel)))
 
+(define (channel-has-receivers? channel)
+  (not (and (null? (channel-receivers channel))
+            (queue-empty? (channel-onetime-receivers channel)))))
+
 (define (flush-channel channel)
   (let ((queue     (channel-queue channel))
         (receivers (channel-receivers channel))
     (with-locked-channel channel
       (lambda ()
         (let loop ()
-          (unless (or (queue-empty? queue)
-                      (and (null? receivers) (queue-empty? onetime-receivers)))
+          (when (and (not (queue-empty? queue)) (channel-has-receivers? channel))
             (let ((message (queue-remove! queue)))
               (unless (queue-empty? onetime-receivers)
                 (run-callback-queue! onetime-receivers message)
     (on-channel-close
      receiving-channel
      (lambda ()
-       (close-channel source-channel)))
+       (with-locked-channel source-channel
+         (lambda ()
+           (channel-remove-receiver source-channel receiver)
+           (unless (channel-has-receivers? source-channel)
+             (close-channel source-channel))))))
     (set-finalizer!
      receiving-channel
      (lambda (x)

File tests/run.scm

   (test (channel-messages c) '())
   (test-assert (not (channel-closed? c)))
   (test-assert (not (channel-closed? sc)))
-  (close-channel sc)
-  (test-assert (channel-closed? c))
-  (test-assert (channel-closed? sc))
 
   (test-group "gc"
     (define c (make-channel 1 2))
     (set! rc #f)
     (gc!!)
     (channel-enqueue c 3)
-    (test '(1 2) (result))))
+    (test '(1 2) (result)))
+
+  (test-group "close propagation"
+    (define c1     (make-channel))
+    (define c1.1   (make-receiving-channel c1 void))
+    (define c1.2   (make-receiving-channel c1 void))
+    (define c1.2.1 (make-receiving-channel c1.2 void))
+    (close-channel c1.2.1)
+    (test-assert (channel-closed? c1.2.1))
+    (test-assert (channel-closed? c1.2))
+    (test-assert (not (channel-closed? c1.1)))
+    (test-assert (not (channel-closed? c1)))
+    (close-channel c1.1)
+    (test-assert (channel-closed? c1.1))
+    (test-assert (channel-closed? c1))))
 
 (test-group "fold-channel"
   (define c (make-channel 1 2))