summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-09-07 23:00:39 +0200
committerLudovic Courtès <ludo@gnu.org>2018-09-07 23:00:39 +0200
commit9b6c4355645534d1ae799bfef6761b75ed8b3a41 (patch)
tree7d36556a55c5daded689ef86e33b3b31a2763070
parent9f1f200c0462d5fa798e4d7b8c3c09294f8bfb95 (diff)
downloadguix-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.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)