summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-24 22:29:47 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-24 23:54:30 +0100
commit2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18 (patch)
tree1bf0a47d3c350dfb6285fdaaf3947b923529bbae /gnu/services
parenteb31d4b4f12d82b3cd8ab04c0e8a796322e6abbc (diff)
downloadguix-2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18.tar.gz
services: dmd: Error out upon unmet dmd requirements.
* gnu/services/dmd.scm (assert-no-duplicates): Rename to...
(assert-valid-graph): ... this.
[provisions]: New variable.
[assert-satisfied-requirements]: New procedure.
Use it.
* tests/guix-system.sh: Add test with unmet dmd requirements.
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/dmd.scm58
1 files changed, 40 insertions, 18 deletions
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index e87b9e4415..80dee4fb18 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -116,25 +116,47 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
                  (default #t)))
 
 
-(define (assert-no-duplicates services)
-  "Raise an error if SERVICES provide the same dmd service more than once.
+(define (assert-valid-graph services)
+  "Raise an error if SERVICES does not define a valid dmd service graph, for
+instance if a service requires a nonexistent service, or if more than one
+service uses a given name.
 
-This is a constraint that dmd's 'register-service' verifies but we'd better
-verify it here statically than wait until PID 1 halts with an assertion
+These are constraints that dmd's 'register-service' verifies but we'd better
+verify them here statically than wait until PID 1 halts with an assertion
 failure."
-  (fold (lambda (service set)
-          (define (assert-unique symbol)
-            (when (set-contains? set symbol)
-              (raise (condition
-                      (&message
-                       (message
-                        (format #f (_ "service '~a' provided more than once")
-                                symbol)))))))
-
-          (for-each assert-unique (dmd-service-provision service))
-          (fold set-insert set (dmd-service-provision service)))
-        (setq)
-        services))
+  (define provisions
+    ;; The set of provisions (symbols).  Bail out if a symbol is given more
+    ;; than once.
+    (fold (lambda (service set)
+            (define (assert-unique symbol)
+              (when (set-contains? set symbol)
+                (raise (condition
+                        (&message
+                         (message
+                          (format #f (_ "service '~a' provided more than once")
+                                  symbol)))))))
+
+            (for-each assert-unique (dmd-service-provision service))
+            (fold set-insert set (dmd-service-provision service)))
+          (setq 'dmd)
+          services))
+
+  (define (assert-satisfied-requirements service)
+    ;; Bail out if the requirements of SERVICE aren't satisfied.
+    (for-each (lambda (requirement)
+                (unless (set-contains? provisions requirement)
+                  (raise (condition
+                          (&message
+                           (message
+                            (format #f (_ "service '~a' requires '~a', \
+which is undefined")
+                                    (match (dmd-service-provision service)
+                                      ((head . _) head)
+                                      (_          service))
+                                    requirement)))))))
+              (dmd-service-requirement service)))
+
+  (for-each assert-satisfied-requirements services))
 
 (define (dmd-configuration-file services)
   "Return the dmd configuration file for SERVICES."
@@ -144,7 +166,7 @@ failure."
       (gnu build file-systems)
       (guix build utils)))
 
-  (assert-no-duplicates services)
+  (assert-valid-graph services)
 
   (mlet %store-monad ((modules  (imported-modules modules))
                       (compiled (compiled-modules modules)))