diff options
-rw-r--r-- | gnu/services/dmd.scm | 26 | ||||
-rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
-rw-r--r-- | tests/guix-system.sh | 37 |
3 files changed, 63 insertions, 1 deletions
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 4bf76e01ec..618df91c5e 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -17,6 +17,8 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services dmd) + #:use-module (guix ui) + #:use-module (guix sets) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) @@ -24,6 +26,8 @@ #:use-module (gnu services) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (dmd-configuration-file)) ;;; Commentary: @@ -32,6 +36,26 @@ ;;; ;;; Code: +(define (assert-no-duplicates services) + "Raise an error if SERVICES provide the same dmd service more than once. + +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 +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 (service-provision service)) + (fold set-insert set (service-provision service))) + (setq) + services)) + (define (dmd-configuration-file services) "Return the dmd configuration file for SERVICES." (define modules @@ -40,6 +64,8 @@ (gnu build file-systems) (guix build utils))) + (assert-no-duplicates services) + (mlet %store-monad ((modules (imported-modules modules)) (compiled (compiled-modules modules))) (define config diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 591b6a1c9a..619f6f99fc 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -2,6 +2,7 @@ # This should be source files of the various tools, and not package modules. gnu/packages.scm gnu/system.scm +gnu/services/dmd.scm guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index b5476476e1..76e722fbc1 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -28,6 +28,8 @@ tmpfile="t-guix-system-$$" errorfile="t-guix-system-error-$$" trap 'rm -f "$tmpfile" "$errorfile"' EXIT +# Reporting of syntax errors. + cat > "$tmpfile"<<EOF ;; This is line 1, and the next one is line 2. (operating-system) @@ -41,3 +43,36 @@ then else grep "$tmpfile:2:3:.*missing.* initializers" "$errorfile" fi + + +# Reporting of duplicate service identifiers. + +cat > "$tmpfile" <<EOF +(use-modules (gnu)) +(use-service-modules networking) + +(operating-system + (host-name "antelope") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems (cons (file-system + (device "root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + + (services (cons* (dhcp-client-service) + (dhcp-client-service) ;twice! + %base-services))) +EOF + +if guix system vm "$tmpfile" 2> "$errorfile" +then + # This must not succeed. + exit 1 +else + grep "service 'networking'.*more than once" "$errorfile" +fi |