From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#67196: M-: uses a wrong value of debug-on-error when it is nil. Date: Mon, 25 Dec 2023 21:39:26 -0500 Message-ID: References: <83a5rfq6i2.fsf@gnu.org> <83ttpbdm2f.fsf@gnu.org> <83il5qe00e.fsf@gnu.org> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="622"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 67196@debbugs.gnu.org, acm@muc.de, eliz@gnu.org To: Richard Stallman Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Dec 26 03:40:29 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rHxMr-000ARC-Bb for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 26 Dec 2023 03:40:29 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rHxMM-0001SC-7m; Mon, 25 Dec 2023 21:39:58 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rHxMJ-0001Rs-0Z for bug-gnu-emacs@gnu.org; Mon, 25 Dec 2023 21:39:55 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rHxMI-0002Lr-Ot for bug-gnu-emacs@gnu.org; Mon, 25 Dec 2023 21:39:54 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rHxMP-0003tH-La for bug-gnu-emacs@gnu.org; Mon, 25 Dec 2023 21:40:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 26 Dec 2023 02:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 67196 X-GNU-PR-Package: emacs Original-Received: via spool by 67196-submit@debbugs.gnu.org id=B67196.170355839914943 (code B ref 67196); Tue, 26 Dec 2023 02:40:01 +0000 Original-Received: (at 67196) by debbugs.gnu.org; 26 Dec 2023 02:39:59 +0000 Original-Received: from localhost ([127.0.0.1]:55659 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rHxMA-0003sa-Gl for submit@debbugs.gnu.org; Mon, 25 Dec 2023 21:39:58 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:19923) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rHxM7-0003sJ-HA for 67196@debbugs.gnu.org; Mon, 25 Dec 2023 21:39:44 -0500 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 32EA982FEA; Mon, 25 Dec 2023 21:39:31 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1703558369; bh=hZulPFtqXigfBD5gzWd6K/IPSla0oH4EqhSmG4Ex8t8=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=RT6hEYP8Pyz9/A3WCFsStow6lHY8y1rw/NXJJ82O1c1mufVBge3bIZ81x7Hz5qmKQ SqYEMW403iS5DB3A+lAF9xqgyNmm1Zaa5AxwvH9nflTka3WDVl8r62r2W67qrnaVo+ 2XneSLy3LiayXCFme/kDVs3goA/FAbSGcf4ViFXBx/WrI/1fQ3BE/RihYI3cWHX4gB gPqhQFtbxaX8MIp53JNGfhhE+fiuEGnULZiapxxYFqJ40eIk1LlsnF7h6EMO1x7Gm/ Qm3fXI78H+yY0W4AMlMSX1ApcG3qNQ6WYsEudN114/JjIVoUnRSgw22Hy5YN7LGQRP 40Jgh5Cr5Obuw== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 2CA0F808AD; Mon, 25 Dec 2023 21:39:29 -0500 (EST) Original-Received: from pastel (65-110-221-238.cpe.pppoe.ca [65.110.221.238]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id E7F4A12110E; Mon, 25 Dec 2023 21:39:28 -0500 (EST) In-Reply-To: (Richard Stallman's message of "Sun, 24 Dec 2023 22:41:44 -0500") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:276901 Archived-At: --=-=-= Content-Type: text/plain > > Here's my current handler-bind patch, which includes some doc. > Thanks, but I don't see any documentation of handler-bind in that patch. Hmm... indeed it wasn't the right patch. Don't know how that happened. Hopefully, this one is better, Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=handler-bind.patch commit 034f453c17683bfc4e55e8a9bf9402556c4cb1ae Author: Stefan Monnier Date: Mon Dec 18 23:45:05 2023 -0500 New special form `handler-bind` AFAIK, this provides the same semantics as Common Lisp's `handler-bind`. * lisp/subr.el (handler-bind): New macro. * src/eval.c (pop_handler): New function. (Fhandler_Bind_1): New function. (signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`. (find_handler_clause): Simplify. (syms_of_eval): Defsubr `Fhandler_bind_1`. * doc/lispref/control.texi (Handling Errors): Add `handler-bind`. * test/src/eval-tests.el (eval-tests--handler-bind): New test. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index d4bd8c14ae3..4107963eed5 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2293,6 +2293,44 @@ Handling Errors @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac +Occasionally, we want to catch some errors and record some information +about the conditions in which they occurred, such as the full +backtrace, or the current buffer. This kinds of information is sadly +not available in the handlers of a @code{condition-case} because the +stack is unwound before running that handler, so the handler is run in +the dynamic context of the @code{condition-case} rather than that of +the place where the error was signaled. For those circumstances, you +can use the following form: + +@defmac handler-bind handlers body@dots{} +This special form runs @var{body} and if it executes without error, +the value it returns becomes the value of the @code{handler-bind} +form. In this case, the @code{handler-bind} has no effect. + +@var{handlers} should be a list of elements of the form +@code{(@var{conditions} @var{handler})} where @var{conditions} is an +error condition name to be handled, or a list of condition names, and +@var{handler} should be a form whose evaluation should return a function. + +Before running @var{body}, @code{handler-bind} evaluates all the +@var{handler} forms and installs those handlers to be active during +the evaluation of @var{body}. These handlers are searched together +with those installed by @code{condition-case}. When the innermost +matching handler is one installed by @code{handler-bind}, the +@var{handler} function is called with a single argument holding the +error description. + +@var{handler} is called in the dynamic context where the error +happened, without first unwinding the stack, meaning that all the +dynamic bindings are still in effect, except that all the error +handlers between the code that signaled the error and the +@code{handler-bind} are temporarily suspended. Like any normal +function, @var{handler} can exit non-locally, typically via +@code{throw}, or it can return normally. If @var{handler} returns +normally, it means the handler @emph{declined} to handle the error and +the search for an error handler is continued where it left off. +@end defmac + @node Error Symbols @subsubsection Error Symbols and Condition Names @cindex error symbol diff --git a/etc/NEWS b/etc/NEWS index 90ff23b7937..8e71b0a903d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1326,6 +1326,11 @@ values. * Lisp Changes in Emacs 30.1 +** New special form 'handler-bind'. +Provides a functionality similar to `condition-case` except it runs the +handler code without unwinding the stack, such that we can record the +backtrace and other dynamic state at the point of the error. + ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes precedence over the variable when present. diff --git a/lisp/subr.el b/lisp/subr.el index 93428c4a518..c53dd333303 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7497,6 +7497,36 @@ match-buffers (push buf bufs))) bufs)) +(defmacro handler-bind (handlers &rest body) + "Setup error HANDLERS around execution of BODY. +HANDLERS is a list of (CONDITIONS HANDLER) where +CONDITIONS should be a list of condition names (symbols) or +a single condition name and HANDLER is a form whose evaluation +returns a function. +When an error is signaled during execution of BODY, if that +error matches CONDITIONS, then the associated HANDLER +function is called with the error as argument. +HANDLERs can either transfer the control via a non-local exit, +or return normally. If they return normally the search for an +error handler continues from where it left off." + ;; FIXME: Completion support as in `condition-case'? + (declare (indent 1) (debug ((&rest (sexp form)) body))) + (let ((args '()) + (bindings '())) + (dolist (cond+handler (reverse handlers)) + (let ((handler (car (cdr cond+handler))) + (conds (car cond+handler)) + (handlersym (gensym "handler"))) + (push (list handlersym handler) bindings) + (if (not (listp conds)) + (progn + (push handlersym args) + (push `',conds args)) + (dolist (cond conds) + (push handlersym args) + (push `',cond args))))) + `(let ,bindings (handler-bind-1 (lambda () ,@body) ,@args)))) + (defmacro with-memoization (place &rest code) "Return the value of CODE and stash it in PLACE. If PLACE's value is non-nil, then don't bother evaluating CODE diff --git a/src/eval.c b/src/eval.c index 419285eb694..e00886afbc8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1192,6 +1192,12 @@ DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0, #define clobbered_eassert(E) verify (sizeof (E) != 0) +static void +pop_handler (void) +{ + handlerlist = handlerlist->next; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1355,6 +1361,37 @@ or (:success BODY...), where the BODY is made of Lisp expressions. return internal_lisp_condition_case (var, bodyform, handlers); } +DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, + doc: /* Setup error handlers around execution of BODYFUN. +BODYFUN be a function and it is called with no arguments. +CONDITION should be a condition name (symbol). +When an error is signaled during executon of BODYFUN, if that +error matches CONDITION, then the associated HANDLER is +called with the error as argument. +HANDLER should either transfer the control via a non-local exit, +or return normally. +If it returns normally, the search for an error handler continues +from where it left off. + +usage: (handler-bind BODYFUN [CONDITION HANDLER]...) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs >= 1); + Lisp_Object bodyfun = args[0]; + Lisp_Object map = Qnil; + ptrdiff_t i = 2; + while (i < nargs) + { + Lisp_Object condition = args[i - 1], handler = args[i]; + map = Fcons (Fcons (condition, handler), map); + i += 2; + } + push_handler (Fnreverse (map), HANDLER); + Lisp_Object ret = call0 (bodyfun); + pop_handler (); + return ret; +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1731,6 +1768,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) = (NILP (error_symbol) ? Fcar (data) : error_symbol); Lisp_Object clause = Qnil; struct handler *h; + int skip; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1753,6 +1791,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); + /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); } @@ -1772,16 +1811,53 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Vsignaling_function = backtrace_function (pdl); } - for (h = handlerlist; h; h = h->next) + for (skip = 0, h = handlerlist; h; skip++, h = h->next) { - if (h->type == CATCHER_ALL) + switch (h->type) { + case CATCHER_ALL: clause = Qt; break; - } - if (h->type != CONDITION_CASE) - continue; - clause = find_handler_clause (h->tag_or_ch, conditions); + case CATCHER: + continue; + case CONDITION_CASE: + clause = find_handler_clause (h->tag_or_ch, conditions); + break; + case HANDLER: + { + Lisp_Object handlers = h->tag_or_ch; + for (; CONSP (handlers); handlers = XCDR (handlers)) + { + Lisp_Object handler = XCAR (handlers); + if (CONSP (handler) + && !NILP (Fmemq (XCAR (handler), conditions))) + { + Lisp_Object error_data + = (NILP (error_symbol) + ? data : Fcons (error_symbol, data)); + push_handler (make_fixnum (skip), SKIP_CONDITIONS); + Lisp_Object retval = call1 (XCDR (handler), error_data); + pop_handler (); + if (CONSP (retval)) + { + error_symbol = XCAR (retval); + data = XCDR (retval); + conditions = Fget (error_symbol, Qerror_conditions); + } + } + } + continue; + } + case SKIP_CONDITIONS: + { + int toskip = XFIXNUM (h->tag_or_ch); + while (toskip-- >= 0) + h = h->next; + continue; + } + default: + abort (); + } if (!NILP (clause)) break; } @@ -1798,7 +1874,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->tag_or_ch, Qerror))) + || EQ (clause, Qerror))) { debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1812,8 +1888,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) with debugging. Make sure to use `debug-early' unconditionally to not interfere with ERT or other packages that install custom debuggers. */ + /* FIXME: This could be turned into a `handler-bind` at toplevel? */ if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) + && (NILP (clause) || EQ (clause, Qerror)) && noninteractive && backtrace_on_error_noninteractive && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) @@ -1827,6 +1904,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* 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) && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) @@ -2052,13 +2130,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) register Lisp_Object h; /* t is used by handlers for all conditions, set up by C code. */ - if (EQ (handlers, Qt)) - return Qt; - /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ - if (EQ (handlers, Qerror)) - return Qt; + if (!CONSP (handlers)) + return handlers; for (h = handlers; CONSP (h); h = XCDR (h)) { @@ -4461,6 +4536,7 @@ syms_of_eval (void) defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + defsubr (&Shandler_bind_1); DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); diff --git a/src/lisp.h b/src/lisp.h index df6cf1df544..ee7ceb8e250 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3595,7 +3595,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) } /* This structure helps implement the `catch/throw' and `condition-case/signal' - control structures. A struct handler contains all the information needed to + control structures as well as 'handler-bind'. + A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. Handler structures are chained together in a doubly linked list; the `next' @@ -3616,9 +3617,23 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) state. Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ - -enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; + a 'struct handler' is a local variable. + + For the HANDLER and SKIP_CONDITIONS cases, we only make use of the + `tag_or_ch` field and none of the rest, because there's no longjmp + to jump to. + [ Maybe we should split the handler-list into a list of restart point + (for CATCHERs and CONDITION_CASEs) and a list of conditions handlers + (for HANDLERs and CONDITION_CASEs)? ] + + When running the HANDLER of a 'handler-bind', we need to + temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" + the current handler, but without hiding any CATCHERs. We do that by + installing a SKIP_CONDITIONS which tells the search to skip the + N next conditions. */ + +enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL, + HANDLER, SKIP_CONDITIONS }; enum nonlocal_exit { diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 4589763b2f5..71049d927a9 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,4 +282,41 @@ eval-tests-defvaralias (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + ;;; eval-tests.el ends here --=-=-=--