~ruther/guix-local

ebda12e1d2c64480bb7d5977e580d8b2eabeb503 — Ludovic Courtès 3 years ago 06ce4e3
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.
2 files changed, 34 insertions(+), 6 deletions(-)

M guix/read-print.scm
M tests/read-print.scm
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)"