Merge branch 'master' into staging

1 files changed, 20 insertions, 0 deletions

diff --git a/guix/records.scm b/guix/records.scm
index 98f3c8fef0..6b3c25cefa 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,6 +53,22 @@
       ((weird _ ...)                              ;weird!
        (syntax-violation name "invalid field specifier" #'weird)))))
 
+(define (report-duplicate-field-specifier name ctor)
+  "Report the first duplicate identifier among the bindings in CTOR."
+  (syntax-case ctor ()
+    ((_ bindings ...)
+     (let loop ((bindings #'(bindings ...))
+                (seen   '()))
+       (syntax-case bindings ()
+         (((field value) rest ...)
+          (not (memq (syntax->datum #'field) seen))
+          (loop #'(rest ...) (cons (syntax->datum #'field) seen)))
+         ((duplicate rest ...)
+          (syntax-violation name "duplicate field initializer"
+                            #'duplicate))
+         (()
+          #t))))))
+
 (eval-when (expand load eval)
   ;; The procedures below are needed both at run time and at expansion time.
 
@@ -169,6 +186,9 @@ of TYPE matches the expansion-time ABI."
                           #'(field (... ...)))
                     (wrap-field-value f (field-default-value f))))
 
+              ;; Pass S to make sure source location info is preserved.
+              (report-duplicate-field-specifier 'name s)
+
               (let ((fields (append fields (map car default-values))))
                 (cond ((lset= eq? fields '(expected ...))
                        #`(let* #,(field-bindings