From 2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 24 Nov 2015 22:29:47 +0100 Subject: [PATCH] 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. --- gnu/services/dmd.scm | 56 ++++++++++++++++++++++++++++++-------------- tests/guix-system.sh | 49 +++++++++++++++++++++++++++++++------- 2 files changed, 80 insertions(+), 25 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))))))) + (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) - services)) + (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" <symbol "label")) (mount-point "/") (type "ext4")) %base-file-systems)) +' +# Reporting of duplicate service identifiers. + +cat > "$tmpfile" < "$tmpfile" < "$errorfile" +then + exit 1 +else + grep "service 'buggy!'.*'does-not-exist'.*undefined" "$errorfile" +fi + +# Reporting inconsistent user accounts. + make_user_config () { cat > "$tmpfile" <