services: Make <service-type> 'description' field mandatory.
* gnu/services.scm (<service-type>)[description]: Remove default value. * tests/services.scm: Add 'description' field to each 'service-type' form.
This commit is contained in:
parent
9a5d686923
commit
3948ac25b1
@ -183,8 +183,7 @@
|
|||||||
(default &no-default-value))
|
(default &no-default-value))
|
||||||
|
|
||||||
;; Meta-data.
|
;; Meta-data.
|
||||||
(description service-type-description ;string
|
(description service-type-description) ;string
|
||||||
(default #f))
|
|
||||||
(location service-type-location ;<location>
|
(location service-type-location ;<location>
|
||||||
(default (and=> (current-source-location)
|
(default (and=> (current-source-location)
|
||||||
source-properties->location))
|
source-properties->location))
|
||||||
|
@ -30,8 +30,10 @@
|
|||||||
|
|
||||||
(test-equal "services, default value"
|
(test-equal "services, default value"
|
||||||
'(42 123 234 error)
|
'(42 123 234 error)
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())))
|
(let* ((t1 (service-type (name 't1) (extensions '())
|
||||||
|
(description "")))
|
||||||
(t2 (service-type (name 't2) (extensions '())
|
(t2 (service-type (name 't2) (extensions '())
|
||||||
|
(description "")
|
||||||
(default-value 42))))
|
(default-value 42))))
|
||||||
(list (service-value (service t2))
|
(list (service-value (service t2))
|
||||||
(service-value (service t2 123))
|
(service-value (service t2 123))
|
||||||
@ -40,13 +42,13 @@
|
|||||||
(service t1)))))
|
(service t1)))))
|
||||||
|
|
||||||
(test-assert "service-back-edges"
|
(test-assert "service-back-edges"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")
|
||||||
(compose +) (extend *)))
|
(compose +) (extend *)))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 (const '()))))
|
(list (service-extension t1 (const '()))))
|
||||||
(compose +) (extend *)))
|
(compose +) (extend *)))
|
||||||
(t3 (service-type (name 't3)
|
(t3 (service-type (name 't3) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t2 identity)
|
(list (service-extension t2 identity)
|
||||||
(service-extension t1 list)))))
|
(service-extension t1 list)))))
|
||||||
@ -63,16 +65,16 @@
|
|||||||
;; from services of type T3; 'xyz 60' comes from the service of type T2,
|
;; from services of type T3; 'xyz 60' comes from the service of type T2,
|
||||||
;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4.
|
;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4.
|
||||||
'(initial-value 5 4 3 2 1 xyz 60)
|
'(initial-value 5 4 3 2 1 xyz 60)
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")
|
||||||
(compose concatenate)
|
(compose concatenate)
|
||||||
(extend cons)))
|
(extend cons)))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1
|
(list (service-extension t1
|
||||||
(cut list 'xyz <>))))
|
(cut list 'xyz <>))))
|
||||||
(compose (cut reduce + 0 <>))
|
(compose (cut reduce + 0 <>))
|
||||||
(extend *)))
|
(extend *)))
|
||||||
(t3 (service-type (name 't3)
|
(t3 (service-type (name 't3) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t2 identity)
|
(list (service-extension t2 identity)
|
||||||
(service-extension t1 list)))))
|
(service-extension t1 list)))))
|
||||||
@ -86,10 +88,10 @@
|
|||||||
(service-value r))))
|
(service-value r))))
|
||||||
|
|
||||||
(test-assert "fold-services, ambiguity"
|
(test-assert "fold-services, ambiguity"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")
|
||||||
(compose concatenate)
|
(compose concatenate)
|
||||||
(extend cons)))
|
(extend cons)))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 list)))))
|
(list (service-extension t1 list)))))
|
||||||
(s (service t2 42)))
|
(s (service t2 42)))
|
||||||
@ -105,8 +107,8 @@
|
|||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(test-assert "fold-services, missing target"
|
(test-assert "fold-services, missing target"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())))
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 list)))))
|
(list (service-extension t1 list)))))
|
||||||
(s (service t2 42)))
|
(s (service t2 42)))
|
||||||
@ -119,11 +121,11 @@
|
|||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(test-assert "instantiate-missing-services"
|
(test-assert "instantiate-missing-services"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")
|
||||||
(default-value 'dflt)
|
(default-value 'dflt)
|
||||||
(compose concatenate)
|
(compose concatenate)
|
||||||
(extend cons)))
|
(extend cons)))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 list)))))
|
(list (service-extension t1 list)))))
|
||||||
(s1 (service t1 'hey!))
|
(s1 (service t1 'hey!))
|
||||||
@ -135,17 +137,17 @@
|
|||||||
(instantiate-missing-services (list s1 s2))))))
|
(instantiate-missing-services (list s1 s2))))))
|
||||||
|
|
||||||
(test-assert "instantiate-missing-services, indirect"
|
(test-assert "instantiate-missing-services, indirect"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")
|
||||||
(default-value 'dflt)
|
(default-value 'dflt)
|
||||||
(compose concatenate)
|
(compose concatenate)
|
||||||
(extend cons)))
|
(extend cons)))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(default-value 'dflt2)
|
(default-value 'dflt2)
|
||||||
(compose concatenate)
|
(compose concatenate)
|
||||||
(extend cons)
|
(extend cons)
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 list)))))
|
(list (service-extension t1 list)))))
|
||||||
(t3 (service-type (name 't3)
|
(t3 (service-type (name 't3) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t2 list)))))
|
(list (service-extension t2 list)))))
|
||||||
(s1 (service t1))
|
(s1 (service t1))
|
||||||
@ -160,8 +162,8 @@
|
|||||||
(instantiate-missing-services (list s2 s3))))))
|
(instantiate-missing-services (list s2 s3))))))
|
||||||
|
|
||||||
(test-assert "instantiate-missing-services, no default value"
|
(test-assert "instantiate-missing-services, no default value"
|
||||||
(let* ((t1 (service-type (name 't1) (extensions '())))
|
(let* ((t1 (service-type (name 't1) (extensions '()) (description "")))
|
||||||
(t2 (service-type (name 't2)
|
(t2 (service-type (name 't2) (description "")
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension t1 list)))))
|
(list (service-extension t1 list)))))
|
||||||
(s (service t2 42)))
|
(s (service t2 42)))
|
||||||
|
Loading…
Reference in New Issue
Block a user