[gnunet-scheme] 206/324: mq-impl/stream: Flush the output port regularily.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 3fb8dd258507e784bec451c4389c4cb7c8b1290f
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Tue Aug 31 15:17:51 2021 +0200

    mq-impl/stream: Flush the output port regularily.
    
    * gnu/gnunet/mq-impl/stream.scm
      (handle-output!): Call 'force-output' after every 'send-round'.
    * tests/mq-stream.scm ("output buffers are flushed"): New test.
---
 gnu/gnunet/mq-impl/stream.scm |  7 ++++++-
 tests/mq-stream.scm           | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/gnu/gnunet/mq-impl/stream.scm b/gnu/gnunet/mq-impl/stream.scm
index a050f74..6a03b8a 100644
--- a/gnu/gnunet/mq-impl/stream.scm
+++ b/gnu/gnunet/mq-impl/stream.scm
@@ -76,7 +76,7 @@
                EPROTOTYPE EPIPE
                PF_UNIX SOCK_STREAM F_GETFD F_SETFD F_GETFL F_SETFL FD_CLOEXEC
                O_NONBLOCK AF_UNIX
-               socket connect fcntl
+               socket connect fcntl force-output
                make-socket-address
                exception-args exception-kind)
          (only (rnrs io ports)
@@ -182,6 +182,11 @@ TODO: closing, destroying @var{mq}, @var{output}."
          ;; Doing 'wait!' or 'send-round' the other way around
          ;; should be acceptable as well.
          (send-round)
+         ;; If 'output' is buffered, make sure bytes don't just sit
+         ;; in the buffer forever.  Don't flush after each individual
+         ;; envelope for performance.  TODO: should connect-unix enable
+         ;; buffering?
+         (force-output output)
          (wait!)
          (loop))))
 
diff --git a/tests/mq-stream.scm b/tests/mq-stream.scm
index e7c6d3b..3df00fe 100644
--- a/tests/mq-stream.scm
+++ b/tests/mq-stream.scm
@@ -625,4 +625,47 @@
    #:parallelism 1))
 ;; ^ if this test blocks, that means not all fibers have stopped
 
+(test-assert "output buffers are flushed"
+  (let^ ((<-- (alpha beta) (two-sockets))
+         ;; In Guile, by default, new sockets are unbuffered.
+         ;; Add a buffer.
+         (! _ (setvbuf alpha 'block 64))
+         (! _ (setvbuf beta 'block 64))
+         (! mq (make-message-queue no-handlers no-error-handler
+                                   (lambda (_) (values))))
+         ;; Send a message.  As the message is smaller than the buffer size,
+         ;; it will be buffered unless 'handle-output!' takes special action.
+         (! _ (send-message! mq (slice/read-only (bv-slice/read-write #vu8(0 4 
0 0)))))
+         (! waited?
+            (let/ec ec
+              (let ((old-waiter (current-write-waiter)))
+                (parameterize ((current-write-waiter
+                                (lambda (p)
+                                  (if (eq? p alpha)
+                                      (ec #t)
+                                      (old-waiter p)))))
+                  (handle-output! mq alpha
+                                  (lambda ()
+                                    (pk 'waiting...)
+                                    ((pk 'escaping ec) #f)
+                                    (pk 'escaped!)))))))
+         ;; If HANDLE-OUTPUT! blocked, that meant the underlying system call
+         ;; was called, so the kernel got (some of the) data and all is well
+         ;; -- except that the kernel buffer size of 4 bytes seems rather tiny.
+         (? waited?
+            (format (current-error-port) "≤4 bytes seems rather small~%")
+            #t)
+        (! old-read-waiter (current-read-waiter)) )
+        ;; If waited? is false, that means HANDLE-OUTPUT! succeeded and now
+        ;; the bytes are in Guile's or the kernel's buffers.  Test if they
+        ;; are in the kernel's.
+       (let/ec ec
+         (equal? #vu8(0 4 0 0)
+                 (parameterize ((current-read-waiter
+                                 (lambda (p)
+                                   (if (eq? p beta)
+                                       (ec #f)
+                                       (old-read-waiter p)))))
+                   (get-bytevector-some beta))))))
+
 (test-end "mq-stream")

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.