ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: 'instantiate-missing-services' reaches fixed point.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2018-09-07 23:00:39 +02:00
parent 9f1f200c04
commit 9b6c435564
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 42 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
gnu/services.scm
View file

@ -732,13 +732,23 @@ (define target-type
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))

25
tests/services.scm
View file

@ -138,6 +138,31 @@ (define live-service
(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)