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.
parent
06ce4e3c06
commit
ebda12e1d2
|
@ -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 #\')
|
||||
|
|
|
@ -19,6 +19,8 @@
|
|||
(define-module (tests-style)
|
||||
#:use-module (guix read-print)
|
||||
#:use-module (guix gexp) ;for the reader extensions
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
|
@ -46,6 +48,11 @@ expressions."
|
|||
|
||||
(test-begin "read-print")
|
||||
|
||||
(test-assert "read-with-comments: missing closing paren"
|
||||
(guard (c ((error? c) #t))
|
||||
(call-with-input-string "(what is going on?"
|
||||
read-with-comments)))
|
||||
|
||||
(test-equal "read-with-comments: dot notation"
|
||||
(cons 'a 'b)
|
||||
(call-with-input-string "(a . b)"
|
||||
|
|
Reference in New Issue