X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;fp=tests%2Fclos.impure.lisp;h=91eab018bc1ab08d224c89e4fd4295ec259f58ef;hb=90c4b36715e7173e12fe4af1079a347b2e6fd14b;hp=6bb7e263b6223caec16bb43aaefbaf3a248e04dc;hpb=168b9114fdaae539f840cf80b5b023d330239353;p=sbcl.git diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 6bb7e26..91eab01 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -1805,4 +1805,33 @@ (let ((callees (find-named-callees #'bar-520366))) (assert (equal (list #'quux-520366) callees)))) +(defgeneric no-applicable-method/retry (x)) +(defmethod no-applicable-method/retry ((x string)) + "string") +(with-test (:name :no-applicable-method/retry) + (assert (equal "cons" + (handler-bind ((error + (lambda (c) + (declare (ignore c)) + (let ((r (find-restart 'sb-pcl::retry))) + (when r + (eval `(defmethod no-applicable-method/retry ((x cons)) + "cons")) + (invoke-restart r)))))) + (no-applicable-method/retry (cons t t)))))) + +(defgeneric no-primary-method/retry (x)) +(defmethod no-primary-method/retry :before (x) (assert x)) +(with-test (:name :no-primary-method/retry) + (assert (equal "ok!" + (handler-bind ((error + (lambda (c) + (declare (ignore c)) + (let ((r (find-restart 'sb-pcl::retry))) + (when r + (eval `(defmethod no-primary-method/retry (x) + "ok!")) + (invoke-restart r)))))) + (no-primary-method/retry (cons t t)))))) + ;;;; success