Browse Source

services: Statically report duplicate dmd service identifiers.

Reported by 白い熊 @相撲道 <guix-devel_gnu.org@sumou.com>
at <http://lists.gnu.org/archive/html/guix-devel/2015-03/msg00264.html>.

* gnu/services/dmd.scm (assert-no-duplicates): New procedure.
  (dmd-configuration-file): Use it.
* po/guix/POTFILES.in: Add gnu/services/dmd.scm.
* tests/guix-system.sh (errorfile): Add test.
gn-latest-20200428
Ludovic Courtès 7 years ago
parent
commit
116244df95
  1. 26
      gnu/services/dmd.scm
  2. 1
      po/guix/POTFILES.in
  3. 37
      tests/guix-system.sh

26
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

1
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

37
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
Loading…
Cancel
Save