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
......@@ -375,7 +375,13 @@ is bound, write a message and exit on an error. If
(let ((result
(catch :asdf-test-done
(handler-bind
((serious-condition
(
#+ccl
(ccl:process-reset
(lambda (c)
(declare (ignore c))
nil))
(serious-condition
(lambda (c)
(ignore-errors
(format *error-output* "~&TEST ABORTED: ~A~&" c))
......
......@@ -49,9 +49,13 @@ before the image dump hooks are called and before the image is dumped.")
(defvar *image-dump-hook* nil
"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,
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-
......@@ -170,7 +174,9 @@ This is designed to abstract away the implementation specific quit forms."
(defun fatal-condition-p (condition)
"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)
"Handle a fatal CONDITION:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment