aboutsummaryrefslogtreecommitdiff
path: root/tests/services.scm
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 /tests/services.scm
parent9f1f200c0462d5fa798e4d7b8c3c09294f8bfb95 (diff)
downloadgnu-guix-9b6c4355645534d1ae799bfef6761b75ed8b3a41.tar
gnu-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.
Diffstat (limited to 'tests/services.scm')
-rw-r--r--tests/services.scm25
1 files changed, 25 insertions, 0 deletions
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)