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 /tests | |
parent | c498aaaf110cd7f6950ea47e637725e0513655d4 (diff) | |
download | guix-c2dcff41c2e47f5f978f467864d5ed7829939884.tar guix-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.scm | 26 |
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 |