fix getting port name for reader errors

Closes #1121
This commit is contained in:
Matthew Flatt 2015-11-05 06:40:05 -07:00
parent 5cc3059de2
commit 58c919c04e
3 changed files with 19 additions and 5 deletions

View File

@ -888,6 +888,24 @@
(delete-file path))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check reader error-message formatting for a struct port
(let ()
(define-struct wrapper (other port)
#:property prop:input-port 1)
(err/rt-test
(read (wrapper #f
(make-input-port "wrapped"
(lambda (bstr)
(bytes-set! bstr 0 (char->integer #\)))
1)
(lambda (bstr d evt)
(bytes-set! bstr 0 (char->integer #\)))
1)
void)))
exn:fail:read?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -1545,10 +1545,6 @@ struct Scheme_Output_Port
struct Scheme_Input_Port *input_half;
};
#define SCHEME_INPORT_VAL(obj) (((Scheme_Input_Port *)(obj))->port_data)
#define SCHEME_OUTPORT_VAL(obj) (((Scheme_Output_Port *)(obj))->port_data)
#define SCHEME_IPORT_NAME(obj) (((Scheme_Input_Port *)obj)->name)
#define SCHEME_SPECIAL (-2)
#define SCHEME_UNLESS_READY (-3)

View File

@ -2175,7 +2175,7 @@ void scheme_read_err(Scheme_Object *port,
if (port) {
Scheme_Object *pn;
pn = SCHEME_IPORT_NAME(port);
pn = scheme_input_port_record(port)->name;
if (SCHEME_PATHP(pn)) {
pn = scheme_remove_current_directory_prefix(pn);
fn = SCHEME_PATH_VAL(pn);