diff options
| -rw-r--r-- | guix/records.scm | 19 | ||||
| -rw-r--r-- | tests/records.scm | 29 |
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 () |