summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/records.scm19
-rw-r--r--tests/records.scm29
2 files changed, 45 insertions, 3 deletions
diff --git a/guix/records.scm b/guix/records.scm
index 0d35a747b0..f3f3aafb04 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -42,6 +42,15 @@
(format #f fmt args ...)
form))))
+(define (report-invalid-field-specifier name bindings)
+ "Report the first invalid binding among BINDINGS."
+ (let loop ((bindings bindings))
+ (syntax-case bindings ()
+ (((field value) rest ...) ;good
+ (loop #'(rest ...)))
+ ((weird _ ...) ;weird!
+ (syntax-violation name "invalid field specifier" #'weird)))))
+
(define-syntax make-syntactic-constructor
(syntax-rules ()
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and
@@ -147,7 +156,13 @@ fields, and DELAYED is the list of identifiers of delayed fields."
"missing field initializers ~a"
(lset-difference eq?
'(expected ...)
- fields)))))))))))))
+ fields)))))))
+ ((_ bindings (... ...))
+ ;; One of BINDINGS doesn't match the (field value) pattern.
+ ;; Report precisely which one is faulty, instead of letting the
+ ;; "source expression failed to match any pattern" error.
+ (report-invalid-field-specifier 'name
+ #'(bindings (... ...))))))))))
(define-syntax-rule (define-field-property-predicate predicate property)
"Define PREDICATE as a procedure that takes a syntax object and, when passed
diff --git a/tests/records.scm b/tests/records.scm
index c6f85d4a81..d6d27bb96a 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-records)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@@ -214,6 +215,32 @@
(equal? (foo-bar y) 1)) ;promise was already forced
(eq? (foo-baz y) 'b)))))
+(test-assert "define-record-type* & wrong field specifier"
+ (let ((exp '(begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar (default 42))
+ (baz foo-baz))
+
+ (foo (baz 1 2 3 4 5)))) ;syntax error
+ (loc (current-source-location))) ;keep this alignment!
+ (catch 'syntax-error
+ (lambda ()
+ (eval exp (test-module))
+ #f)
+ (lambda (key proc message location form . args)
+ (and (eq? proc 'foo)
+ (string-match "invalid field" message)
+ (equal? form '(baz 1 2 3 4 5))
+
+ ;; Make sure the location is that of the field specifier.
+ ;; See <http://bugs.gnu.org/23969>.
+ (lset= equal?
+ (pk 'expected-loc
+ `((line . ,(- (assq-ref loc 'line) 1))
+ ,@(alist-delete 'line loc)))
+ (pk 'actual-loc location)))))))
+
(test-assert "define-record-type* & missing initializers"
(catch 'syntax-error
(lambda ()