summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-08-10 16:37:34 +0200
committerLudovic Courtès <ludo@gnu.org>2022-08-10 16:53:58 +0200
commitebda12e1d2c64480bb7d5977e580d8b2eabeb503 (patch)
tree24a8bc2b129d4865c9489891204d6dcb00f26a13 /guix
parent06ce4e3c06145423e66bb5694d800256e762057c (diff)
read-print: Report missing closing parens instead of looping.
Fixes <https://issues.guix.gnu.org/57093>. Reported by Mohammed AMAR-BENSABER <renken@shione.net>. Previously 'read-with-comments' would enter an infinite loop. * guix/read-print.scm (read-with-comments)[missing-closing-paren-error]: New procedure. Call it when 'loop' as called from 'liip' returns EOF. * tests/read-print.scm ("read-with-comments: missing closing paren"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/read-print.scm33
1 files changed, 27 insertions, 6 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 9d666d7f70..08e219e204 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -24,6 +24,11 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (guix i18n)
+ #:use-module ((guix diagnostics)
+ #:select (formatted-message
+ &fix-hint &error-location
+ location))
#:export (pretty-print-with-comments
pretty-print-with-comments/splice
read-with-comments
@@ -158,6 +163,19 @@ BLANK-LINE? is true, assume PORT is at the beginning of a new line."
(define dot (list 'dot))
(define (dot? x) (eq? x dot))
+ (define (missing-closing-paren-error)
+ (raise (make-compound-condition
+ (formatted-message (G_ "unexpected end of file"))
+ (condition
+ (&error-location
+ (location (match (port-filename port)
+ (#f #f)
+ (file (location file
+ (port-line port)
+ (port-column port))))))
+ (&fix-hint
+ (hint (G_ "Did you forget a closing parenthesis?")))))))
+
(define (reverse/dot lst)
;; Reverse LST and make it an improper list if it contains DOT.
(let loop ((result '())
@@ -190,12 +208,15 @@ BLANK-LINE? is true, assume PORT is at the beginning of a new line."
((memv chr '(#\( #\[))
(let/ec return
(let liip ((lst '()))
- (liip (cons (loop (match lst
- (((? blank?) . _) #t)
- (_ #f))
- (lambda ()
- (return (reverse/dot lst))))
- lst)))))
+ (define item
+ (loop (match lst
+ (((? blank?) . _) #t)
+ (_ #f))
+ (lambda ()
+ (return (reverse/dot lst)))))
+ (if (eof-object? item)
+ (missing-closing-paren-error)
+ (liip (cons item lst))))))
((memv chr '(#\) #\]))
(return))
((eq? chr #\')