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.

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