aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-04-29 00:38:03 +0200
committerLudovic Courtès <ludo@gnu.org>2021-04-29 01:22:04 +0200
commit524c9800afb433cc474132185d8e37f72004adb3 (patch)
tree019787ee7991d95e92e58f0f3e2f30224c821ab9
parent0ce1b281511bd1a9505f416ec7ff1be3c3d7a243 (diff)
downloadguix-524c9800afb433cc474132185d8e37f72004adb3.tar
guix-524c9800afb433cc474132185d8e37f72004adb3.tar.gz
diagnostics, ui: Adjust to 'read-error' and 'syntax-error' in Guile 3.0.6.
* guix/diagnostics.scm (source-properties->location): Add clause for vectors. * guix/ui.scm (report-load-error): Tweak 'read-error' handling for 3.0.6. * tests/guix-package.sh: Relax regexp for the "unbound variable" diagnostic check. * tests/guix-system.sh: Adjust "missing closing paren" check for 3.0.6. * tests/records.scm (location-alist): New procedure. ("define-record-type* & wrong field specifier") ("define-record-type* & wrong field specifier, identifier") ("define-record-type* & duplicate initializers"): Use it.
-rw-r--r--guix/diagnostics.scm6
-rw-r--r--guix/ui.scm10
-rw-r--r--tests/guix-package.sh2
-rw-r--r--tests/guix-system.sh8
-rw-r--r--tests/records.scm18
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)))