diff options
| -rw-r--r-- | guix/diagnostics.scm | 6 | ||||
| -rw-r--r-- | guix/ui.scm | 10 | ||||
| -rw-r--r-- | tests/guix-package.sh | 2 | ||||
| -rw-r--r-- | tests/guix-system.sh | 8 | ||||
| -rw-r--r-- | tests/records.scm | 18 |
5 files changed, 33 insertions, 11 deletions
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 7b9ffc61b5..6a792febd4 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -233,6 +233,10 @@ etc." (make-location file (+ line 1) col))) (#f #f) + (#(file line column) + ;; Guile >= 3.0.6 uses vectors instead of alists internally, which can be + ;; seen in the arguments to 'syntax-error' exceptions. + (location file (+ 1 line) column)) (_ (let ((file (assq-ref loc 'filename)) (line (assq-ref loc 'line)) diff --git a/guix/ui.scm b/guix/ui.scm index 7fbd4c63a2..334dce2c68 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -376,12 +376,14 @@ ARGS is the list of arguments received by the 'throw' handler." (('system-error . rest) (let ((err (system-error-errno args))) (report-error (G_ "failed to load '~a': ~a~%") file (strerror err)))) - (('read-error "scm_i_lreadparen" message _ ...) + (('read-error _ message args ...) ;; Guile's missing-paren messages are obscure so we make them more ;; intelligible here. - (if (string-suffix? "end of file" message) - (let ((location (string-drop-right message - (string-length "end of file")))) + (if (or (string-suffix? "end of file" message) ;Guile < 3.0.6 + (and (string-contains message "unexpected end of input") + (member '(#\)) args))) + (let ((location (string-take message + (+ 2 (string-contains message ": "))))) (format (current-error-port) (G_ "~amissing closing parenthesis~%") location)) (apply throw args))) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 39e2b514c3..92ab565c5b 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -459,7 +459,7 @@ if guix package --bootstrap -n -m "$module_dir/manifest.scm" \ then false else cat "$module_dir/stderr" - grep "manifest.scm:[1-3]:.*wonderful-package.*: unbound variable" \ + grep "manifest.scm:[1-4]:.*wonderful-package.*: unbound variable" \ "$module_dir/stderr" fi diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 238c8929a8..7e992e7bdb 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -51,6 +51,7 @@ then # This must not succeed. exit 1 else + cat "$errorfile" grep "$tmpfile:2:3:.*missing.* initializers" "$errorfile" fi @@ -66,7 +67,12 @@ then # This must not succeed. exit 1 else - grep "$tmpfile:4:1: missing closing paren" "$errorfile" + cat "$errorfile" + + # Guile 3.0.6 gets line/column numbers for 'read-error' wrong + # (zero-indexed): <https://bugs.gnu.org/48089>. + grep "$tmpfile:4:1: missing closing paren" "$errorfile" || \ + grep "$tmpfile:3:0: missing closing paren" "$errorfile" fi diff --git a/tests/records.scm b/tests/records.scm index 2c55a61720..706bb3dbfd 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, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,16 @@ (module-use! module (resolve-interface '(guix records))) module)) +(define (location-alist loc) + ;; Return a location alist. In Guile < 3.0.6, LOC is always an alist, but + ;; starting with 3.0.6, LOC is a vector (at least when it comes from + ;; 'syntax-error' exceptions), hence this conversion. + (match loc + (#(file line column) + `((line . ,line) (column . ,column) + (filename . ,file))) + (_ loc))) + (test-begin "records") @@ -298,7 +308,7 @@ (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) - (pk 'actual-loc location))))))) + (pk 'actual-loc (location-alist location)))))))) (test-assert "define-record-type* & wrong field specifier, identifier" (let ((exp '(begin @@ -325,7 +335,7 @@ (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 2)) ,@(alist-delete 'line loc))) - (pk 'actual-loc location))))))) + (pk 'actual-loc (location-alist location)))))))) (test-assert "define-record-type* & missing initializers" (catch 'syntax-error @@ -396,7 +406,7 @@ (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) - (pk 'actual-loc location))))))) + (pk 'actual-loc (location-alist location)))))))) (test-assert "ABI checks" (let ((module (test-module))) |