[gnunet-scheme] 251/324: tests/utils: Move call-with-spawner from tests/mq-stream.scm.

[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 f23603f013098a4b699948fe659ab7f157be678f
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Thu Sep 9 16:20:01 2021 +0200

    tests/utils: Move call-with-spawner from tests/mq-stream.scm.
    
    It will be used in tests/network-size.scm.
    
    * tests/mq-stream.scm (call-with-spawner, call-with-spawner/wait):
      Move to ...
    * tests/utils.scm: ... here and export.
---
 tests/mq-stream.scm | 30 ------------------------------
 tests/utils.scm     | 35 ++++++++++++++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 31 deletions(-)

diff --git a/tests/mq-stream.scm b/tests/mq-stream.scm
index b9819d0..84522b2 100644
--- a/tests/mq-stream.scm
+++ b/tests/mq-stream.scm
@@ -463,36 +463,6 @@
      (wait done/1)
      #t)))
 
-(define* (call-with-spawner proc . args)
-  (apply run-fibers
-        (lambda ()
-          (call-with-services
-           '()
-           (lambda (config spawn)
-             (proc spawn))))
-        args))
-
-;; When done, wait for every fiber to complete.
-;; Somewhat racy, don't use outside tests.
-(define* (call-with-spawner/wait proc . args)
-  (define h (make-weak-key-hash-table)) ; condition -> nothing in particular
-  (apply call-with-spawner
-        (lambda (spawn/not-waiting)
-          (define (spawn thunk)
-            (define done-condition (make-condition))
-            (hashq-set! h done-condition #f)
-            (spawn/not-waiting
-             (lambda ()
-               (thunk)
-               (signal-condition! done-condition))))
-          (define-values return-values
-            (proc spawn))
-          ;; Make sure every fiber completes before returning.
-          ;; XXX hash-for-each imposes a continuation barrier
-          (for-each wait (hash-map->list (lambda (x y) x) h))
-          (apply values return-values))
-        args))
-
 (define (two-sockets)
   (define sp (socketpair AF_UNIX SOCK_STREAM 0))
   (fcntl (car sp) F_SETFL
diff --git a/tests/utils.scm b/tests/utils.scm
index 1a0818b..5e20fc4 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -23,11 +23,14 @@
                #:select (bitwise-ior))
   #:use-module ((rnrs base) #:select (assert))
   #:use-module ((fibers) #:prefix #{fibers:}#)
+  #:autoload (fibers conditions) (make-condition signal-condition! wait)
   #:autoload (gnu gnunet config db)
   (hash->configuration hash-key key=? set-value!)
   #:export (conservative-gc? calls-in-tail-position?
                             call-with-services
-                            call-with-services/fibers))
+                            call-with-services/fibers
+                            call-with-spawner
+                            call-with-spawner/wait))
 
 ;; Current versions of guile (at least 3.0.5) use a conservative
 ;; garbage collector, so some tests concerning garbage collection
@@ -134,3 +137,33 @@ the services and each tails is a list of a procedure 
accepting ports
 
 (define (call-with-services/fibers service-alist proc)
   (fibers:run-fibers (lambda () (call-with-services service-alist proc))))
+
+(define* (call-with-spawner proc . args)
+  (apply fibers:run-fibers
+        (lambda ()
+          (call-with-services
+           '()
+           (lambda (config spawn)
+             (proc spawn))))
+        args))
+
+;; When done, wait for every fiber to complete.
+;; Somewhat racy, don't use outside tests.
+(define* (call-with-spawner/wait proc . args)
+  (define h (make-weak-key-hash-table)) ; condition -> nothing in particular
+  (apply call-with-spawner
+        (lambda (spawn/not-waiting)
+          (define (spawn thunk)
+            (define done-condition (make-condition))
+            (hashq-set! h done-condition #f)
+            (spawn/not-waiting
+             (lambda ()
+               (thunk)
+               (signal-condition! done-condition))))
+          (define-values return-values
+            (proc spawn))
+          ;; Make sure every fiber completes before returning.
+          ;; XXX hash-for-each imposes a continuation barrier
+          (for-each wait (hash-map->list (lambda (x y) x) h))
+          (apply values return-values))
+        args))

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