summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2021-03-05 21:06:04 +0100
committerAndy Wingo <wingo@pobox.com>2021-03-05 21:06:04 +0100
commit9fb550b945f6cc9d109d83f6621ceac69896d763 (patch)
tree4b9d5dff123d9d7855f19347cd7f4a12255765d9
parent4ad56ed938ccbd98c236eb0aac489d8636b4ab3b (diff)
downloadguile-9fb550b945f6cc9d109d83f6621ceac69896d763.tar.gz
Fix reading "#;", "'", and similar premature-EOF situations
* module/ice-9/read.scm (%read): Adjust how subexpressions are read to error on EOF. Improve the error message. * test-suite/tests/reader.test ("#;"): Adapt expectation.
-rw-r--r--module/ice-9/read.scm48
-rw-r--r--test-suite/tests/reader.test2
2 files changed, 25 insertions, 25 deletions
diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index e403e01cd..bc9e15288 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -222,7 +222,7 @@
;; return `.', but not as part of a dotted pair: as in
;; #{.}#. Indeed an example is here!
(if (and (eqv? ch #\.) (eq? (strip-annotation expr) '#{.}#))
- (let* ((tail (read-expr (next-non-whitespace)))
+ (let* ((tail (read-subexpression "tail of improper list"))
(close (next-non-whitespace)))
(unless (eqv? close rdelim)
(error "missing close paren: ~A" close))
@@ -452,13 +452,10 @@
#f)))
(define (read-keyword)
- (let ((ch (next-non-whitespace)))
- (when (eof-object? ch)
- (error "end of input while reading keyword"))
- (let ((expr (strip-annotation (read-expr ch))))
- (unless (symbol? expr)
- (error "keyword prefix #: not followed by a symbol: ~a" expr))
- (symbol->keyword expr))))
+ (let ((expr (strip-annotation (read-subexpression "keyword"))))
+ (unless (symbol? expr)
+ (error "keyword prefix #: not followed by a symbol: ~a" expr))
+ (symbol->keyword expr)))
(define (read-array ch)
(define (read-decimal-integer ch alt)
@@ -606,14 +603,16 @@
((#\i #\e #\b #\B #\o #\O #\d #\D #\x #\X #\I #\E)
(read-number-and-radix ch))
((#\{) (read-extended-symbol))
- ((#\') (list 'syntax (read-expr (next-non-whitespace))))
- ((#\`) (list 'quasisyntax (read-expr (next-non-whitespace))))
+ ((#\') (list 'syntax (read-subexpression "syntax expression")))
+ ((#\`) (list 'quasisyntax
+ (read-subexpression "quasisyntax expression")))
((#\,)
(if (eqv? #\@ (peek))
(begin
(next)
- (list 'unsyntax-splicing (read-expr (next-non-whitespace))))
- (list 'unsyntax (read-expr (next-non-whitespace)))))
+ (list 'unsyntax-splicing
+ (read-subexpression "unsyntax-splicing expression")))
+ (list 'unsyntax (read-subexpression "unsyntax expression"))))
((#\n) (read-nil))
(else
(error "Unknown # object: ~S" ch)))))))
@@ -659,16 +658,16 @@
(string->symbol (read-string ch))
(read-mixed-case-symbol ch)))
((#\')
- (list 'quote (read-expr (next-non-whitespace))))
+ (list 'quote (read-subexpression "quoted expression")))
((#\`)
- (list 'quasiquote (read-expr (next-non-whitespace))))
+ (list 'quasiquote (read-subexpression "quasiquoted expression")))
((#\,)
(cond
((eqv? #\@ (peek))
(next)
- (list 'unquote-splicing (read-expr (next-non-whitespace))))
+ (list 'unquote-splicing (read-subexpression "subexpression of ,@")))
(else
- (list 'unquote (read-expr (next-non-whitespace))))))
+ (list 'unquote (read-subexpression "unquoted expression")))))
((#\#)
;; FIXME: read-sharp should recur if we read a comment
(read-sharp))
@@ -685,10 +684,8 @@
((#\:)
(if (eq? (keyword-style) keyword-style-prefix)
;; FIXME: Don't skip whitespace here.
- (let ((ch (next-non-whitespace)))
- (when (eof-object? ch)
- (error "unexpected end of input while reading :keyword"))
- (symbol->keyword (strip-annotation (read-expr ch))))
+ (let ((sym (read-subexpression ":keyword")))
+ (symbol->keyword (strip-annotation sym)))
(read-mixed-case-symbol ch)))
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\+ #\- #\.)
(read-number ch))
@@ -809,6 +806,12 @@
(else
(skip-r6rs-block-comment)))))
+ (define (read-subexpression what)
+ (let ((ch (next-non-whitespace)))
+ (when (eof-object? ch)
+ (error (string-append "unexpected end of input while reading " what)))
+ (read-expr ch)))
+
(define (next-non-whitespace)
(let lp ((ch (next)))
(case ch
@@ -821,10 +824,7 @@
(lp (process-shebang)))
((#\;)
(next)
- (let ((ch (next-non-whitespace)))
- (when (eof-object? ch)
- (error "no expression after #; comment"))
- (read-expr ch))
+ (read-subexpression "#; comment")
(next-non-whitespace))
((#\|)
(if (read-hash-procedure #\|)
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 203d40645..535ff1c8f 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -489,7 +489,7 @@
(eof-object? (with-input-from-string "#;foo" read)))
(pass-if-exception "#;"
- exception:missing-expression
+ exception:eof
(with-input-from-string "#;" read))
(pass-if-exception "#;("
exception:eof