;;; 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.
;;;
(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))
(('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)))
;;; 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.
;;;
(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)))
+
\f
(test-begin "records")
(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
(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
(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)))