fix read-error reporting for characters that live in no port

svn: r6031
This commit is contained in:
Matthew Flatt 2007-04-24 01:50:09 +00:00
parent 41db6cbaec
commit 2009419979
2 changed files with 10 additions and 0 deletions

View File

@ -951,6 +951,11 @@
(test #\{ syntax-property (read-syntax 'x (open-input-string "{1 2 3}")) 'paren-shape) (test #\{ syntax-property (read-syntax 'x (open-input-string "{1 2 3}")) 'paren-shape)
(test #\{ syntax-property (read-syntax 'x (open-input-string "#{1 2}")) 'paren-shape) (test #\{ syntax-property (read-syntax 'x (open-input-string "#{1 2}")) 'paren-shape)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test read error on a character not in any port
(err/rt-test (read/recursive (open-input-string ";") #\. #f) exn:fail:read?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

View File

@ -1323,6 +1323,11 @@ void scheme_read_err(Scheme_Object *port,
show_loc = SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC)); show_loc = SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC));
/* Via read/recursive, it's possible that the reader will try to
complain about a character that precedes the start of a port.
In that case, pos can be 0. */
if (!pos) line = col = pos = -1;
if (stxsrc) { if (stxsrc) {
Scheme_Object *xsrc; Scheme_Object *xsrc;