M guix/read-print.scm => guix/read-print.scm +27 -6
@@ 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 #\')
M tests/read-print.scm => tests/read-print.scm +7 -0
@@ 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)"