diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-04-19 12:33:25 -0400 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-22 23:04:05 +0100 |
| commit | c2dcff41c2e47f5f978f467864d5ed7829939884 (patch) | |
| tree | 2830b58567dd6a9a03fb40dfafef75eea491b1ef /guix | |
| parent | c498aaaf110cd7f6950ea47e637725e0513655d4 (diff) | |
records: Detect duplicate field initializers.
* guix/records.scm (report-duplicate-field-specifier): New procedure.
(make-syntactic-constructor): Call it.
* tests/records.scm ("define-record-type* & duplicate initializers"):
New test.
Co-authored-by: Mark H Weaver <mhw@netris.org>
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/records.scm | 20 |
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 |