diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-09-07 23:00:39 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-07 23:00:39 +0200 |
| commit | 9b6c4355645534d1ae799bfef6761b75ed8b3a41 (patch) | |
| tree | 7d36556a55c5daded689ef86e33b3b31a2763070 | |
| parent | 9f1f200c0462d5fa798e4d7b8c3c09294f8bfb95 (diff) | |
| download | guix-9b6c4355645534d1ae799bfef6761b75ed8b3a41.tar guix-9b6c4355645534d1ae799bfef6761b75ed8b3a41.tar.gz | |
services: 'instantiate-missing-services' reaches fixed point.
Fixes a bug whereby services indirectly depended on would not be
automatically instantiated.
* gnu/services.scm (instantiate-missing-services): Loop back when the
length of ADJUSTED is greater than that of INSTANCES.
* tests/services.scm ("instantiate-missing-services, indirect"): New test.
| -rw-r--r-- | gnu/services.scm | 24 | ||||
| -rw-r--r-- | tests/services.scm | 25 |
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) |