[gnunet-scheme] 07/08: tests/distributed-hash-table: Test reconnecting and callbacks.

[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 84e2ec1fa7d5fa4dcbbca58efe35f9dcbe191759
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Feb 3 14:57:19 2022 +0000

    tests/distributed-hash-table: Test reconnecting and callbacks.
    
    * tests/distributed-hash-table.scm
      ("(DHT) bogus message from service --> all fibers stop, 'connected' and 
'disconnected' called"):
      Extract some logic to ...
      (determine-reported-errors,put-ill-formed-message): ... these new 
procedures.
      ("(DHT) ill-formed message from service --> all fibers stop, 'connected' 
and 'disconnected' called"):
      New test.
    
    Partially fixes: <https://notabug.org/maximed/scheme-gnunet/issues/16>.
---
 tests/distributed-hash-table.scm | 76 +++++++++++++++++++++++++++-------------
 1 file changed, 52 insertions(+), 24 deletions(-)

diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index f823d9e..79c7592 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -645,40 +645,68 @@ supported."
 (test-assert "(DHT) close, not connected --> all fibers stop, no callbacks 
called"
   (close-not-connected-no-fallbacks "dht" connect disconnect!))
 
-(test-equal "(DHT) bogus message from service --> all fibers stop, 'connected' 
and 'disconnected' called"
-  `((logic:ill-formed
-     ,(value->index (symbol-value message-type msg:dht:client:result))))
+(define* (determine-reported-errors proc #:key (n-connections 1))
   (call-with-spawner/wait*
    (lambda (config spawn)
      (define errors '())
-     (define connected? #false)
-     (define disconnected? #false)
-     (define disconnected-c (make-condition))
+     (define currently-connected? #false)
+     (define times-connected 0)
+     (define finally-disconnected-c (make-condition))
      (parameterize ((error-reporter (lambda foo
-                                     (pk 'foo foo)
-                                     (assert connected?)
+                                     (assert (> times-connected 0))
                                      (set! errors (cons foo errors)))))
        (define (connected)
-        (assert (not connected?))
-        (set! connected? #true))
+        (assert (not currently-connected?))
+        (set! currently-connected? #true)
+        (set! times-connected (+ 1 times-connected))
+        (assert (<= times-connected n-connections)))
        (define (disconnected)
-        (assert connected?)
-        (assert (not disconnected?))
-        (set! disconnected? #true)
-        (signal-condition! disconnected-c))
+        (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)
-       (wait disconnected-c)
-       (and connected? disconnected? errors)))
-   `(("dht" . ,(lambda (port spawn-fiber)
-                (define b (make-bytevector (sizeof /:message-header '())))
-                (define s (slice/write-only (bv-slice/read-write b)))
-                (set%! /:message-header '(type) s
-                       (value->index (symbol-value message-type 
msg:dht:client:result)))
-                (set%! /:message-header '(size) s (slice-length s))
-                (put-bytevector port b)
-                (close-port port))))))
+       (wait finally-disconnected-c)
+       (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)))
+  (set%! /:message-header '(type) s
+        (value->index (symbol-value message-type msg:dht:client:result)))
+  (set%! /:message-header '(size) s (slice-length s))
+  (put-bytevector port b))
+
+(test-equal "(DHT) ill-formed message from service --> all fibers stop, 
'connected' and 'disconnected' called"
+  `((logic:ill-formed
+     ,(value->index (symbol-value message-type msg:dht:client:result))))
+  (determine-reported-errors
+   (lambda (port spawn-fiber)
+     (put-ill-formed-message port)
+     (close-port port))))
+
+;; Allow reconnecting a few times and eventually ensure a permanent
+;; disconnecting to make the test terminate.
+(define n-connections 7)
+(test-equal "(DHT) end-of-file --> reconnect (all fibers eventually stop)"
+  `((logic:ill-formed
+     ,(value->index (symbol-value message-type msg:dht:client:result))))
+  (determine-reported-errors
+   (let ((i 0))
+     (lambda (port spawn-fiber)
+       (set! i (+ i 1))
+       (assert (<= i n-connections))
+       (when (= i n-connections)
+        (put-ill-formed-message port))
+       (close-port port)))
+   #:n-connections n-connections))
+
+;; TODO: would be nice to test that old requests are submitted again
+
 (test-end)

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