From 2ef6e40da88d5b4f070e339a2210f5751ab6a7cb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 27 Dec 2023 15:06:32 -0500 Subject: [PATCH] (signal_or_quit): Preserve error object identity 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. --- src/eval.c | 66 +++++++++++++++++++----------------------- src/keyboard.c | 4 +-- test/src/eval-tests.el | 10 +++++++ 3 files changed, 42 insertions(+), 38 deletions(-) diff --git a/src/eval.c b/src/eval.c index b982c124184..1dd797063eb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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; } diff --git a/src/keyboard.c b/src/keyboard.c index 816147c9130..aa7d732bcc3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -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; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 9ac117859dd..e1c90feb09a 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -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 -- 2.39.5