Skip to content
Snippets Groups Projects
Commit 9fd59ed8 authored by Robert Goldman's avatar Robert Goldman
Browse files

Redefined *FATAL-CONDITIONS* per 1605650.

See https://bugs.launchpad.net/asdf/+bug/1605650

According to the spec, SERIOUS-CONDITIONs are "All conditions serious
enough to require interactive intervention if not handled should inherit
from the type serious-condition."  This is almost exactly the definition
of *FATAL-CONDITIONS*, so I substituted SERIOUS-CONDITION for ERROR
here.

Added exceptions to the set of *FATAL-CONDITIONS* in order to fix test
condition handling for CCL.  The exceptions permit us to have a class of
conditions (e.g., SERIOUS-CONDITION) that has a subclass that is not a
FATAL-CONDITION, but that does not have an obvious more specific
alternative.

The specific example that caused me to add this: On shutdown, CCL
signals CCL:PROCESS-RESET, a subclass of SERIOUS-CONDITION. So recent
test harness modifications to handle SERIOUS-CONDITIONs caused the test
scripts to mistakenly think there were failures because of calls to
EXIT-LISP.
parent 8c1d1b65
No related branches found
No related tags found
No related merge requests found
...@@ -375,7 +375,13 @@ is bound, write a message and exit on an error. If ...@@ -375,7 +375,13 @@ is bound, write a message and exit on an error. If
(let ((result (let ((result
(catch :asdf-test-done (catch :asdf-test-done
(handler-bind (handler-bind
((serious-condition (
#+ccl
(ccl:process-reset
(lambda (c)
(declare (ignore c))
nil))
(serious-condition
(lambda (c) (lambda (c)
(ignore-errors (ignore-errors
(format *error-output* "~&TEST ABORTED: ~A~&" c)) (format *error-output* "~&TEST ABORTED: ~A~&" c))
......
...@@ -49,9 +49,13 @@ before the image dump hooks are called and before the image is dumped.") ...@@ -49,9 +49,13 @@ before the image dump hooks are called and before the image is dumped.")
(defvar *image-dump-hook* nil (defvar *image-dump-hook* nil
"Functions to call (in order) when before an image is dumped") "Functions to call (in order) when before an image is dumped")
(defvar *fatal-conditions* '(error) (defvar *fatal-conditions* '(SERIOUS-CONDITION)
"conditions that cause the Lisp image to enter the debugger if interactive, "conditions that cause the Lisp image to enter the debugger if interactive,
or to die if not interactive")) or to die if not interactive")
(defvar *fatal-condition-exceptions*
(list #+ccl 'ccl:process-reset)
"Subclasses of condition that would match *FATAL-CONDITIONS* but that
should not be treated as fatal."))
;;; Exiting properly or im- ;;; Exiting properly or im-
...@@ -170,7 +174,9 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -170,7 +174,9 @@ This is designed to abstract away the implementation specific quit forms."
(defun fatal-condition-p (condition) (defun fatal-condition-p (condition)
"Is the CONDITION fatal? It is if it matches any in *FATAL-CONDITIONS*" "Is the CONDITION fatal? It is if it matches any in *FATAL-CONDITIONS*"
(match-any-condition-p condition *fatal-conditions*)) (and
(not (match-any-condition-p condition *fatal-condition-exceptions*))
(match-any-condition-p condition *fatal-conditions*)))
(defun handle-fatal-condition (condition) (defun handle-fatal-condition (condition)
"Handle a fatal CONDITION: "Handle a fatal CONDITION:
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment