From 0af996ffd49f08b71ba071c6d69dd2b465b4202f Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 12 Oct 2005 11:11:56 +0000 Subject: [PATCH] 0.9.5.45: COMPUTE-RESTARTS with :TEST & no condition * COMPUTE-RESTARTS should return all restarts, even those with a test-function, when invoked without a condition. (RESTART-BIND describes test-function as accepting a condition, so we can't legally pass NIL in anyways -- the sane alternative seems to be to skip this filtering when computing restarts without the condition.) Reported by Helmut Eller for CMUCL. --- NEWS | 3 +++ src/code/target-error.lisp | 5 +++-- tests/condition.impure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 4 files changed, 18 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 2ccc5a0..cc6228b 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,9 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5: on platforms supporting dynamic-extent allocation. * enhancement: saving cores with foreign code loaded is now supported on MIPS/Linux in addition to the previously supported platforms. + * bug fix: COMPUTE-RESTARTS returns all active restarts, including those + with :TEST, when called without a condition. (reported by Helmut Eller for + CMUCL) * bug fix: division by zero in sb-sprof when no samples were collected * bug fix: a race when a slow to arrive sigprof signal killed sbcl * bug fix: asdf-install uses CRLF as required by the HTTP spec. diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index 2406d7b..f7d43cb 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -51,8 +51,9 @@ (when (and (or (not condition) (member restart associated) (not (member restart other))) - (funcall (restart-test-function restart) - condition)) + (or (not condition) + (funcall (restart-test-function restart) + condition))) (res restart)))) (res)))) diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp index cdae286..07b41e0 100644 --- a/tests/condition.impure.lisp +++ b/tests/condition.impure.lisp @@ -46,4 +46,15 @@ (assert (typep (sb-mop:class-prototype (find-class 'counted-condition)) '(and condition counted-condition))) +(define-condition picky-condition () ()) +(restart-case + (handler-case + (error 'picky-condition) + (picky-condition (c) + (assert (eq (car (compute-restarts)) (car (compute-restarts c)))))) + (picky-restart () + :report "Do nothing." + :test (lambda (c) (typep c 'picky-condition)) + 'ok)) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index a218013..1176cb4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.5.44" +"0.9.5.45" -- 1.7.10.4