nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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>
master
Ludovic Courtès 2018-04-19 12:33:25 -04:00
parent c498aaaf11
commit c2dcff41c2
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 45 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/records.scm
View File

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

26
tests/records.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -288,6 +288,30 @@
(and (string-match "extra.*initializer.*baz" message)
(eq? proc 'foo)))))
(test-assert "define-record-type* & duplicate initializers"
(let ((exp '(begin
(define-record-type* <foo> foo make-foo
foo?
(bar foo-bar (default 42)))
(foo (bar 1)
(bar 2))))
(loc (current-source-location))) ;keep this alignment!
(catch 'syntax-error
(lambda ()
(eval exp (test-module))
#f)
(lambda (key proc message location form . args)
(and (string-match "duplicate.*initializer" message)
(eq? proc 'foo)
;; Make sure the location is that of the field specifier.
(lset= equal?
(pk 'expected-loc
`((line . ,(- (assq-ref loc 'line) 1))
,@(alist-delete 'line loc)))
(pk 'actual-loc location)))))))
(test-assert "ABI checks"
(let ((module (test-module)))
(eval '(begin