[gnunet-scheme] 15/16: determine-reported-errors: Extract from the DHT tests.

[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 2fedc9e1cfb7742cd36fce44aa5a7da0b6d3b239
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Jul 24 13:16:25 2022 +0200

    determine-reported-errors: Extract from the DHT tests.
    
    Looks useful elsewhere as well.
    
    * tests/distributed-hash-table.scm (determine-reported-errors): Move
    to ...
    * tests/utils.scm (determine-reported-errors): ... here, and adjust
    API to not be specific to DHT, and adjust DHT tests to new API.
    * doc/service-communication.tm (determine-reported-errors): Document it.
---
 doc/service-communication.tm     | 16 +++++++++++++
 tests/distributed-hash-table.scm | 44 ++++------------------------------
 tests/utils.scm                  | 52 +++++++++++++++++++++++++++++++++++++++-
 3 files changed, 71 insertions(+), 41 deletions(-)

diff --git a/doc/service-communication.tm b/doc/service-communication.tm
index c13323c..3ed9e8f 100644
--- a/doc/service-communication.tm
+++ b/doc/service-communication.tm
@@ -420,6 +420,22 @@
   disconnection callbacks are called in the right order and sufficiently
   often.>
 
+  <\explain>
+    <scm|(determine-reported-errors <var|service> <var|connect> <var|proc>
+    #:key (<var|n-connections> 1) (<var|n-errors> 1))>
+  <|explain>
+    This is not a test by itself, but can be used as basis for writing tests
+    on error reporting logic. It connects to a service simulated by
+    <var|proc>, builds a list of errors passed to <scm|error-reporter> and
+    returns it. After a disconnect, it will automatically reconnect until
+    <var|n-connections> have been made. It also waits for <var|n-errors> to
+    be gathered and verifies that all fibers complete.
+
+    The simulation is done by the procedure <var|proc>. It is a procedure
+    accepting the connction port as seen by the server and can e.g. write to
+    the port and close it.
+  </explain>
+
   <todo|document more>
 
   <\example>
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index fd24aa7..0a98e85 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -675,46 +675,6 @@ supported.  When @var{explode} is signalled, the 
connection is closed."
 (test-assert "(DHT) reconnects"
   (reconnects "dht" connect))
 
-(define* (determine-reported-errors proc #:key (n-connections 1) (n-errors 1))
-  (call-with-spawner/wait*
-   (lambda (config spawn)
-     (define errors '())
-     (define currently-connected? #false)
-     (define times-connected 0)
-     (define times-errored 0)
-     (define finally-disconnected-c (make-condition))
-     (define all-errors-c (make-condition))
-     (parameterize ((error-reporter (lambda foo
-                                     (assert (> times-connected 0))
-                                     (set! times-errored (+ 1 times-errored))
-                                     (set! errors (cons foo errors))
-                                     (when (>= times-errored n-errors)
-                                       (signal-condition! all-errors-c)))))
-       (define (connected)
-        (assert (not currently-connected?))
-        (set! currently-connected? #true)
-        (set! times-connected (+ 1 times-connected))
-        (assert (<= times-connected n-connections)))
-       (define (disconnected)
-        (assert currently-connected?)
-        (set! currently-connected? #false)
-        (when (= times-connected n-connections)
-          (signal-condition! finally-disconnected-c)))
-       (define server
-        (connect config #:connected connected #:disconnected disconnected
-                 #:spawn spawn))
-       ;; Give 'error-reporter' a chance to be called too often
-       (sleep 0.001)
-       ;; The error handler and 'disconnected' are called in no particular
-       ;; order, so we have to wait for both.
-       (wait finally-disconnected-c)
-       (wait all-errors-c)
-       ;; keep 'server' reachable long enough.
-       (pk server)
-       (and (not currently-connected?)
-           (= times-connected n-connections) errors)))
-   `(("dht" . ,proc))))
-
 (define (put-ill-formed-message port)
   (define b (make-bytevector (sizeof /:message-header '())))
   (define s (slice/write-only (bv-slice/read-write b)))
@@ -727,6 +687,8 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
   `((logic:ill-formed
      ,(value->index (symbol-value message-type msg:dht:client:result))))
   (determine-reported-errors
+   "dht"
+   connect
    (lambda (port spawn-fiber)
      (put-ill-formed-message port)
      (close-port port))))
@@ -738,6 +700,8 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
   `((logic:ill-formed
      ,(value->index (symbol-value message-type msg:dht:client:result))))
   (determine-reported-errors
+   "dht"
+   connect
    (let ((i 0))
      (lambda (port spawn-fiber)
        (set! i (+ i 1))
diff --git a/tests/utils.scm b/tests/utils.scm
index 58628c7..7428281 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -28,6 +28,7 @@
   #:autoload (fibers timers) (sleep)
   #:autoload (gnu gnunet config db)
   (hash->configuration hash-key key=? set-value!)
+  #:autoload (gnu gnunet mq error-reporting) (error-reporter)
   #:export (conservative-gc? calls-in-tail-position?
                             call-with-services
                             call-with-services/fibers
@@ -42,7 +43,8 @@
                             close-not-connected-no-callbacks
                             garbage-collectable
                             disconnect-after-eof-after-connected
-                            reconnects))
+                            reconnects
+                            determine-reported-errors))
 
 (define (make-nonblocking! sock)
   (fcntl sock F_SETFL
@@ -362,3 +364,51 @@ sufficiently often."
        (wait connected-again)
        (assert connected?)
        #t))))
+
+(define* (determine-reported-errors service connect proc #:key (n-connections 
1) (n-errors 1))
+  "This procedure can be used as a basic for the error reporting logic --
+it connects to a simulated service, builds a list of errors passed to
+@code{error-reporter} and return it.  After a disconnect, it will automatically
+reconnect until @var{n-connections} have been made.  It also waits for 
@var{n-errors}
+to be gathered and verifies that all fibers complete.
+
+The simulation is done by the procedure @var{proc}.  It is a procedure 
accepting the
+connection port as seen by the server and can e.g. write to the port or close 
it."
+  (call-with-spawner/wait*
+   (lambda (config spawn)
+     (define errors '())
+     (define currently-connected? #false)
+     (define times-connected 0)
+     (define times-errored 0)
+     (define finally-disconnected-c (make-condition))
+     (define all-errors-c (make-condition))
+     (parameterize ((error-reporter (lambda foo
+                                     (assert (> times-connected 0))
+                                     (set! times-errored (+ 1 times-errored))
+                                     (set! errors (cons foo errors))
+                                     (when (>= times-errored n-errors)
+                                       (signal-condition! all-errors-c)))))
+       (define (connected)
+        (assert (not currently-connected?))
+        (set! currently-connected? #true)
+        (set! times-connected (+ 1 times-connected))
+        (assert (<= times-connected n-connections)))
+       (define (disconnected)
+        (assert currently-connected?)
+        (set! currently-connected? #false)
+        (when (= times-connected n-connections)
+          (signal-condition! finally-disconnected-c)))
+       (define server
+        (connect config #:connected connected #:disconnected disconnected
+                 #:spawn spawn))
+       ;; Give 'error-reporter' a chance to be called too often
+       (sleep 0.001)
+       ;; The error handler and 'disconnected' are called in no particular
+       ;; order, so we have to wait for both.
+       (wait finally-disconnected-c)
+       (wait all-errors-c)
+       ;; keep 'server' reachable long enough.
+       (pk server)
+       (and (not currently-connected?)
+           (= times-connected n-connections) errors)))
+   `((,service . ,proc))))

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