From 47212fc763788660ff9051ccee1f6fa8a0db7bdd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 15:00:18 +0100 Subject: [PATCH] records: Improve reporting of "invalid field specifier" errors. Previously users would just see: error: invalid field specifier without source location or hints. * guix/records.scm (expand): Add optional 'parent-form' parameter and pass it to 'syntax-violation' when it is true. (make-syntactic-constructor): Pass S as a third argument to 'report-invalid-field-specifier'. * guix/ui.scm (report-load-error): For 'syntax-error', show SUBFORM or FORM in the message. * tests/records.scm ("define-record-type* & wrong field specifier"): Add a 'subform' parameter and adjust test accordingly. ("define-record-type* & wrong field specifier, identifier"): New test. * tests/guix-system.sh: Add test. --- guix/records.scm | 19 ++++++++++++++----- guix/ui.scm | 5 +++-- tests/guix-system.sh | 22 +++++++++++++++++++++- tests/records.scm | 34 +++++++++++++++++++++++++++++++--- 4 files changed, 69 insertions(+), 11 deletions(-) diff --git a/guix/records.scm b/guix/records.scm index 99507dc384..4bda5426a3 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, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -70,14 +70,22 @@ interface\" (ABI) for TYPE is equal to COOKIE." "~a: record ABI mismatch; recompilation needed" (list #,type) '())))) - (define (report-invalid-field-specifier name bindings) - "Report the first invalid binding among BINDINGS." + (define* (report-invalid-field-specifier name bindings + #:optional parent-form) + "Report the first invalid binding among BINDINGS. PARENT-FORM is used for +error-reporting purposes." (let loop ((bindings bindings)) (syntax-case bindings () (((field value) rest ...) ;good (loop #'(rest ...))) ((weird _ ...) ;weird! - (syntax-violation name "invalid field specifier" #'weird))))) + ;; WEIRD may be an identifier, thus lacking source location info, and + ;; BINDINGS is a list, also lacking source location info. Hopefully + ;; PARENT-FORM provides source location info. + (apply syntax-violation name "invalid field specifier" + (if parent-form + (list parent-form #'weird) + (list #'weird))))))) (define (report-duplicate-field-specifier name ctor) "Report the first duplicate identifier among the bindings in CTOR." @@ -233,7 +241,8 @@ of TYPE matches the expansion-time ABI." ;; Report precisely which one is faulty, instead of letting the ;; "source expression failed to match any pattern" error. (report-invalid-field-specifier 'name - #'(bindings (... ...)))))))))) + #'(bindings (... ...)) + s)))))))) (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/guix/ui.scm b/guix/ui.scm index b99a9e59f5..01aeee49eb 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -372,9 +372,10 @@ ARGS is the list of arguments received by the 'throw' handler." (format (current-error-port) (G_ "~amissing closing parenthesis~%") location)) (apply throw args))) - (('syntax-error proc message properties form . rest) + (('syntax-error proc message properties form subform . rest) (let ((loc (source-properties->location properties))) - (report-error loc (G_ "~a~%") message))) + (report-error loc (G_ "~s: ~a~%") + (or subform form) message))) (('unbound-variable _ ...) (report-unbound-variable-error args #:frame frame)) (((or 'srfi-34 '%exception) obj) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 1b2c425725..271627c2a5 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès # Copyright © 2017 Tobias Geerinckx-Rice # Copyright © 2018 Chris Marusich # @@ -130,6 +130,26 @@ else fi fi +cat > "$tmpfile" < "$errorfile" +then false +else + # Here '%base-file-systems' appears as if it were a field specified of the + # enclosing 'operating-system' form due to parenthesis mismatch. + grep "$tmpfile:3:[0-9]\+:.*%base-file-system.*invalid field specifier" \ + "$errorfile" +fi + OS_BASE=' (host-name "antelope") (timezone "Europe/Paris") diff --git a/tests/records.scm b/tests/records.scm index 16b7a9c35e..2c55a61720 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, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -286,10 +286,11 @@ (lambda () (eval exp (test-module)) #f) - (lambda (key proc message location form . args) + (lambda (key proc message location form subform . _) (and (eq? proc 'foo) (string-match "invalid field" message) - (equal? form '(baz 1 2 3 4 5)) + (equal? subform '(baz 1 2 3 4 5)) + (equal? form '(foo (baz 1 2 3 4 5))) ;; Make sure the location is that of the field specifier. ;; See . @@ -299,6 +300,33 @@ ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) +(test-assert "define-record-type* & wrong field specifier, identifier" + (let ((exp '(begin + (define-record-type* foo make-foo + foo? + (bar foo-bar (default 42)) + (baz foo-baz)) + + (foo + baz))) ;syntax error + (loc (current-source-location))) ;keep this alignment! + (catch 'syntax-error + (lambda () + (eval exp (test-module)) + #f) + (lambda (key proc message location form subform . _) + (and (eq? proc 'foo) + (string-match "invalid field" message) + (equal? subform 'baz) + (equal? form '(foo baz)) + + ;; Here the location is that of the parent form. + (lset= equal? + (pk 'expected-loc + `((line . ,(- (assq-ref loc 'line) 2)) + ,@(alist-delete 'line loc))) + (pk 'actual-loc location))))))) + (test-assert "define-record-type* & missing initializers" (catch 'syntax-error (lambda ()