suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

report locations in default error handler

Browse Source
This commit is contained in:
Andrew Kent 2016-08-24 21:31:21 -04:00 committed by Vincent St-Amour
parent 19bfe3e44d
commit 2070db9c01
2 changed files with 49 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/collects/racket/match/runtime.rkt
View File

@ -23,9 +23,8 @@
(define (match:error val srclocs form-name) (define (match:error val srclocs form-name)
(raise (make-exn:misc:match (raise (make-exn:misc:match
(format "~a: no matching clause for ~e\n location: ~a" (format "~a: no matching clause for ~e"
form-name val form-name val)
(srcloc->string (car srclocs)))
(current-continuation-marks) (current-continuation-marks)
val val
srclocs))) srclocs)))

66
racket/src/racket/src/error.c
View File

@ -3158,8 +3158,8 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
s = scheme_char_string_to_byte_string(argv[0]); s = scheme_char_string_to_byte_string(argv[0]);
scheme_write_byte_string(SCHEME_BYTE_STR_VAL(s), scheme_write_byte_string(SCHEME_BYTE_STR_VAL(s),
SCHEME_BYTE_STRTAG_VAL(s), SCHEME_BYTE_STRTAG_VAL(s),
port); port);
/* Print context, if available */ /* Print context, if available */
if (SCHEME_CHAPERONE_STRUCTP(argv[1]) if (SCHEME_CHAPERONE_STRUCTP(argv[1])
@ -3178,26 +3178,54 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
int orig_max_cnt = max_cnt; int orig_max_cnt = max_cnt;
w = scheme_get_param(config, MZCONFIG_ERROR_PRINT_WIDTH); w = scheme_get_param(config, MZCONFIG_ERROR_PRINT_WIDTH);
if (SCHEME_INTP(w)) if (SCHEME_INTP(w))
print_width = SCHEME_INT_VAL(w); print_width = SCHEME_INT_VAL(w);
else else
print_width = 0x7FFFFFFF; 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)); l = scheme_get_stack_trace(scheme_struct_ref(argv[1], 1));
while (!SCHEME_NULLP(l)) { while (!SCHEME_NULLP(l)) {
if (!max_cnt) { if (!max_cnt) {
scheme_write_byte_string("\n ...", 7, port); scheme_write_byte_string("\n ...", 7, port);
break; break;
} else { } else {
Scheme_Object *name, *loc; Scheme_Object *name, *loc;
if (max_cnt == orig_max_cnt) { if (max_cnt == orig_max_cnt) {
/* Starting label: */ /* Starting label: */
scheme_write_byte_string("\n context...:\n", 15, port); scheme_write_byte_string("\n context...:\n", 15, port);
} else } else {
scheme_write_byte_string("\n", 1, port); scheme_write_byte_string("\n", 1, port);
}
name = SCHEME_CAR(l); name = SCHEME_CAR(l);
loc = SCHEME_CDR(name); loc = SCHEME_CDR(name);
name = SCHEME_CAR(name); name = SCHEME_CAR(name);
scheme_write_byte_string(" ", 3, port); scheme_write_byte_string(" ", 3, port);
@ -3215,9 +3243,9 @@ def_error_display_proc(int argc, Scheme_Object *argv[])
0); 0);
} }
l = SCHEME_CDR(l); l = SCHEME_CDR(l);
--max_cnt; --max_cnt;
} }
} }
} }
} }