[gnunet-scheme] branch master updated (1f78c1e -> fd17a8f)

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a change to branch master
in repository gnunet-scheme.

    from 1f78c1e  lost-and-found: Export and document the 
'losable-lost-and-found'.
     new fbb8276  dht/client: Simplify by eliminating the lost-and-found field.
     new 6b3e9e1  nse/client: Move creation of field values to the record 
protocol.
     new f7e60a6  tests: Extract the "notify disconnected after end-of-file, 
after 'connected'" test from NSE.
     new d2bc976  distributed-hash-table: Add a 
'disconnect-after-eof-after-connected' test.
     new 54ba96e  tests/distributed-hash-table: Notice an indeterministic test 
failure.
     new 0d8668a  doc: Document 'connect-after-eof-after-connected'.
     new 90791e9  doc: Make explanation of 'close-not-connected-no-fallbacks' 
more precise.
     new dd7f75c  Correct typo: close-not-connected-no-fallbacks -> 
close-not-connected-no-callbacks.
     new e50be30  cadet: skip failing test for now to allow other tests to run.
     new 7474bce  tests: Extract the "reconnects" test from NSE.
     new fd17a8f  distributed-hash-table: Add a 'reconnects' test.

The 11 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "add" were already present in the repository and have only
been added to this reference.


Summary of changes:
 doc/service-communication.tm     |  27 ++++++++---
 gnu/gnunet/dht/client.scm        |  12 ++---
 gnu/gnunet/nse/client.scm        |  18 +++++--
 tests/cadet.scm                  |   6 ++-
 tests/distributed-hash-table.scm |   8 +++-
 tests/network-size.scm           |  87 ++-------------------------------
 tests/utils.scm                  | 101 +++++++++++++++++++++++++++++++++++++--
 7 files changed, 150 insertions(+), 109 deletions(-)

diff --git a/doc/service-communication.tm b/doc/service-communication.tm
index 191aa84..c13323c 100644
--- a/doc/service-communication.tm
+++ b/doc/service-communication.tm
@@ -394,17 +394,32 @@
   </explain>
 
   <\explain>
