diff options
| -rw-r--r-- | guix/records.scm | 19 | ||||
| -rw-r--r-- | guix/ui.scm | 5 | ||||
| -rw-r--r-- | tests/guix-system.sh | 22 | ||||
| -rw-r--r-- | 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 <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> ;;; ;;; 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 <ludo@gnu.org> +# Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> # @@ -130,6 +130,26 @@ else fi fi +cat > "$tmpfile" <<EOF +(use-modules (gnu)) ; 1 + +(operating-system ; 3 + (file-systems (cons (file-system ; 4 + (device (file-system-label "root")) + (mount-point "/") ; 6 + (type "ext4")))) ; 7 (!!) + %base-file-systems) +EOF + +if guix system build "$tmpfile" -n 2> "$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 <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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 <http://bugs.gnu.org/23969>. @@ -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> 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 () |