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 af7e84b6770b124f62a63ba1c4853fb49522b6c2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue May 2 17:13:37 2023 +0200

    tests: Skip when guix-daemon and avahi-daemon are not running.
    
    * tests/remote.scm (drv, drv-with-timeout): Wrap in a promise and adjust
    users accordingly.
    (guix-daemon-running?, avahi-daemon-running?): New procedures.
    <top level>: Add 'test-skip' call.
---
 tests/remote.scm | 45 +++++++++++++++++++++++++++++++++++++--------
 1 file changed, 37 insertions(+), 8 deletions(-)

diff --git a/tests/remote.scm b/tests/remote.scm
index 884365a..7ca2d97 100644
--- a/tests/remote.scm
+++ b/tests/remote.scm
@@ -27,7 +27,10 @@
              (guix packages)
              (guix store)
              (tests common)
+             (avahi)
+             (avahi client)
              (squee)
+             (srfi srfi-34)
              (srfi srfi-64)
              (ice-9 match)
              (ice-9 threads))
@@ -82,10 +85,10 @@
          (gexp->derivation "foo" exp))))))
 
 (define drv
-  (dummy-drv))
+  (delay (dummy-drv)))
 
 (define drv-with-timeout
-  (dummy-drv 2))
+  (delay (dummy-drv 2)))
 
 (define* (make-build #:key
                      drv
@@ -102,12 +105,38 @@
     (#:timestamp . 1501347493)
     (#:timeout . ,timeout)))
 
+(define guix-daemon-running?
+  (let ((result (delay (guard (c ((store-connection-error? c) #f))
+                         (with-store store
+                           #t)))))
+    (lambda ()
+      "Return true if guix-daemon is running."
+      (force result))))
+
+(define avahi-daemon-running?
+  (let ((result (delay
+                  (catch 'avahi-error
+                    (lambda ()
+                      (let* ((poll (make-simple-poll))
+                             (client (make-client (simple-poll poll)
+                                                  (list
+                                                   
client-flag/ignore-user-config)
+                                                  (const #t))))
+                        (client? client)))
+                    (const #f)))))
+    (lambda ()
+      "Return true if avahi-daemon is running."
+      (force result))))
+
 (test-group-with-cleanup "remote"
   (test-assert "db-init"
     (begin
       (test-init-db!)
       #t))
 
+  ;; The remaining tests require guix-daemon to be running.
+  (test-skip (if (and (guix-daemon-running?) (avahi-daemon-running?)) 0 100))
+
   (test-assert "fill-db"
     (let ((build build)
           (spec
@@ -123,7 +152,7 @@
       (db-add-or-update-specification spec)
       (db-add-evaluation "guix" checkouts
                          #:timestamp 1501347493)
-      (db-add-build (make-build #:drv drv
+      (db-add-build (make-build #:drv (force drv)
                                 #:output "fake-1"))))
 
   (test-assert "remote-server"
@@ -139,19 +168,19 @@
   (test-assert "build done"
     (retry
      (lambda ()
-       (eq? (assq-ref (db-get-build drv) #:status)
+       (eq? (assq-ref (db-get-build (force drv)) #:status)
             (build-status succeeded)))
      #:times 10
      #:delay 1))
 
   (test-assert "build timeout"
     (begin
-      (db-add-build (make-build #:drv drv-with-timeout
+      (db-add-build (make-build #:drv (force drv-with-timeout)
                                 #:output "fake-2"
                                 #:timeout 1))
       (retry
        (lambda ()
-         (eq? (assq-ref (db-get-build drv-with-timeout) #:status)
+         (eq? (assq-ref (db-get-build (force drv-with-timeout)) #:status)
               (build-status failed)))
        #:times 10
        #:delay 1)))
@@ -160,10 +189,10 @@
     (begin
       (stop-worker)
       (start-worker)
-      (db-update-build-status! drv (build-status scheduled))
+      (db-update-build-status! (force drv) (build-status scheduled))
       (retry
        (lambda ()
-         (eq? (assq-ref (db-get-build drv) #:status)
+         (eq? (assq-ref (db-get-build (force drv)) #:status)
               (build-status succeeded)))
        #:times 10
        #:delay 1)))



reply via email to

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