[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/handler-bind a97a2363e39 04/12: ert.el: Use `handler-bind` to re
|
From: |
Stefan Monnier |
|
Subject: |
scratch/handler-bind a97a2363e39 04/12: ert.el: Use `handler-bind` to record backtraces |
|
Date: |
Mon, 25 Dec 2023 23:56:51 -0500 (EST) |
branch: scratch/handler-bind
commit a97a2363e399b7725b081ba8834416b96a252c67
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
ert.el: Use `handler-bind` to record backtraces
* lisp/emacs-lisp/ert.el (ert--should-signal-hook): Delete function.
(ert--expand-should-1): Don't bind `signal-hook-function`.
(ert--test-execution-info): Remove `next-debugger` slot.
(ert--run-test-debugger): Adjust to new calling convention.
Pass the `:backtrace-base` info to the debugger.
(ert--run-test-internal): Use `handler-bind` rather than let-binding
`debugger` and `debug-on-error`.
* lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Don't
use `defconst` if it's not meant to stay constant (e.g. we let-bind it
in tramp-tests.el).
---
lisp/emacs-lisp/ert-x.el | 2 +-
lisp/emacs-lisp/ert.el | 139 ++++++++++++++++++-----------------------------
2 files changed, 55 insertions(+), 86 deletions(-)
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index e8b0dd92989..76ccead540f 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -543,7 +543,7 @@ The same keyword arguments are supported as in
;; If this defconst is used in a test file, `tramp' shall be loaded
;; prior `ert-x'. There is no default value on w32 systems, which
;; could work out of the box.
-(defconst ert-remote-temporary-file-directory
+(defvar ert-remote-temporary-file-directory
(when (featurep 'tramp)
(cond
((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 84b50777684..558971c8d70 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -278,14 +278,6 @@ DATA is displayed to the user and should state the reason
for skipping."
(when ert--should-execution-observer
(funcall ert--should-execution-observer form-description)))
-;; See Bug#24402 for why this exists
-(defun ert--should-signal-hook (error-symbol data)
- "Stupid hack to stop `condition-case' from catching ert signals.
-It should only be stopped when ran from inside `ert--run-test-internal'."
- (when (and (not (symbolp debugger)) ; only run on anonymous debugger
- (memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error (cons error-symbol data))))
-
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
(and (symbolp thing)
@@ -324,8 +316,7 @@ It should only be stopped when ran from inside
`ert--run-test-internal'."
(default-value (gensym "ert-form-evaluation-aborted-")))
`(let* ((,fn (function ,fn-name))
(,args (condition-case err
- (let ((signal-hook-function
#'ert--should-signal-hook))
- (list ,@arg-forms))
+ (list ,@arg-forms)
(error (progn (setq ,fn #'signal)
(list (car err)
(cdr err)))))))
@@ -728,78 +719,68 @@ in front of the value of MESSAGE-FORM."
;; value and test execution should be terminated. Should not
;; return.
(exit-continuation (cl-assert nil))
- ;; The binding of `debugger' outside of the execution of the test.
- next-debugger
;; The binding of `ert-debug-on-error' that is in effect for the
;; execution of the current test. We store it to avoid being
;; affected by any new bindings the test itself may establish. (I
;; don't remember whether this feature is important.)
ert-debug-on-error)
-(defun ert--run-test-debugger (info args)
- "During a test run, `debugger' is bound to a closure that calls this
function.
+(defun ert--run-test-debugger (info condition debugfun)
+ "Error handler used during the test run.
This function records failures and errors and either terminates
the test silently or calls the interactive debugger, as
appropriate.
-INFO is the ert--test-execution-info corresponding to this test
-run. ARGS are the arguments to `debugger'."
- (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args)
- args
- (cl-ecase first-debugger-arg
- ((lambda debug t exit nil)
- (apply (ert--test-execution-info-next-debugger info) args))
- (error
- (let* ((condition (car more-debugger-args))
- (type (cl-case (car condition)
- ((quit) 'quit)
- ((ert-test-skipped) 'skipped)
- (otherwise 'failed)))
- ;; We store the backtrace in the result object for
- ;; `ert-results-pop-to-backtrace-for-test-at-point'.
- ;; This means we have to limit `print-level' and
- ;; `print-length' when printing result objects. That
- ;; might not be worth while when we can also use
- ;; `ert-results-rerun-test-at-point-debugging-errors',
- ;; (i.e., when running interactively) but having the
- ;; backtrace ready for printing is important for batch
- ;; use.
- ;;
- ;; Grab the frames above the debugger.
- (backtrace (cdr (backtrace-get-frames debugger)))
- (infos (reverse ert--infos)))
- (setf (ert--test-execution-info-result info)
- (cl-ecase type
- (quit
- (make-ert-test-quit :condition condition
- :backtrace backtrace
- :infos infos))
- (skipped
- (make-ert-test-skipped :condition condition
- :backtrace backtrace
- :infos infos))
- (failed
- (make-ert-test-failed :condition condition
- :backtrace backtrace
- :infos infos))))
- ;; Work around Emacs's heuristic (in eval.c) for detecting
- ;; errors in the debugger.
- (cl-incf num-nonmacro-input-events)
- ;; FIXME: We should probably implement more fine-grained
- ;; control a la non-t `debug-on-error' here.
- (cond
- ((ert--test-execution-info-ert-debug-on-error info)
- (apply (ert--test-execution-info-next-debugger info) args))
- (t))
- (funcall (ert--test-execution-info-exit-continuation info)))))))
+INFO is the `ert--test-execution-info' corresponding to this test run.
+ERR is the error object."
+ (let* ((type (cl-case (car condition)
+ ((quit) 'quit)
+ ((ert-test-skipped) 'skipped)
+ (otherwise 'failed)))
+ ;; We store the backtrace in the result object for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+ ;; This means we have to limit `print-level' and
+ ;; `print-length' when printing result objects. That
+ ;; might not be worth while when we can also use
+ ;; `ert-results-rerun-test-at-point-debugging-errors',
+ ;; (i.e., when running interactively) but having the
+ ;; backtrace ready for printing is important for batch
+ ;; use.
+ ;;
+ ;; Grab the frames above ourselves.
+ (backtrace (cdr (backtrace-get-frames 'ert--run-test-debugger)))
+ (infos (reverse ert--infos)))
+ (setf (ert--test-execution-info-result info)
+ (cl-ecase type
+ (quit
+ (make-ert-test-quit :condition condition
+ :backtrace backtrace
+ :infos infos))
+ (skipped
+ (make-ert-test-skipped :condition condition
+ :backtrace backtrace
+ :infos infos))
+ (failed
+ (make-ert-test-failed :condition condition
+ :backtrace backtrace
+ :infos infos))))
+ ;; FIXME: We should probably implement more fine-grained
+ ;; control a la non-t `debug-on-error' here.
+ (cond
+ ((ert--test-execution-info-ert-debug-on-error info)
+ ;; The `debugfun' arg tells `debug' which backtrace frame starts
+ ;; the "entering the debugger" code so it can hide those frames
+ ;; from the backtrace.
+ (funcall debugger 'error condition :backtrace-base debugfun))
+ (t))
+ (funcall (ert--test-execution-info-exit-continuation info))))
(defun ert--run-test-internal (test-execution-info)
"Low-level function to run a test according to TEST-EXECUTION-INFO.
This mainly sets up debugger-related bindings."
- (setf (ert--test-execution-info-next-debugger test-execution-info) debugger
- (ert--test-execution-info-ert-debug-on-error test-execution-info)
+ (setf (ert--test-execution-info-ert-debug-on-error test-execution-info)
ert-debug-on-error)
(catch 'ert--pass
;; For now, each test gets its own temp buffer and its own
@@ -807,26 +788,14 @@ This mainly sets up debugger-related bindings."
;; too expensive, we can remove it.
(with-temp-buffer
(save-window-excursion
- ;; FIXME: Use `signal-hook-function' instead of `debugger' to
- ;; handle ert errors. Once that's done, remove
- ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for
- ;; details.
- (let ((lexical-binding t)
- (debugger (lambda (&rest args)
- (ert--run-test-debugger test-execution-info
- args)))
- (debug-on-error t)
- ;; Don't infloop if the error being called is erroring
- ;; out, and we have `debug-on-error' bound to nil inside
- ;; the test.
- (backtrace-on-error-noninteractive nil)
- (debug-on-quit t)
- ;; FIXME: Do we need to store the old binding of this
- ;; and consider it in `ert--run-test-debugger'?
- (debug-ignored-errors nil)
+ (let ((lexical-binding t) ;;FIXME: Why?
(ert--infos '()))
- (funcall (ert-test-body (ert--test-execution-info-test
- test-execution-info))))))
+ (letrec ((debugfun (lambda (err)
+ (ert--run-test-debugger test-execution-info
+ err debugfun))))
+ (handler-bind (((error quit) debugfun))
+ (funcall (ert-test-body (ert--test-execution-info-test
+ test-execution-info))))))))
(ert-pass))
(setf (ert--test-execution-info-result test-execution-info)
(make-ert-test-passed))
- branch scratch/handler-bind created (now 933bc573c60), Stefan Monnier, 2023/12/25
- scratch/handler-bind 23479891db8 01/12: New special form `handler-bind`, Stefan Monnier, 2023/12/25
- scratch/handler-bind 7da237eb092 03/12: edebug.el: Use `handler-bind` instead of `signal-hook-function`, Stefan Monnier, 2023/12/25
- scratch/handler-bind 089c87c61db 02/12: (eval-expression): Fix bug#67196, Stefan Monnier, 2023/12/25
- scratch/handler-bind a97a2363e39 04/12: ert.el: Use `handler-bind` to record backtraces,
Stefan Monnier <=
- scratch/handler-bind 8f090cd421d 05/12: tramp.el: Use `handler-bind` instead of `signal-hook-function`, Stefan Monnier, 2023/12/25
- scratch/handler-bind 2f6f38ddc79 07/12: Move batch backtrace code to `top_level_2`, Stefan Monnier, 2023/12/25
- scratch/handler-bind e7c19f33112 09/12: (edebug-format): Make it obsolete, Stefan Monnier, 2023/12/25
- scratch/handler-bind 071ea552e6b 10/12: Add `redisplay-counter` to catched nested redisplays and abort outer one, Stefan Monnier, 2023/12/25
- scratch/handler-bind 68c95fc6682 06/12: startup.el: Use `handler-bind` to implement `--debug-init`, Stefan Monnier, 2023/12/25
- scratch/handler-bind 1fcb76b0465 08/12: Allow the `error-message` property to be a function, Stefan Monnier, 2023/12/25
- scratch/handler-bind 453f977d642 11/12: misc debug-early.el (incl. debug-early-muted), Stefan Monnier, 2023/12/25
- scratch/handler-bind 933bc573c60 12/12: (macroexp--with-extended-form-stack): Use plain `let`, Stefan Monnier, 2023/12/25