[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)))