Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 01:34:21 +00:00
Code Issues Projects Releases Packages Wiki Activity

Experimental record type for all conditions (bug#68075)

Browse source 
* src/print.c (Ferror_message_string): Work with cons or with
records.
(print_error_message): Still work with cons errors, but rename
parameter.

* src/eval.c (signal_or_quit): Make a record, not a cons.  Except
in the sub-case of CONDITION_CASE, where a fresh cons is given.
Name this object 'condition', not 'error'.
(skip_debugger): Rename parameter 'data' to 'condition'
(signal_quit_p)
(maybe_call_debugger): Expect record, not cons.
(syms_of_eval): Define symbol Qcondition.
This commit is contained in:
João Távora 2024-01-01 16:23:38 -06:00
parent 26b7078705
commit 20098915fe
2 changed files with 39 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
src/eval.c
View file

@ -1766,15 +1766,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
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. */
Lisp_Object args[3] = {Qcondition, error_symbol, data};
Lisp_Object condition /* The error object. */
= oom ? data
: (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol
: Fcons (error_symbol, data);
: Frecord (3, args);
Lisp_Object conditions;
Lisp_Object string;
Lisp_Object real_error_symbol
= CONSP (error) ? XCAR (error) : error_symbol;
= RECORDP (condition) ? AREF (condition, 1) : error_symbol;
Lisp_Object clause = Qnil;
bool legacy_cons = false;
struct handler *h;
int skip;
@ -1827,7 +1829,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
break;
case CATCHER:
continue;
case CONDITION_CASE:
case CONDITION_CASE:
legacy_cons = true;
clause = find_handler_clause (h->tag_or_ch, conditions);
break;
case HANDLER_BIND:
@ -1838,7 +1841,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
max_ensure_room (20);
push_handler (make_fixnum (skip + h->bytecode_dest),
SKIP_CONDITIONS);
call1 (h->val, error);
call1 (h->val, condition);
unbind_to (count, Qnil);
pop_handler ();
}
@ -1873,7 +1876,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
|| EQ (clause, Qerror)))
{
debugger_called
= maybe_call_debugger (conditions, error);
= maybe_call_debugger (conditions, condition);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
if (continuable && debugger_called)
@ -1881,14 +1884,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
}
if (!NILP (clause))
unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error);
unwind_to_catch (h,
NONLOCAL_EXIT_SIGNAL,
legacy_cons?Fcons(AREF(condition, 1), AREF(condition, 2))
:condition);
else if (handlerlist != handlerlist_sentinel)
/* FIXME: This will come right back here if there's no `top-level'
catcher. A better solution would be to abort here, and instead
add a catch-all condition handler so we never come here. */
Fthrow (Qtop_level, Qt);
string = Ferror_message_string (error);
string = Ferror_message_string (condition);
fatal ("%s", SDATA (string));
}
@ -1980,7 +1986,7 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
according to debugger-ignored-errors. */
static bool
skip_debugger (Lisp_Object conditions, Lisp_Object data)
skip_debugger (Lisp_Object conditions, Lisp_Object condition)
{
Lisp_Object tail;
bool first_string = 1;
@ -1993,7 +1999,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
if (first_string)
{
error_message = Ferror_message_string (data);
error_message = Ferror_message_string (condition);
first_string = 0;
}
@ -2015,9 +2021,9 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
/* Say whether SIGNAL is a `quit' error (or inherits from it). */
bool
signal_quit_p (Lisp_Object error)
signal_quit_p (Lisp_Object condition)
{
Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil;
Lisp_Object signal = RECORDP (condition) ? AREF (condition, 1) : Qnil;
Lisp_Object list;
return EQ (signal, Qquit)
@ -2027,12 +2033,9 @@ signal_quit_p (Lisp_Object error)
}
/* Call the debugger if calling it is currently enabled for CONDITIONS.
SIG and DATA describe the signal. There are two ways to pass them:
= SIG is the error symbol, and DATA is the rest of the data.
= 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 error)
maybe_call_debugger (Lisp_Object conditions, Lisp_Object condition)
{
if (
/* Don't try to run the debugger with interrupts blocked.
@ -2040,15 +2043,15 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object error)
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (signal_quit_p (error)
&& (signal_quit_p (condition)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, error)
&& ! skip_debugger (conditions, condition)
/* See commentary on definition of
`internal-when-entered-debugger'. */
&& when_entered_debugger < num_nonmacro_input_events)
{
call_debugger (list2 (Qerror, error));
call_debugger (list2 (Qerror, condition));
return 1;
}
@ -4348,6 +4351,7 @@ is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
The command `toggle-debug-on-error' toggles this.
See also the variable `debug-on-quit' and `inhibit-debugger'. */);
Vdebug_on_error = Qnil;
DEFSYM (Qcondition, "condition")
DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
doc: /* List of errors for which the debugger should not be called.

23
src/print.c
View file

@ -1035,6 +1035,15 @@ error message is constructed. */)
&& NILP (XCDR (XCDR (obj))))
return XCAR (XCDR (obj));
if (RECORDP (obj)) {
/* If OBJ is #s(condition error STRING), proceed as above */
if (EQ (AREF (obj, 1), Qerror) && STRINGP (AREF (obj, 2)))
return AREF (obj, 2);
obj = Fcons(AREF (obj, 1), AREF (obj, 2));
}
print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
@ -1052,7 +1061,7 @@ error message is constructed. */)
CALLER is the Lisp function inside which the error was signaled. */
void
print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
print_error_message (Lisp_Object error_as_cons, Lisp_Object stream, const char *context,
Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
@ -1074,14 +1083,14 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
SAFE_FREE ();
}
errname = Fcar (data);
errname = Fcar (error_as_cons);
if (EQ (errname, Qerror))
{
data = Fcdr (data);
if (!CONSP (data))
data = Qnil;
errmsg = Fcar (data);
error_as_cons = Fcdr (error_as_cons);
if (!CONSP (error_as_cons))
error_as_cons = Qnil;
errmsg = Fcar (error_as_cons);
file_error = Qnil;
}
else
@ -1104,7 +1113,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
/* Print an error message including the data items. */
tail = Fcdr_safe (data);
tail = Fcdr_safe (error_as_cons);
/* For file-error, make error message by concatenating
all the data items. They are all strings. */