3 files changed, 63 insertions(+), 1 deletions(-)

M gnu/services/dmd.scm
M po/guix/POTFILES.in
M tests/guix-system.sh

@@ 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

@@ 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

@@ 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