summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/services.scm24
-rw-r--r--tests/services.scm25
2 files changed, 42 insertions, 7 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 49cf01a4f8..f151bbaa9d 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -732,13 +732,23 @@ instantiated; other missing services lead to a
instances
(service-type-extensions (service-kind svc))))
- (let ((instances (fold (lambda (service result)
- (vhash-consq (service-kind service) service
- result))
- vlist-null services)))
- (fold2 adjust-service-list
- services instances
- services)))
+ (let loop ((services services))
+ (define instances
+ (fold (lambda (service result)
+ (vhash-consq (service-kind service) service
+ result))
+ vlist-null services))
+
+ (define adjusted
+ (fold2 adjust-service-list
+ services instances
+ services))
+
+ ;; If we instantiated services, they might in turn depend on missing
+ ;; services. Loop until we've reached fixed point.
+ (if (= (length adjusted) (vlist-length instances))
+ adjusted
+ (loop adjusted))))
(define* (fold-services services
#:key (target-type system-service-type))
diff --git a/tests/services.scm b/tests/services.scm
index b146a0dec2..1ad577e601 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -138,6 +138,31 @@
(equal? (list s1 s2)
(instantiate-missing-services (list s1 s2))))))
+(test-assert "instantiate-missing-services, indirect"
+ (let* ((t1 (service-type (name 't1) (extensions '())
+ (default-value 'dflt)
+ (compose concatenate)
+ (extend cons)))
+ (t2 (service-type (name 't2) (extensions '())
+ (default-value 'dflt2)
+ (compose concatenate)
+ (extend cons)
+ (extensions
+ (list (service-extension t1 list)))))
+ (t3 (service-type (name 't3)
+ (extensions
+ (list (service-extension t2 list)))))
+ (s1 (service t1))
+ (s2 (service t2))
+ (s3 (service t3 42))
+ (== (cut lset= equal? <...>)))
+ (and (== (list s1 s2 s3)
+ (instantiate-missing-services (list s3)))
+ (== (list s1 s2 s3)
+ (instantiate-missing-services (list s1 s3)))
+ (== (list s1 s2 s3)
+ (instantiate-missing-services (list s2 s3))))))
+
(test-assert "instantiate-missing-services, no default value"
(let* ((t1 (service-type (name 't1) (extensions '())))
(t2 (service-type (name 't2)