ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

read-print: Report missing closing parens instead of looping.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2022-08-10 16:37:34 +02:00
parent 06ce4e3c06
commit ebda12e1d2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 34 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
guix/read-print.scm
View file

@ -24,6 +24,11 @@ (define-module (guix read-print)
#: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 @@ (define* (read-with-comments port #:key (blank-line? #t))
(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 @@ (define (reverse/dot lst)
((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 #\')

7
tests/read-print.scm
View file

@ -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 @@ (define-syntax-rule (test-pretty-print/sequence str args ...)
(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)"