mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-31 23:00:54 -08:00
Code Issues Projects Releases Packages Wiki Activity

Do not print \*current-form\* when there is none

Browse source
This commit is contained in:
jgarcia 2007-10-13 10:11:53 +00:00
parent 2b75bb9fad
commit 7d68d65331
2 changed files with 15 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/c/error.d
View file

@ -82,16 +82,25 @@ CEerror(const char *err, int narg, ...)
void
FEprogram_error(const char *s, int narg, ...)
{
cl_object form, real_args;
cl_object form, real_args, text;
cl_va_list args;
cl_va_start(args, narg, narg, 0);
real_args = @list(3, SYM_VAL(@'si::*current-form*'),
make_constant_base_string(s),
cl_grab_rest_args(args));
text = make_constant_base_string(s);
real_args = cl_grab_rest_args(args);
if (cl_boundp(@'si::*current-form*') != Cnil) {
/* When FEprogram_error is invoked from the compiler, we can
* provide information about the offending form.
*/
cl_object stmt = SYM_VAL(@'si::*current-form*');
if (stmt != Cnil) {
real_args = @list(3, stmt, text, real_args);
text = make_constant_base_string("In form~%~S~%~?");
}
}
si_signal_simple_error(4,
@'program-error', /* condition name */
Cnil, /* not correctable */
make_constant_base_string("In form~%~S~%~?"),
text,
real_args);
}

2
src/c/symbols_list.h
View file

@ -1657,7 +1657,7 @@ cl_symbols[] = {
{SYS_ "GC-STATS", SI_ORDINARY, si_gc_stats, 1, OBJNULL},
{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, Cnil},
{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},
{SYS_ "CODE-BLOCK", SI_ORDINARY, NULL, -1, OBJNULL},