summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/services/dmd.scm58
-rw-r--r--tests/guix-system.sh49
2 files changed, 81 insertions, 26 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)))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index d99c9bd07b..e20bc98713 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -71,13 +71,7 @@ else
grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile"
fi
-# Reporting of duplicate service identifiers.
-
-cat > "$tmpfile" <<EOF
-(use-modules (gnu))
-(use-service-modules networking)
-
-(operating-system
+OS_BASE='
(host-name "antelope")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
@@ -85,11 +79,20 @@ cat > "$tmpfile" <<EOF
(bootloader (grub-configuration (device "/dev/sdX")))
(file-systems (cons (file-system
(device "root")
- (title 'label)
+ (title (string->symbol "label"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
+'
+# Reporting of duplicate service identifiers.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu))
+(use-service-modules networking)
+
+(operating-system
+ $OS_BASE
(services (cons* (dhcp-client-service)
(dhcp-client-service) ;twice!
%base-services)))
@@ -103,6 +106,36 @@ else
grep "service 'networking'.*more than once" "$errorfile"
fi
+# Reporting unmet dmd requirements.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu) (gnu services dmd))
+(use-service-modules networking)
+
+(define buggy-service-type
+ (dmd-service-type
+ 'buggy
+ (lambda _
+ (dmd-service
+ (provision '(buggy!))
+ (requirement '(does-not-exist))
+ (start #t)))))
+
+(operating-system
+ $OS_BASE
+ (services (cons (service buggy-service-type #t)
+ %base-services)))
+EOF
+
+if guix system build "$tmpfile" 2> "$errorfile"
+then
+ exit 1
+else
+ grep "service 'buggy!'.*'does-not-exist'.*undefined" "$errorfile"
+fi
+
+# Reporting inconsistent user accounts.
+
make_user_config ()
{
cat > "$tmpfile" <<EOF