[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnunet-scheme] branch master updated: tests/cadet: Verify that messages
From: |
gnunet |
Subject: |
[gnunet-scheme] branch master updated: tests/cadet: Verify that messages are received. |
Date: |
Fri, 26 Aug 2022 13:03:25 +0200 |
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.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [gnunet-scheme] branch master updated: tests/cadet: Verify that messages are received.,
gnunet <=