From 1877ee5664ef655c19b47deb22b5e18c36285f20 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@sift.net> Date: Sun, 31 Jul 2016 21:01:35 -0500 Subject: [PATCH] Alternative means of handling SERIOUS-CONDITION issues. Previous method was over-complicated. Now we simply appropriately define the type UIOP:FATAL-CONDITION, and we can do without both UIOP:*FATAL-CONDITIONS* and UIOP::*FATAL-CONDITION-EXCEPTIONS*. --- operate.lisp | 2 +- uiop/image.lisp | 21 +++++++-------------- 2 files changed, 8 insertions(+), 15 deletions(-) diff --git a/operate.lisp b/operate.lisp index 28b621c80..755e997fc 100644 --- a/operate.lisp +++ b/operate.lisp @@ -220,7 +220,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (handler-bind ((style-warning #'muffle-warning) (missing-component (constantly nil)) - (serious-condition #'(lambda (e) + (uiop:fatal-condition #'(lambda (e) (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%") name e)))) (let ((*verbose-out* (make-broadcast-stream))) diff --git a/uiop/image.lisp b/uiop/image.lisp index 3affc7140..fa1e9881c 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -7,7 +7,8 @@ #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments* #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:argv0 #:*lisp-interaction* - #:*fatal-conditions* #:fatal-condition-p #:handle-fatal-condition + #:fatal-condition #:fatal-condition-p + #:handle-fatal-condition #:call-with-fatal-condition-handler #:with-fatal-condition-handler #:*image-restore-hook* #:*image-prelude* #:*image-entry-point* #:*image-postlude* #:*image-dump-hook* @@ -49,14 +50,8 @@ 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* '(SERIOUS-CONDITION) - "conditions that cause the Lisp image to enter the debugger if 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.")) - + (deftype fatal-condition () + `(and serious-condition #+ccl (not ccl:process-reset)))) ;;; Exiting properly or im- (with-upgradability () @@ -173,10 +168,8 @@ This is designed to abstract away the implementation specific quit forms." condition))) (defun fatal-condition-p (condition) - "Is the CONDITION fatal? It is if it matches any in *FATAL-CONDITIONS*" - (and - (not (match-any-condition-p condition *fatal-condition-exceptions*)) - (match-any-condition-p condition *fatal-conditions*))) + "Is the CONDITION fatal?" + (typep condition 'fatal-condition)) (defun handle-fatal-condition (condition) "Handle a fatal CONDITION: @@ -191,7 +184,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" (defun call-with-fatal-condition-handler (thunk) "Call THUNK in a context where fatal conditions are appropriately handled" - (handler-bind (((satisfies fatal-condition-p) #'handle-fatal-condition)) + (handler-bind ((fatal-condition #'handle-fatal-condition)) (funcall thunk))) (defmacro with-fatal-condition-handler ((&optional) &body body) -- GitLab