records: Improve reporting of invalid field specifiers.
Fixes <http://bugs.gnu.org/23969>. Reported by Vincent Legoll <vincent.legoll@gmail.com>. * guix/records.scm (report-invalid-field-specifier): New procedure. * tests/records.scm ("define-record-type* & wrong field specifier"): New test.master
parent
db8f6b3412
commit
babc2c80a7
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -42,6 +42,15 @@
|
||||||
(format #f fmt args ...)
|
(format #f fmt args ...)
|
||||||
form))))
|
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
|
(define-syntax make-syntactic-constructor
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and
|
"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"
|
"missing field initializers ~a"
|
||||||
(lset-difference eq?
|
(lset-difference eq?
|
||||||
'(expected ...)
|
'(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-syntax-rule (define-field-property-predicate predicate property)
|
||||||
"Define PREDICATE as a procedure that takes a syntax object and, when passed
|
"Define PREDICATE as a procedure that takes a syntax object and, when passed
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -17,6 +17,7 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-records)
|
(define-module (test-records)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
|
@ -214,6 +215,32 @@
|
||||||
(equal? (foo-bar y) 1)) ;promise was already forced
|
(equal? (foo-bar y) 1)) ;promise was already forced
|
||||||
(eq? (foo-baz y) 'b)))))
|
(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"
|
(test-assert "define-record-type* & missing initializers"
|
||||||
(catch 'syntax-error
|
(catch 'syntax-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
Reference in New Issue