-    <scm|(close-not-connected-no-fallbacks <var|service> <var|connect>
+    <scm|(close-not-connected-no-callbacks <var|service> <var|connect>
     <var|disconnect!> #:rest)>
   <|explain>
-    This tests the automatic reconnection logic. It verifies that if the
-    service daemon is down, the connection and disconnection callbacks are
-    not called. The optional argument <var|rest> is a list of extra arguments
-    to pass to <var|connect>.
+    This tests the connection and disconnection callbacks. It verifies that
+    if the service daemon is down, the connection and disconnection callbacks
+    are not called. The optional argument <var|rest> is a list of extra
+    arguments to pass to <var|connect>.
 
     When run sufficiently slowly, false negatives are possible.
   </explain>
 
+  <\explain>
+    <scm|(connect-after-eof-after-connected <var|service> <var|connect>)>
+  </explain|This tests the connection and disconnection callbacks, in case
+  the server disconnects without sending or receiving anything.<space|1em>It
+  verifies that the connection and disconnection callback is called and that
+  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>
@@ -417,7 +432,7 @@
       (test-assert "(DHT) close, not connected --\<gtr\> all fibers stop, no
       callbacks called"
 
-      \ \ (close-not-connected-no-fallbacks "dht" connect disconnect!))
+      \ \ (close-not-connected-no-callbacks "dht" connect disconnect!))
 
       (test-assert "(DHT) garbage collectable"
 
diff --git a/gnu/gnunet/dht/client.scm b/gnu/gnunet/dht/client.scm
index db999fb..8cb7ee2 100644
--- a/gnu/gnunet/dht/client.scm
+++ b/gnu/gnunet/dht/client.scm
@@ -102,7 +102,8 @@
          (only (gnu gnunet mq error-reporting)
                report-error)
          (only (gnu gnunet concurrency lost-and-found)
-               make-lost-and-found collect-lost-and-found-operation)
+               make-lost-and-found collect-lost-and-found-operation
+               losable-lost-and-found)
          (gnu gnunet dht struct)
          (only (gnu gnunet message protocols)
                message-type)
@@ -584,14 +585,11 @@ currently unsupported."
       ;; terminal-condition: a disconnect has been requested
       (fields (immutable terminal-condition server-terminal-condition)
              (immutable control-channel server-control-channel)
-             (immutable lost-and-found server-lost-and-found)
              ;; Atomic box holding an unsigned 64-bit integer.
              (immutable next-unique-id/box server-next-unique-id/box))
       (protocol (lambda (%make)
                  (lambda ()
-                   (define lost-and-found (make-lost-and-found))
-                   ((%make lost-and-found) (make-condition) (make-channel)
-                    lost-and-found
+                   ((%make (make-lost-and-found)) (make-condition) 
(make-channel)
                     ;; Any ‘small’ natural number will do.
                     (make-atomic-box 0))))))
 
@@ -622,7 +620,7 @@ do anything if @var{server} has been permanently 
disconnected."
                    ;; When not lingering, add this search object to the lost
                    ;; and found, such that it will eventually be cancelled.
                    ((%make (and (not linger?)
-                                (server-lost-and-found server)))
+                                (losable-lost-and-found server)))
                     server found query unique-id options linger?)))))
 
     (define-record-type (<put> %make-put put?)
@@ -762,7 +760,7 @@ code automatically tries to reconnect, so @var{connected} 
can be called after
       ;; but that causes ‘(DHT) garbage collectable’ to fail.
       (spawn-procedure spawn (server-terminal-condition server) config
                       old-id->operation-map (server-control-channel server)
-                      (server-lost-and-found server) #:connected connected
+                      (losable-lost-and-found server) #:connected connected
                       #:disconnected disconnected #:spawn spawn)
       server)
     (define (spawn-procedure spawn . rest)
diff --git a/gnu/gnunet/nse/client.scm b/gnu/gnunet/nse/client.scm
index 8044340..c54d664 100644
--- a/gnu/gnunet/nse/client.scm
+++ b/gnu/gnunet/nse/client.scm
@@ -88,7 +88,13 @@
              (immutable request-close?/box
                         server-request-close?/box)
              (immutable request-close-condition
-                        server-request-close-condition)))
+                        server-request-close-condition))
+      (protocol
+       (lambda (%make)
+        (lambda ()
+          (%make (make-atomic-box #false)
+                 (make-atomic-box #false)
+                 (make-condition))))))
 
     (define (estimate server)
       "Return the current estimate of the number of peers on the network,
@@ -223,10 +229,12 @@ until connected again.  It is possible for @var{updated} 
to be called
 shortly after calling @var{disconnected}.
 
 The procedures @var{updated}, @var{connected} and @var{disconnected} are 
optional."
+      (define server (%make-server))
       (define estimate/box (make-atomic-box #f))
-      (define request-close?/box (make-atomic-box #f))
-      (define request-close-condition (make-condition))
-      (reconnect estimate/box request-close?/box request-close-condition config
+      (reconnect (server-estimate/box server)
+                (server-request-close?/box server)
+                (server-request-close-condition server)
+                config
                 #:updated updated #:connected connected #:disconnected 
disconnected
                 #:spawn spawn)
-      (%make-server estimate/box request-close?/box request-close-condition))))
+      server)))
diff --git a/tests/cadet.scm b/tests/cadet.scm
index 9eaae2c..f4cd279 100644
--- a/tests/cadet.scm
+++ b/tests/cadet.scm
@@ -35,8 +35,10 @@
 
 (test-begin "CADET")
 (test-assert "(CADET) close, not connected --> all fibers stop, no callbacks 
called"
-  (close-not-connected-no-fallbacks "cadet" connect disconnect!))
-(test-assert "(CADET) garbage collectable"
+  (close-not-connected-no-callbacks "cadet" connect disconnect!))
+
+(test-skip 1) ; TODO: fix the bug
+(test-assert "(CADET) garbage collectable" ; TOO: error unbound variable 
(320:7 stub)
   (garbage-collectable "cadet" connect))
 
 (define %peer-identity
diff --git a/tests/distributed-hash-table.scm b/tests/distributed-hash-table.scm
index a961e43..268e7be 100644
--- a/tests/distributed-hash-table.scm
+++ b/tests/distributed-hash-table.scm
@@ -659,9 +659,13 @@ supported.  When @var{explode} is signalled, the 
connection is closed."
      #true)))
 
 (test-assert "(DHT) close, not connected --> all fibers stop, no callbacks 
called"
-  (close-not-connected-no-fallbacks "dht" connect disconnect!))
+  (close-not-connected-no-callbacks "dht" connect disconnect!))
 (test-assert "(DHT) garbage collectable"
   (garbage-collectable "dht" connect))
+(test-assert "(DHT) notify disconnected after end-of-file, after 'connected'"
+  (disconnect-after-eof-after-connected "dht" connect))
+(test-assert "(DHT) reconnects"
+  (reconnects "dht" connect))
 
 (define* (determine-reported-errors proc #:key (n-connections 1) (n-errors 1))
   (call-with-spawner/wait*
@@ -788,7 +792,7 @@ supported.  When @var{explode} is signalled, the connection 
is closed."
      #true)))
 
 ;; TODO: would be nice to verify that the necessary messages are sent to the
-;; DHT service.
+;; DHT service.  TODO: sometimes fails with ‘epoll instance is death’.
 (test-assert "cancelling a search within a search callback does not hang"
   (call-with-services/fibers
    `(("dht" . ,(simulate-dht-service)))
diff --git a/tests/network-size.scm b/tests/network-size.scm
index 8f8e6bb..f809d6e 100644
--- a/tests/network-size.scm
+++ b/tests/network-size.scm
@@ -185,93 +185,12 @@
      #t)))
 
 (test-assert "notify disconnected after end-of-file, after 'connected'"
-  (call-with-services/fibers
-   `(("nse" . ,(lambda (port spawn-fiber)
-                (close-port port))))
-   (lambda (config spawn-fiber)
-     (define disconnected? #f)
-     (define connected? #f)
-     (define c (make-condition))
-     (define (connected)
-       (set! connected? #t))
-     (define (disconnected)
-       (assert connected?)
-       ;; Because (gnu gnunet nse client) automatically reconnects,
-       ;; the following commented-out assertion can be false.
-       #;(assert (not disconnected?))
-       (set! disconnected? #t)
-       (signal-condition! c))
-     (define server
-       (nse:connect config #:spawn spawn-fiber #:connected connected
-                   #:disconnected disconnected))
-     (wait c)
-     ;; Give (gnu gnunet nse client) a chance to (incorrectly) call
-     ;; disconnected again.
-     (sleep 0.001)
-     #t)))
-
-(define forever (make-condition))
+  (disconnect-after-eof-after-connected "nse" nse:connect))
 
-(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-fallbacks
+  (close-not-connected-no-callbacks
    "nse" nse:connect nse:disconnect!
    #:rest (list #:disconnected #{don't-call-me}#)))
 
diff --git a/tests/utils.scm b/tests/utils.scm
index fb41ef3..58628c7 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -39,8 +39,10 @@
                             call-with-absent-service
                             trivial-service-config
                             #{don't-call-me}#
-                            close-not-connected-no-fallbacks
-                            garbage-collectable))
+                            close-not-connected-no-callbacks
+                            garbage-collectable
+                            disconnect-after-eof-after-connected
+                            reconnects))
 
 (define (make-nonblocking! sock)
   (fcntl sock F_SETFL
@@ -208,7 +210,7 @@ cannot be connected to."
 (define (#{don't-call-me}# . rest)
   (error "oops ~a" rest))
 
-(define* (close-not-connected-no-fallbacks service connect disconnect!
+(define* (close-not-connected-no-callbacks service connect disconnect!
                                           #:key (rest '()))
   "Try to connect to the @var{service} service in an environment where
 the service daemon is down.  Verify that the 'connected' and 'disconnected'
@@ -267,3 +269,96 @@ fiber exit and the fibers do not keep a reference to the 
service object."
     (if (>= trials n-trials)
        (>= (/ successes trials) (if (conservative-gc?) 8/10 1))
        (loop (if (test) (+ 1 successes) successes) (+ 1 trials)))))
+
+(define (disconnect-after-eof-after-connected service connect)
+  "Test that when connected to a sevice and an end-of-file is encountered,
+the disconnection callback is called and that the disconnection callback
+is called after the connection callback."
+  (call-with-services/fibers
+   `((,service . ,(lambda (port spawn-fiber)
+                   (close-port port))))
+   (lambda (config spawn-fiber)
+     (define disconnected? #f)
+     (define connected? #f)
+     (define c (make-condition))
+     (define (connected)
+       (set! connected? #t))
+     (define (disconnected)
+       (assert connected?)
+       ;; Because (gnu gnunet SERVICE client) automatically reconnects,
+       ;; the following commented-out assertion can be false.
+       #;(assert (not disconnected?))
+       (set! disconnected? #t)
+       (signal-condition! c))
+     (define server
+       (connect config #:spawn spawn-fiber #:connected connected
+               #:disconnected disconnected))
+     (wait c)
+     ;; Give (gnu gnunet SERVICE client) a chance to (incorrectly) call
+     ;; 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.