diff options
| -rw-r--r-- | gnu/services/dmd.scm | 58 | ||||
| -rw-r--r-- | tests/guix-system.sh | 49 |
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 |