report locations in default error handler
This commit is contained in:
parent
19bfe3e44d
commit
2070db9c01
|
@ -23,9 +23,8 @@
|
|||
|
||||
(define (match:error val srclocs form-name)
|
||||
(raise (make-exn:misc:match
|
||||
(format "~a: no matching clause for ~e\n location: ~a"
|
||||
form-name val
|
||||
(srcloc->string (car srclocs)))
|
||||
(format "~a: no matching clause for ~e"
|
||||
form-name val)
|
||||
(current-continuation-marks)
|
||||
val
|
||||
srclocs)))
|
||||
|
|
|
@ -3181,6 +3181,33 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
|
|||
print_width = SCHEME_INT_VAL(w);
|
||||
else
|
||||
print_width = 0x7FFFFFFF;
|
||||
|
||||
/* Print srcloc(s) if present */
|
||||
l = scheme_struct_type_property_ref(scheme_source_property, argv[1]);
|
||||
if (l)
|
||||
l = _scheme_apply(l, 1, &(argv[1]));
|
||||
|
||||
|
||||
if (l && !SCHEME_NULLP(l)) {
|
||||
/* Some exns include srcloc in the msg, so skip the first srcloc of those when needed */
|
||||
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))
|
||||
&& (scheme_is_struct_instance(exn_table[MZEXN_FAIL_READ].type, argv[1])
|
||||
|| scheme_is_struct_instance(exn_table[MZEXN_FAIL_SYNTAX].type, argv[1])
|
||||
|| scheme_is_struct_instance(exn_table[MZEXN_FAIL_CONTRACT_VARIABLE].type, argv[1])))
|
||||
l = SCHEME_CDR(l);
|
||||
|
||||
if (!SCHEME_NULLP(l))
|
||||
scheme_write_byte_string("\n location...:", 15, port);
|
||||
|
||||
while (!SCHEME_NULLP(l)) {
|
||||
scheme_write_byte_string("\n ", 4, port);
|
||||
w = SCHEME_CAR(l);
|
||||
w = srcloc_to_string(1, &w);
|
||||
scheme_display_w_max(w, port, print_width);
|
||||
l = SCHEME_CDR(l);
|
||||
}
|
||||
}
|
||||
|
||||
l = scheme_get_stack_trace(scheme_struct_ref(argv[1], 1));
|
||||
while (!SCHEME_NULLP(l)) {
|
||||
if (!max_cnt) {
|
||||
|
@ -3192,8 +3219,9 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
|
|||
if (max_cnt == orig_max_cnt) {
|
||||
/* Starting label: */
|
||||
scheme_write_byte_string("\n context...:\n", 15, port);
|
||||
} else
|
||||
} else {
|
||||
scheme_write_byte_string("\n", 1, port);
|
||||
}
|
||||
|
||||
name = SCHEME_CAR(l);
|
||||
loc = SCHEME_CDR(name);
|
||||
|
|
Loading…
Reference in New Issue
Block a user