procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(signal_or_quit): Preserve error object identity

Browse source 
Make sure we build the (ERROR-SYMBOL . ERROR-DATA) object only once
when signaling an error, so that its `eq` identity can be used.
It also gets us a tiny bit closer to having real "error objects"
like in most other current programming languages.

* src/eval.c (maybe_call_debugger): Change arglist to receive the error
object instead of receiving the signal and the data separately.
(signal_or_quit): Build the error object right at the beginning so it
stays `eq` to itself.
Rename the `keyboard_quit` arg to `continuable` so say what it does
rather than what it's used for.
(signal_quit_p): Change arg to be the error object rather than just the
error-symbol.

* src/keyboard.c (cmd_error_internal, menu_item_eval_property_1):
Adjust calls to `signal_quit_p` accordingly.

* test/src/eval-tests.el (eval-tests--error-id): New test.
This commit is contained in:
Stefan Monnier 2023-12-27 15:06:32 -05:00
parent 02edbc88a1
commit 2ef6e40da8
3 changed files with 42 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
src/eval.c
View file

@ -1706,8 +1706,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool);
static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object error);
static void
process_quit_flag (void)
@ -1773,20 +1772,25 @@ quit (void)
bool backtrace_yet = false;
/* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal.
If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
Qquit and DATA should be Qnil, and this function may return.
If CONTINUABLE, the caller allows this function to return
(presumably after calling the debugger);
Otherwise this function is like Fsignal and does not return. */
static Lisp_Object
signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
{
/* When memory is full, ERROR-SYMBOL is nil,
and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
That is a special case--don't do this in other situations. */
bool oom = NILP (error_symbol);
Lisp_Object error /* The error object. */
= oom ? data
: (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol
: Fcons (error_symbol, data);
Lisp_Object conditions;
Lisp_Object string;
Lisp_Object real_error_symbol
= (NILP (error_symbol) ? Fcar (data) : error_symbol);
= CONSP (error) ? XCAR (error) : error_symbol;
Lisp_Object clause = Qnil;
struct handler *h;
int skip;
@ -1804,11 +1808,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
/* This hook is used by edebug. */
if (! NILP (Vsignal_hook_function)
&& ! NILP (error_symbol))
&& !oom)
{
specpdl_ref count = SPECPDL_INDEX ();
max_ensure_room (20);
/* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */
/* FIXME: Here we still "split" the error object
into its error-symbol and its error-data? */
call2 (Vsignal_hook_function, error_symbol, data);
unbind_to (count, Qnil);
}
@ -1820,7 +1826,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
too. Don't do this when ERROR_SYMBOL is nil, because that
is a memory-full error. */
Vsignaling_function = Qnil;
if (!NILP (error_symbol))
if (!oom)
{
union specbinding *pdl = backtrace_next (backtrace_top ());
if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
@ -1845,14 +1851,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
{
if (!NILP (find_handler_clause (h->tag_or_ch, conditions)))
{
Lisp_Object error_data
= (NILP (error_symbol)
? data : Fcons (error_symbol, data));
specpdl_ref count = SPECPDL_INDEX ();
max_ensure_room (20);
push_handler (make_fixnum (skip + h->bytecode_dest),
SKIP_CONDITIONS);
call1 (h->val, error_data);
call1 (h->val, error);
unbind_to (count, Qnil);
pop_handler ();
}
@ -1875,7 +1878,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
bool debugger_called = false;
if (/* Don't run the debugger for a memory-full error.
(There is no room in memory to do that!) */
!NILP (error_symbol)
!oom
&& (!NILP (Vdebug_on_signal)
/* If no handler is present now, try to run the debugger. */
|| NILP (clause)
@ -1887,17 +1890,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
|| EQ (clause, Qerror)))
{
debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
= maybe_call_debugger (conditions, error);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit))
if (continuable && debugger_called)
return Qnil;
}
/* If an error is signaled during a Lisp hook in redisplay, write a
backtrace into the buffer *Redisplay-trace*. */
/* FIXME: Turn this into a `handler-bind` installed during redisplay? */
if (!debugger_called && !NILP (error_symbol)
if (!debugger_called && !oom
&& backtrace_on_redisplay_error
&& (NILP (clause) || h == redisplay_deep_handler)
&& NILP (Vinhibit_debugger)
@ -1918,7 +1921,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
backtrace_yet = true;
specbind (Qstandard_output, redisplay_trace_buffer);
specbind (Qdebugger, Qdebug_early);
call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
call_debugger (list2 (Qerror, error));
unbind_to (count, Qnil);
delayed_warning = make_string
("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61);
@ -1929,10 +1932,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
if (!NILP (clause))
{
Lisp_Object unwind_data
= (NILP (error_symbol) ? data : Fcons (error_symbol, data));
unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data);
unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
}
else
{
@ -1943,10 +1943,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
Fthrow (Qtop_level, Qt);
}
if (! NILP (error_symbol))
data = Fcons (error_symbol, data);
string = Ferror_message_string (data);
string = Ferror_message_string (error);
fatal ("%s", SDATA (string));
}
@ -2071,14 +2068,15 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
return 0;
}
/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */
/* Say whether SIGNAL is a `quit' error (or inherits from it). */
bool
signal_quit_p (Lisp_Object signal)
signal_quit_p (Lisp_Object error)
{
Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil;
Lisp_Object list;
return EQ (signal, Qquit)
|| (!NILP (Fsymbolp (signal))
|| (SYMBOLP (signal)
&& CONSP (list = Fget (signal, Qerror_conditions))
&& !NILP (Fmemq (Qquit, list)));
}
@ -2089,27 +2087,23 @@ signal_quit_p (Lisp_Object signal)
= SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
This is for memory-full errors only. */
static bool
maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
maybe_call_debugger (Lisp_Object conditions, Lisp_Object error)
{
Lisp_Object combined_data;
combined_data = Fcons (sig, data);
if (
/* Don't try to run the debugger with interrupts blocked.
The editing loop would return anyway. */
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (signal_quit_p (sig)
&& (signal_quit_p (error)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, combined_data)
&& ! skip_debugger (conditions, error)
/* See commentary on definition of
`internal-when-entered-debugger'. */
&& when_entered_debugger < num_nonmacro_input_events)
{
call_debugger (list2 (Qerror, combined_data));
call_debugger (list2 (Qerror, error));
return 1;
}

4
src/keyboard.c
View file

@ -1026,7 +1026,7 @@ cmd_error_internal (Lisp_Object data, const char *context)
{
/* The immediate context is not interesting for Quits,
since they are asynchronous. */
if (signal_quit_p (XCAR (data)))
if (signal_quit_p (data))
Vsignaling_function = Qnil;
Vquit_flag = Qnil;
@ -8619,7 +8619,7 @@ menu_item_eval_property_1 (Lisp_Object arg)
{
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
if (CONSP (arg) && signal_quit_p (XCAR (arg)))
if (signal_quit_p (arg))
quit ();
return Qnil;

10
test/src/eval-tests.el
View file

@ -340,4 +340,14 @@ expressions works for identifiers starting with period."
(error 'plain-error))
'wrong-type-argument)))
(ert-deftest eval-tests--error-id ()
(let* (inner-error
(outer-error
(condition-case err
(handler-bind ((error (lambda (err) (setq inner-error err))))
(car 1))
(error err))))
(should (eq inner-error outer-error))))
;;; eval-tests.el ends here