mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

scm_handle_by_message uses scm_print_exception

Browse source 
* libguile/throw.c (handler_message, should_print_backtrace): Use
  scm_print_exception.  Add a helper function to determine when to print
  a backtrace; don't do so on read or syntax errors.
This commit is contained in:
Andy Wingo 2011-02-11 15:16:25 +01:00
parent 9ddf197eb2
commit e0c70a8b06
1 changed files with 23 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

118
libguile/throw.c
View file

@ -335,109 +335,37 @@ scm_exit_status (SCM args)
}
static int
should_print_backtrace (SCM tag, SCM stack)
{
return SCM_BACKTRACE_P
&& scm_is_true (stack)
&& scm_initialized_p
/* It's generally not useful to print backtraces for errors reading
or expanding code in these fallback catch statements. */
&& !scm_is_eq (tag, scm_from_latin1_symbol ("read-error"))
&& !scm_is_eq (tag, scm_from_latin1_symbol ("syntax-error"));
}
static void
handler_message (void *handler_data, SCM tag, SCM args)
{
char *prog_name = (char *) handler_data;
SCM p = scm_current_error_port ();
SCM p, stack, frame;
if (scm_is_eq (tag, scm_from_latin1_symbol ("syntax-error"))
&& scm_ilength (args) >= 5)
p = scm_current_error_port ();
stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
frame = scm_is_true (stack) ? scm_stack_ref (stack, SCM_INUM0) : SCM_BOOL_F;
if (should_print_backtrace (tag, stack))
{
SCM who = SCM_CAR (args);
SCM what = SCM_CADR (args);
SCM where = SCM_CADDR (args);
SCM form = SCM_CADDDR (args);
SCM subform = SCM_CAR (SCM_CDDDDR (args));
scm_puts ("Syntax error:\n", p);
if (scm_is_true (where))
{
SCM file, line, col;
file = scm_assq_ref (where, scm_sym_filename);
line = scm_assq_ref (where, scm_sym_line);
col = scm_assq_ref (where, scm_sym_column);
if (scm_is_true (file))
scm_display (file, p);
else
scm_puts ("unknown file", p);
scm_puts (":", p);
scm_display (line, p);
scm_puts (":", p);
scm_display (col, p);
scm_puts (": ", p);
}
else
scm_puts ("unknown location: ", p);
if (scm_is_true (who))
{
scm_display (who, p);
scm_puts (": ", p);
}
scm_display (what, p);
if (scm_is_true (subform))
{
scm_puts (" in subform ", p);
scm_write (subform, p);
scm_puts (" of ", p);
scm_write (form, p);
}
else if (scm_is_true (form))
{
scm_puts (" in form ", p);
scm_write (form, p);
}
scm_puts ("Backtrace:\n", p);
scm_display_backtrace_with_highlights (stack, p,
SCM_BOOL_F, SCM_BOOL_F,
SCM_EOL);
scm_newline (p);
}
else if (scm_ilength (args) == 4)
{
SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
SCM subr = SCM_CAR (args);
SCM message = SCM_CADR (args);
SCM parts = SCM_CADDR (args);
SCM rest = SCM_CADDDR (args);
if (SCM_BACKTRACE_P && scm_is_true (stack) && scm_initialized_p)
{
SCM highlights;
if (scm_is_eq (tag, scm_arg_type_key)
|| scm_is_eq (tag, scm_out_of_range_key))
highlights = rest;
else
highlights = SCM_EOL;
scm_puts ("Backtrace:\n", p);
scm_display_backtrace_with_highlights (stack, p,
SCM_BOOL_F, SCM_BOOL_F,
highlights);
scm_newline (p);
}
scm_i_display_error (scm_is_true (stack)
? scm_stack_ref (stack, SCM_INUM0) : SCM_BOOL_F,
p, subr, message, parts, rest);
}
else
{
if (! prog_name)
prog_name = "guile";
scm_puts (prog_name, p);
scm_puts (": ", p);
scm_puts ("uncaught throw to ", p);
scm_prin1 (tag, p, 0);
scm_puts (": ", p);
scm_prin1 (args, p, 1);
scm_putc ('\n', p);
}
scm_print_exception (p, frame, tag, args);
}