amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

records: Improve reporting of invalid field specifiers.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2016-07-14 18:58:36 +02:00
parent db8f6b3412
commit babc2c80a7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 45 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

29
tests/records.scm
View file

@ -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 ()