[gnunet-scheme] 131/324: tests: mq: Work-around guile-fibers bug.

[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 cabfcf2c1aafef72ca248486ba5b2730e142ad2c
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sat Jun 12 11:58:29 2021 +0200

    tests: mq: Work-around guile-fibers bug.
    
    Using #:drain? #t with parallelism is currently broken,
    see <https://github.com/wingo/fibers/issues/47>.
    
    * tests/mq.scm
      (thread): Remove debugging code for guile-fibers bug.
      (results->array)[visit-per-thread]: Likewise.
      ("nothing lost when sending concurrently"): Likewise, and work
      around draining bug with condition variables.
      ("is the draining bug fixed?"): Remove fake test.
---
 tests/mq.scm | 40 ++++++++--------------------------------
 1 file changed, 8 insertions(+), 32 deletions(-)

diff --git a/tests/mq.scm b/tests/mq.scm
index bc05f9d..a9a3644 100644
--- a/tests/mq.scm
+++ b/tests/mq.scm
@@ -356,7 +356,6 @@ invocations, and at other times doing nothing.
        (proc mq)))))
 
 (define (thread mq thread-index)
-  (pk 'j thread-index)
   (parameterize ((received/thread '())
                 (i/thread 0)
                 (random/thread
@@ -365,16 +364,6 @@ invocations, and at other times doing nothing.
        ((>= i N_MESSAGES))
       (send-message! mq (make-thread-message thread-index i)
                     #:priority prio))
-    ;; If you try to debug "the draining bug bites you",
-    ;; notice that while there is (j 0) ... (j (- N_THREAD 1))
-    ;; in the output, some (i index) are missing.
-    ;;
-    ;; A bug in guile-fibers?
-    (pk 'i thread-index)
-    ;; See "the draining bug bites you".
-    ;; This assertion never happens FWIW.
-    (assert (or (pair? (received/thread))
-               (null? (received/thread))))
     (received/thread)))
 
 (define (make-restricted-sender how-many make-sender inner-proc)
@@ -450,17 +439,6 @@ with @code{x}."
     (define message-index (cdr message))
     (array-set! a #t message-index thread-index))
   (define (visit-per-thread _ messages)
-    ;; TODO: once, I got a
-    ;; (wrong-type-arg "for-each" "Not a list: ~S" (#<unspecified>) #f)
-    ;; _after_ (pk 'n-leftovers').
-    ;;
-    ;; After some debugging, it appears run-fibers with #:drain? #t
-    ;; sometimes forgets about a fiber.
-    (unless (or (null? messages) (pair? messages))
-      (pk 'the-sporadic-bug _ messages)
-      (backtrace)
-      (error "the draining bug bites you (_: ~s) (messages: ~s)"
-            _ messages))
     (for-each visit-message messages))
   (vector-for-each visit-per-thread per-thread-sent)
   a)
@@ -485,6 +463,7 @@ with @code{x}."
         ;; The ‘drained-out’ messages are put
         ;; at index N_THREAD.
         (results (make-vector (+ 1 N_THREAD)))
+         (done? (vector-unfold (lambda (_) (make-condition)) N_THREAD))
         (ready? (make-condition)))
     (run-fibers
      (lambda ()
@@ -493,10 +472,15 @@ with @code{x}."
          (lambda ()
            (wait ready?)
            (vector-set! results thread-index
-                        (thread mq thread-index)))))
+                        (thread mq thread-index))
+            (signal-condition! (vector-ref done? thread-index)))))
        (for-each run! thread-indices)
        ;; Try to start every thread at the same time!
-       (signal-condition! ready?))
+       (signal-condition! ready?)
+       ;; #:drain? #t with parallelism is broken,
+       ;; see <https://github.com/wingo/fibers/issues/47>.
+       ;; So explicitely wait on each fiber.
+       (vector-for-each (lambda (_ c) (wait c)) done?))
      #:drain? #t
      ;; No need
      #:install-suspendable-ports? #f
@@ -508,13 +492,5 @@ with @code{x}."
     (parameterize ((drain? #t)
                   (received/thread '()))
       (try-send-again! mq)
-      (pk 'n-leftovers (length (received/thread)))
       (vector-set! results N_THREAD (received/thread)))
     (array-missing (results->array results))))
-
-;; See "the draining bug bites you"
-;; in results->array.
-(test-expect-fail 1)
-(test-eq "is the draining bug fixed?"
-  'yes
-  'no)

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