[gnunet-scheme] branch master updated: tests/cadet: Verify that messages are received.

[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.

The following commit(s) were added to refs/heads/master by this push:
     new bd39d42  tests/cadet: Verify that messages are received.
bd39d42 is described below

commit bd39d42265187e040b775c62c4a5ea72fd448f39
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Aug 26 13:00:27 2022 +0200

    tests/cadet: Verify that messages are received.
    
    * tests/cadet.scm
    ("data is properly sent in response to acknowledgements, in-order"):
    In the msg:cadet:local:data error handler, count the number of
    received messages and check for consistency with n-sent, n-added and
    total-acknowledgements. In the 'synchronize' handler, verify that the
    number of sent messages eventually becomes equal to the number of
    received messages.
---
 tests/cadet.scm | 48 ++++++++++++++++++++++++++++++++----------------
 1 file changed, 32 insertions(+), 16 deletions(-)

diff --git a/tests/cadet.scm b/tests/cadet.scm
index b883f5d..eece218 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -268,8 +268,6 @@
   ;; It is verified that, when there is a sufficient amount of 
acknowledgements,
   ;; the messages are all sent to the service, that they aren't sent too early
   ;; and that they are sent in-order.
-  ;;
-  ;; TODO: actually check the first once.
   (property ((messages+acknowledgements
              ($list
               ($choose
@@ -286,15 +284,32 @@
                ;; of the test.
                (error ($const 'synchronize))))))
     (pk 'iter) ; indicate it's not hanging
-    (let ((server-channel (make-channel)))
+    (let ((server-channel (make-channel))
+         ;; No atomic boxes are required here even though they are accessed 
and mutated
+         ;; from multiple fibers, because of #:parallelism 0 and #:hz 0.
+         (n-received 0)
+         (n-added 0) ; how many messages have been added to the queue so far
+         (n-sent 0) ; how many of those messages have been irrevocably sent
+         (total-acknowledgements 0))
       (call-with-services/fibers
        `(("cadet" .
          ,(lambda (port spawn-fiber)
+            (define message-handler/local-data
+              (message-handler ; TODO: simple-message-handler
+               (type (symbol-value message-type msg:cadet:local:data))
+               ((interpose exp) exp)
+               ((well-formed? s) #true)
+               ((handle! message)
+                (set! n-received (+ 1 n-received))
+                (assert (<= n-received n-sent))
+                (assert (<= n-received n-added))
+                (assert (<= n-received total-acknowledgements))
+                (values))))
             (define message-queue
               (port->message-queue port
                                    (message-handlers
                                     no-operation-message-handler/channel-create
-                                    no-operation-message-handler/local-data)
+                                    message-handler/local-data)
                                    no-error-handler
                                    #:spawn spawn-fiber))
             (let loop ()
@@ -314,11 +329,6 @@
           (open-channel! server address0 (message-handlers)))
         (define message-queue
           (channel-message-queue channel))
-        ;; No atomic boxes are required here even though they are accessed and 
mutated
-        ;; from multiple fibers, because of #:parallelism 0 and #:hz 0.
-        (define n-added 0) ; how many messages have been added to the queue so 
far
-        (define n-sent 0) ; how many of those messages have been irrevocably 
sent
-        (define total-acknowledgements 0)
         (define (make-notify-sent! i)
           (lambda ()
             ;; Verify that messages were sent in-order,
@@ -336,24 +346,30 @@
         (let loop ((remaining messages+acknowledgements))
           (match remaining
             (('synchronize . remaining)
-             ;; Check that all the messages that could be sent have been sent
-             ;; (no corking was requested, and the previous loop simulated
+             ;; Check that all the messages that could be sent are sent
+             ;; and received (no corking was requested, and the loop simulates
              ;; passage of some time).
-             (let loop ((old-to-be-sent +inf.0))
+             (let loop ((old-to-be-sent +inf.0)
+                        (old-to-be-received +inf.0))
                (define new-to-be-sent
                  (- (min total-acknowledgements n-added) n-sent))
+               (define new-to-be-received
+                 (- (min total-acknowledgements n-added) n-received))
                (assert (<= 0 new-to-be-sent))
-               (assert (< new-to-be-sent old-to-be-sent)) ; bail out if no 
progress is made
-               (when (< 0 new-to-be-sent)
+               (assert (<= 0 new-to-be-received))
+               (assert (or (< new-to-be-sent old-to-be-sent) ; bail out if no 
progress is made
+                           (< new-to-be-received old-to-be-received)))
+               (when (or (< 0 new-to-be-sent)
+                         (< 0 new-to-be-received))
                  ;; Give the various fibers a chance to process the messages. 
The allowed
                  ;; amount of context switched is proportional to the number 
of messages
                  ;; that still need to be sent. The number 16 is an 
over-approximation,
                  ;; the exact value doesn't matter to this test.
-                 (let loop* ((n (* 16 (+ 1 new-to-be-sent))))
+                 (let loop* ((n (* 16 (+ 1 (+ new-to-be-sent 
new-to-be-received)))))
                    (when (> n 0)
                      (yield-current-task)
                      (loop* (- n 1))))
-                 (loop new-to-be-sent)))
+                 (loop new-to-be-sent new-to-be-received)))
              (loop remaining))
             ((#(n-new-messages n-new-acknowledgements) . remaining)
              (put-message server-channel n-new-acknowledgements)

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