char *
gdbscm_exception_message_to_string (SCM exception)
{
SCM port = scm_open_output_string ();
SCM key, args;
char *result;
gdb_assert (gdbscm_is_exception (exception));
key = gdbscm_exception_key (exception);
args = gdbscm_exception_args (exception);
if (scm_is_eq (key, with_stack_error_symbol)
/* Don't crash on a badly generated gdb:with-stack exception. */
&& scm_is_pair (args)
&& scm_is_pair (scm_cdr (args)))
{
key = scm_car (args);
args = scm_cddr (args);
}
gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
result = gdbscm_scm_to_c_string (scm_get_output_string (port));
scm_close_port (port);
return result;
}
/*! \brief Process a Scheme error into the log and/or a GError
* \par Function Description
* Process a captured Guile exception with the given \a s_key and \a
* s_args, and optionally the stack trace \a s_stack. The stack trace
* and source location are logged, and if a GError return location \a
* err is provided, it is populated with an informative error message.
*/
static void
process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err) {
char *long_message;
char *short_message;
SCM s_port, s_subr, s_message, s_message_args, s_rest, s_location;
/* Split s_args up */
s_rest = s_args;
s_subr = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message_args = scm_car (s_rest); s_rest = scm_cdr (s_rest);
/* Capture short error message */
s_port = scm_open_output_string ();
scm_display_error_message (s_message, s_message_args, s_port);
short_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Capture long error message (including possible backtrace) */
s_port = scm_open_output_string ();
if (scm_is_true (scm_stack_p (s_stack))) {
scm_puts (_("\nBacktrace:\n"), s_port);
scm_display_backtrace (s_stack, s_port, SCM_BOOL_F, SCM_BOOL_F);
scm_puts ("\n", s_port);
}
s_location = SCM_BOOL_F;
#ifdef HAVE_SCM_DISPLAY_ERROR_STACK
s_location = s_stack;
#endif /* HAVE_SCM_DISPLAY_ERROR_STACK */
#ifdef HAVE_SCM_DISPLAY_ERROR_FRAME
s_location =
scm_is_true (s_stack) ? scm_stack_ref (s_stack, SCM_INUM0) : SCM_BOOL_F;
#endif /* HAVE_SCM_DISPLAY_ERROR_FRAME */
scm_display_error (s_location, s_port, s_subr,
s_message, s_message_args, s_rest);
long_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Send long message to log */
s_log_message ("%s", long_message);
/* Populate any GError */
g_set_error (err, EDA_ERROR, EDA_ERROR_SCHEME, "%s", short_message);
}
static void
chk_string_port_contents(ScmObj port, const char *expected)
{
ScmObj actual = SCM_OBJ_INIT, expe;
SCM_REFSTK_INIT_REG(&port,
&actual, &expe);
expe = scm_make_string_from_cstr(expected, SCM_ENC_SRC);
actual = scm_get_output_string(port);
TEST_ASSERT_SCM_EQUAL(expe, actual);
}
static void backtrace(SCM stack) {
SCM port, string;
char *cstring;
port = scm_open_output_string();
scm_display_backtrace(stack, port, SCM_BOOL_F, SCM_BOOL_F);
string = scm_get_output_string(port);
cstring = scm_to_locale_string(string);
log_msg("TRACE: %s\n", cstring);
scm_close_output_port(port);
free(cstring);
scm_remember_upto_here_2(port, string);
return;
}