[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv19943

Modified Files:
	conditions.lisp 
Log Message:
Avoid recursive error if *break-on-signals* is not a type-specifier.


--- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp	2006/05/07 18:47:14	1.21
+++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp	2006/05/09 19:56:02	1.22
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Nov 20 15:47:04 2002
 ;;;;                
-;;;; $Id: conditions.lisp,v 1.21 2006/05/07 18:47:14 ffjeld Exp $
+;;;; $Id: conditions.lisp,v 1.22 2006/05/09 19:56:02 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -242,18 +242,19 @@
 	 (cpl (class-precedence-list class))
 	 (condition nil)
 	 (bos-type *break-on-signals*))
-    (let ((*break-on-signals* nil)) ; avoid recursive error if *b-o-s* is faulty.
-      (when (typecase bos-type
-	      (null nil)
-	      (symbol
-	       (let ((bos-class (find-class bos-type nil)))
-		 (if (not bos-class)
-		     (typep (class-prototype-value class) bos-type)
-		   (member bos-class cpl))))
-	      (list
-	       (typep (class-prototype-value class) bos-type))
-	      (t (member bos-type cpl)))
-	(break "Signalling ~S" datum)))
+    (with-simple-restart (continue "Ignore *break-on-signals*.")
+      (let ((*break-on-signals* nil))	; avoid recursive error if *b-o-s* is faulty.
+	(when (typecase bos-type
+		(null nil)
+		(symbol
+		 (let ((bos-class (find-class bos-type nil)))
+		   (if (not bos-class)
+		       (typep (class-prototype-value class) bos-type)
+		     (member bos-class cpl))))
+		(list
+		 (typep (class-prototype-value class) bos-type))
+		(t (member bos-type cpl)))
+	  (break "Signalling ~S" datum))))
     (macrolet ((invoke-handler (handler)
 		 `(funcall ,handler
 			   (or condition