fix problems with `read-language' error reporting

This commit is contained in:
Matthew Flatt 2011-01-30 07:47:10 -06:00
parent c945f5d27d
commit bc5ab1e031
3 changed files with 17 additions and 4 deletions

View File

@ -158,7 +158,9 @@ is @racket[#f].
If @racket[in] has a @litchar{#lang} or @litchar{#!} specification, If @racket[in] has a @litchar{#lang} or @litchar{#!} specification,
but parsing and resolving the specification raises an exception, the but parsing and resolving the specification raises an exception, the
exception is propagated by @racket[read-language]. exception is propagated by @racket[read-language]. Having at least
@litchar{#l} or @litchar{#!} (after comments and whitespace) counts as
starting a @litchar{#lang} or @litchar{#!} specification.
If @racket[in] does not specify a @tech{reader language} with If @racket[in] does not specify a @tech{reader language} with
@litchar{#lang} or @litchar{#!}, then @racket[fail-thunk] is @litchar{#lang} or @litchar{#!}, then @racket[fail-thunk] is

View File

@ -1095,6 +1095,14 @@
(check-nothing ";" exn:fail:read:eof?) (check-nothing ";" exn:fail:read:eof?)
(check-nothing "#| |#" exn:fail:read:eof?) (check-nothing "#| |#" exn:fail:read:eof?)
(check-nothing "8 9" exn:fail:read?)) (check-nothing "8 9" exn:fail:read?))
(err/rt-test (read-language (open-input-string "#l") void) exn:fail:read:eof?)
(err/rt-test (read-language (open-input-string "#la") void) exn:fail:read:eof?)
(err/rt-test (read-language (open-input-string ";;\n;\n#la") void) exn:fail:read:eof?)
(err/rt-test (read-language (open-input-string ";;\n;\n#lx") void) exn:fail:read?)
(test (void) read-language (open-input-string ";;\n;\n#xa") void)
;; Check error-message formatting:
(err/rt-test (read (open-input-string "#l"))
(lambda (exn) (regexp-match? #rx"`#l'" (exn-message exn))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -1547,16 +1547,19 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
} }
return v; return v;
} else { } else {
if (ch == EOF) --fl;
scheme_read_err(port, stxsrc, line, col, pos, 6, ch, indentation, scheme_read_err(port, stxsrc, line, col, pos, 6, ch, indentation,
"read: expected a single space after `#lang'", "read%s: expected a single space after `#lang'",
found, fl); (get_info ? "-language" : ""));
return NULL; return NULL;
} }
} }
} }
} }
if (ch == EOF) --fl;
scheme_read_err(port, stxsrc, line, col, pos, fl, ch, indentation, scheme_read_err(port, stxsrc, line, col, pos, fl, ch, indentation,
"read: bad input: `#%u'", "read%s: bad input: `#%u'",
(get_info ? "-language" : ""),
found, (intptr_t)fl); found, (intptr_t)fl);
return NULL; return NULL;
} }