X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fclos.impure.lisp;h=91eab018bc1ab08d224c89e4fd4295ec259f58ef;hb=f16e93459cd73b1884e3d576c95e422f8e8a000e;hp=b0f04904b238e5a534231054394f7904fea00827;hpb=a9588489d05f2d358886eb4aba39ca0a2a3de8b2;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index b0f0490..91eab01 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1803,6 +1803,35 @@
      TAG)))
 (with-test (:name :bug-520366)
   (let ((callees (find-named-callees #'bar-520366)))
-    (assert (equal (list #'quux) callees))))
+    (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