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; }