From 7f43fd550e07970182aa2e21008be5953dc35ecb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 6 Mar 2026 19:17:11 +0100 Subject: [PATCH] signals: handler-bind handles only objects of type CONDITION --- src/clos/conditions.lsp | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp index 40989d089..8098366d2 100644 --- a/src/clos/conditions.lsp +++ b/src/clos/conditions.lsp @@ -378,21 +378,26 @@ (defmacro handler-bind (bindings &body body) (with-gensyms (handler condition) `(flet ((,handler (,condition) - ,@(loop for (type func . rest) in bindings - when rest do - (error "Ill-formed handler bindings.") - collect `(when (typep ,condition ',type) - (funcall ,func ,condition))))) + ;; We don't want to handle exceptions here, if it is expanded from + ;; HANDLER-CASE and the type qualifier is T, then we end up with + ;; invalid pointer, because the stack is unwound. -- jd 2026-03-04 + (when (typep ,condition 'condition) + ,@(loop for (type func . rest) in bindings + when rest do + (error "Ill-formed handler bindings.") + collect `(when (typep ,condition ',type) + (funcall ,func ,condition)))))) (declare (dynamic-extent (function ,handler))) (let ((*handler-clusters* (cons (function ,handler) *handler-clusters*))) ,@body)))) (defun bind-simple-handlers (tag names) (flet ((simple-handler (condition) - (loop for code from 1 - for type in (if (atom names) (list names) names) - when (typep condition type) do - (throw tag (values code condition))))) + (when (typep condition 'condition) + (loop for code from 1 + for type in (if (atom names) (list names) names) + when (typep condition type) do + (throw tag (values code condition)))))) (cons #'simple-handler *handler-clusters*))) (defun signal (datum &rest arguments)