aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-04-19 12:33:25 -0400
committerLudovic Courtès <ludo@gnu.org>2019-01-22 23:04:05 +0100
commitc2dcff41c2e47f5f978f467864d5ed7829939884 (patch)
tree2830b58567dd6a9a03fb40dfafef75eea491b1ef /tests
parentc498aaaf110cd7f6950ea47e637725e0513655d4 (diff)
downloadpatches-c2dcff41c2e47f5f978f467864d5ed7829939884.tar
patches-c2dcff41c2e47f5f978f467864d5ed7829939884.tar.gz
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 'tests')
-rw-r--r--tests/records.scm26
1 files changed, 25 insertions, 1 deletions
diff --git a/tests/records.scm b/tests/records.scm
index 09ada70c2d..d9469a78bd 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -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