guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Wed, 3 May 2023 05:41:14 -0400 (EDT)

branch: master
commit 6fa99ec2c948cfca98e0ea36e6d2c163af77c52f
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue May 2 17:57:47 2023 +0200

    tests: Use 'spawn' when available.
    
    * tests/remote.scm (spawn?): New variable.
    (start-worker, start-server): Use it instead of 'primitive-fork'.
---
 tests/remote.scm | 44 +++++++++++++++++++++++++-------------------
 1 file changed, 25 insertions(+), 19 deletions(-)

diff --git a/tests/remote.scm b/tests/remote.scm
index 7ca2d97..8e4db5a 100644
--- a/tests/remote.scm
+++ b/tests/remote.scm
@@ -41,16 +41,24 @@
 (define worker
   (make-parameter #f))
 
+(define spawn?
+  (if (defined? 'spawn)                           ;introduced in Guile 3.0.9
+      (@ (guile) spawn)
+      (lambda* (program arguments #:key (search-path? #f))
+        (match (primitive-fork)
+          (0
+           (apply (if search-path? execlp execl) program arguments))
+          (pid
+           pid)))))
+
 (define (start-worker)
-  (worker
-   (match (primitive-fork)
-     (0
-      (setenv "REQUEST_PERIOD" "1")
-      (execlp "cuirass" "cuirass" "remote-worker"
-              "--server=127.0.0.1:5555"
-              "--private-key=tests/signing-key.sec"
-              "--public-key=tests/signing-key.pub"))
-     (pid pid))))
+  (setenv "REQUEST_PERIOD" "1")
+  (worker (spawn "cuirass"
+                 '("cuirass" "remote-worker"
+                   "--server=127.0.0.1:5555"
+                   "--private-key=tests/signing-key.sec"
+                   "--public-key=tests/signing-key.pub")
+                 #:search-path? #t)))
 
 (define (stop-worker)
   (let ((worker (worker)))
@@ -58,16 +66,14 @@
     (waitpid worker)))
 
 (define (start-server)
-  (server
-   (match (primitive-fork)
-     (0
-      (mkdir-p "tests/cache")
-      (execlp "cuirass" "cuirass" "remote-server"
-              (string-append "--database=" (%package-database))
-              "--cache=tests/cache"
-              "--private-key=tests/signing-key.sec"
-              "--public-key=tests/signing-key.pub"))
-     (pid pid))))
+  (mkdir-p "tests/cache")
+  (server (spawn "cuirass"
+                 (list "cuirass" "remote-server"
+                       (string-append "--database=" (%package-database))
+                       "--cache=tests/cache"
+                       "--private-key=tests/signing-key.sec"
+                       "--public-key=tests/signing-key.pub")
+                 #:search-path? #t)))
 
 (define (stop-server)
   (let ((server (server)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]