diff options
author | Andy Wingo <wingo@pobox.com> | 2021-03-05 21:06:04 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-03-05 21:06:04 +0100 |
commit | 9fb550b945f6cc9d109d83f6621ceac69896d763 (patch) | |
tree | 4b9d5dff123d9d7855f19347cd7f4a12255765d9 | |
parent | 4ad56ed938ccbd98c236eb0aac489d8636b4ab3b (diff) | |
download | guile-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.scm | 48 | ||||
-rw-r--r-- | test-suite/tests/reader.test | 2 |
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 |