From: Nathan F. <nf...@us...> - 2007-04-07 01:13:26
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20889/src/code Modified Files: cold-error.lisp Log Message: 1.0.4.36: Commit Kevin Reid's "safer *break-on-signals*" patch. Index: cold-error.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/cold-error.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- cold-error.lisp 14 Jul 2005 16:30:14 -0000 1.20 +++ cold-error.lisp 7 Apr 2007 01:13:23 -0000 1.21 @@ -27,10 +27,16 @@ 'simple-condition 'signal)) (*handler-clusters* *handler-clusters*) - (old-bos *break-on-signals*)) + (old-bos *break-on-signals*) + (bos-actually-breaking nil)) (restart-case - (when (typep condition *break-on-signals*) - (let ((*break-on-signals* nil)) + (let ((break-on-signals *break-on-signals*) + (*break-on-signals* nil)) + ;; The rebinding encloses the TYPEP so that a bogus + ;; type specifier will not lead to infinite recursion when + ;; TYPEP fails. + (when (typep condition break-on-signals) + (setf bos-actually-breaking t) (break "~A~%BREAK was entered because of *BREAK-ON-SIGNALS* ~ (now rebound to NIL)." condition))) @@ -45,7 +51,13 @@ ;; unless we provide this restart.) (reassign (new-value) :report - "Return from BREAK and assign a new value to *BREAK-ON-SIGNALS*." + (lambda (stream) + (format stream + (if bos-actually-breaking + "Return from BREAK and assign a new value to ~ + *BREAK-ON-SIGNALS*." + "Assign a new value to *BREAK-ON-SIGNALS* and ~ + continue with signal handling."))) :interactive (lambda () (let (new-value) |