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.
This commit is contained in:
		
							parent
							
								
									06ce4e3c06
								
							
						
					
					
						commit
						ebda12e1d2
					
				
					 2 changed files with 34 additions and 6 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
                  (define item
 | 
			
		||||
                    (loop (match lst
 | 
			
		||||
                            (((? blank?) . _) #t)
 | 
			
		||||
                            (_ #f))
 | 
			
		||||
                          (lambda ()
 | 
			
		||||
                                      (return (reverse/dot lst))))
 | 
			
		||||
                              lst)))))
 | 
			
		||||
                            (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 a new issue