[gnunet-scheme] 10/11: tests: Extract the "reconnects" test from NSE.

[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 7474bce90f13f04bf6e95bb24e38c51ef303f147
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jun 29 22:41:09 2022 +0000

    tests: Extract the "reconnects" test from NSE.
    
    It's also useful for DHT!
    
    * tests/network-size.scm ("reconnects"): Generalise to ...
    * tests/utils.scm (reconnects): ... this new procedure.
      (forever): New variable.
    * doc/service-communication.tm (reconnects): Document it.
---
 doc/service-communication.tm |  7 +++++
 tests/network-size.scm       | 60 +--------------------------------------
 tests/utils.scm              | 67 +++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 74 insertions(+), 60 deletions(-)

diff --git a/doc/service-communication.tm b/doc/service-communication.tm
index 168fa82..c13323c 100644
--- a/doc/service-communication.tm
+++ b/doc/service-communication.tm
@@ -413,6 +413,13 @@
   the disconnection happens after connection. It does not test automatic
   reconnection.>
 
+  <\explain>
+    <scm|(reconnects service <var|service> <var|connect>)>
+  </explain|This tests the reconnection logic, by repeatedly closing the
+  connection from the server side and verifying that the connection and
+  disconnection callbacks are called in the right order and sufficiently
+  often.>
+
   <todo|document more>
 
   <\example>
diff --git a/tests/network-size.scm b/tests/network-size.scm
index f06e4ca..f809d6e 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -187,65 +187,7 @@
 (test-assert "notify disconnected after end-of-file, after 'connected'"
   (disconnect-after-eof-after-connected "nse" nse:connect))
 
-(define forever (make-condition))
-
-(test-assert "reconnects"
-  (let ((n 9)
-       (too-many? #f)
-       (done (make-condition)))
-    (call-with-services/fibers
-     `(("nse" . ,(lambda (port spawn-fiber)
-                  (if (> n 0)
-                      (begin
-                        (set! n (- n 1))
-                        (close-port port))
-                      (wait forever)))))
-     (lambda (config spawn-fiber)
-       (define disconnected? #f)
-       (define connected? #f)
-       (define connected-again (make-condition))
-       (define disconnect-count 0)
-       (define (connected)
-        (match (cons disconnected? connected?)
-          ((#t . #f)
-           (set! disconnected? #f)
-           (set! connected? #t)
-           (when (= disconnect-count 9)
-             (signal-condition! connected-again))
-           (values))
-          ((#t . #t) (error "impossible"))
-          ((#f . #f)
-           (set! connected? #t)
-           (values)) ; first connect
-          ((#f . #t) (error "doubly connected"))))
-       (define (disconnected)
-        (match (cons connected? disconnected?)
-          ((#t . #f)
-           (set! connected? #f)
-           (set! disconnected? #t)
-           (set! disconnect-count (+ 1 disconnect-count))
-           (cond
-            ((= disconnect-count 9)
-             (signal-condition! done))
-            ((> disconnect-count 9)
-             (set! too-many? #t)
-             (error "too many disconnects")))
-           (values))
-          ((#t . #t) (error "impossible"))
-          ((#f . #f)
-           (error "disconnected before connecting"))
-          ((#f . #t)
-           (error "doubly disconnected"))))
-       (define server
-        (nse:connect config #:spawn spawn-fiber #:connected connected
-                     #:disconnected disconnected))
-       (wait done)
-       (assert (not too-many?))
-       ;; We used to do (sleep 0.01) here but this was
-       ;; (rarely) insufficient.
-       (wait connected-again)
-       (assert connected?)
-       #t))))
+(test-assert "reconnects" (reconnects "nse" nse:connect))
 
 (test-assert "close, not connected --> all fibers stop, no callbacks called"
   (close-not-connected-no-callbacks
diff --git a/tests/utils.scm b/tests/utils.scm
index 56258d6..58628c7 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -41,7 +41,8 @@
                             #{don't-call-me}#
                             close-not-connected-no-callbacks
                             garbage-collectable
-                            disconnect-after-eof-after-connected))
+                            disconnect-after-eof-after-connected
+                            reconnects))
 
 (define (make-nonblocking! sock)
   (fcntl sock F_SETFL
@@ -297,3 +298,67 @@ is called after the connection callback."
      ;; disconnected again.
      (sleep 0.001)
      #t)))
+
+(define forever (make-condition))
+
+(define (reconnects service connect)
+  "This tests the reconnection logic, by repeatedly closing the
+connection from the server side and verifying that the connection
+and disconnection callbacks are called in the right order and
+sufficiently often."
+  (let ((n 9)
+       (too-many? #f)
+       (done (make-condition)))
+    (call-with-services/fibers
+     `((,service . ,(lambda (port spawn-fiber)
+                     (if (> n 0)
+                         (begin
+                           (set! n (- n 1))
+                           (close-port port))
+                         (wait forever)))))
+     (lambda (config spawn-fiber)
+       (define disconnected? #f)
+       (define connected? #f)
+       (define connected-again (make-condition))
+       (define disconnect-count 0)
+       (define (connected)
+        (match (cons disconnected? connected?)
+          ((#t . #f)
+           (set! disconnected? #f)
+           (set! connected? #t)
+           (when (= disconnect-count 9)
+             (signal-condition! connected-again))
+           (values))
+          ((#t . #t) (error "impossible"))
+          ((#f . #f)
+           (set! connected? #t)
+           (values)) ; first connect
+          ((#f . #t) (error "doubly connected"))))
+       (define (disconnected)
+        (match (cons connected? disconnected?)
+          ((#t . #f)
+           (set! connected? #f)
+           (set! disconnected? #t)
+           (set! disconnect-count (+ 1 disconnect-count))
+           (cond
+            ((= disconnect-count 9)
+             (signal-condition! done))
+            ((> disconnect-count 9)
+             (set! too-many? #t)
+             (error "too many disconnects")))
+           (values))
+          ((#t . #t) (error "impossible"))
+          ((#f . #f)
+           (error "disconnected before connecting"))
+          ((#f . #t)
+           (error "doubly disconnected"))))
+       (define server
+        (connect config #:spawn spawn-fiber #:connected connected
+                 #:disconnected disconnected))
+       (wait done)
+       (assert (not too-many?))
+       ;; We used to do (sleep 0.01) here but this was
+       ;; (rarely) insufficient.
+       (wait connected-again)
+       (assert connected?)
+       #t))))

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