X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcondition.pure.lisp;h=043080019c14b9558c671055237b2123fa7566ed;hb=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;hp=181b2018c7d41f0361a3e9d2e1ab2dfff1252bc0;hpb=fd210120f575183fbb5493a7ebc6b32aab107466;p=sbcl.git

diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index 181b201..0430800 100644
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -51,6 +51,7 @@
                    (foo2 (make-condition 'error)))
                (handler-bind
                    ((error (lambda (c)
+                             (declare (ignore c))
                              (let ((restarts (remove 'res (compute-restarts foo1)
                                                      :key #'restart-name
                                                      :test-not #'eql)))
@@ -96,8 +97,11 @@
 (assert
  (eq (block nil
        (handler-bind
-           ((type-error (lambda (c) (return :failed)))
+           ((type-error (lambda (c)
+                          (declare (ignore c))
+                          (return :failed)))
             (simple-error (lambda (c)
+                            (declare (ignore c))
                             (return (if (find-restart 'continue)
                                         :passed
                                         :failed)))))
@@ -145,24 +149,61 @@
 
 ;;; If CERROR is given a condition, any remaining arguments are only
 ;;; used for the continue format control.
-(let ((x 0))
-  (handler-bind
-      ((simple-error (lambda (c) (incf x) (continue c))))
-    (cerror "Continue from ~A at ~A"
-            (make-condition 'simple-error :format-control "foo"
-                            :format-arguments nil)
-            'cerror (get-universal-time))
-    (assert (= x 1))))
-
-(with-test (:name :malformed-restart-case-clause)
-  (assert (eq :ok
-              (handler-case
-                  (macroexpand `(restart-case (error "foo")
-                                  (foo :report "quux" (quux))))
-                (simple-error (e)
-                  (assert (equal '(restart-case (foo :report "quux" (quux)))
-                                 (simple-condition-format-arguments e)))
-                  :ok)))))
+(with-test (:name (cerror :condition-object-and-format-arguments))
+  (let ((x 0))
+    (handler-bind
+        ((simple-error (lambda (c) (incf x) (continue c))))
+      (cerror "Continue from ~A at ~A"
+              (make-condition 'simple-error :format-control "foo"
+                                            :format-arguments nil)
+              'cerror (get-universal-time))
+      (assert (= x 1)))))
+
+;; Test some of the variations permitted by the RESTART-CASE syntax.
+(with-test (:name (restart-case :smoke))
+  (macrolet
+      ((test (clause &optional (expected ''(:ok)) (args '(:ok)))
+         `(assert (equal ,expected
+                         (multiple-value-list
+                          (restart-case
+                              (handler-bind
+                                  ((error (lambda (c)
+                                            (invoke-restart ',(first clause) ,@args))))
+                                (error "foo"))
+                            ,clause))))))
+
+    (test (foo (quux) quux))
+    (test (foo (&optional quux) quux))
+    ;; Multiple values should work.
+    (test (foo (a b) (values a b)) '(1 2) (1 2))
+    ;; Although somewhat unlikely, these should be legal and return
+    ;; the respective keyword when the restart is invoked.
+    (test (foo () :report) '(:report) ())
+    (test (foo () :interactive) '(:interactive) ())
+    (test (foo () :test) '(:test) ())
+    ;; Declarations should work normally as part of the restart body.
+    (test (foo (quux) :declare ()) '(nil))
+    (test (foo () :declare () :report "quux") '("quux") ())))
+
+(with-test (:name (restart-case :malformed-clauses))
+  (macrolet
+      ((test (clause &optional (expected clause))
+         `(assert (eq :ok
+                      (handler-case
+                          (macroexpand
+                           `(restart-case (error "foo") ,',clause))
+                        (simple-error (e)
+                          (assert (equal '(restart-case ,expected)
+                                         (simple-condition-format-arguments e)))
+                          :ok))))))
+
+    (test :report)                     ; not even a list
+    (test ())                          ; empty
+    (test (foo))                       ; no lambda-list
+    (test (foo :report))               ; no lambda-list
+    (test (foo :report "quux"))        ; no lambda-list
+    (test (foo :report "quux" (quux))) ; confused report and lambda list
+    ))
 
 (with-test (:name :simple-condition-without-args)
   (let ((sc (make-condition 'simple-condition)))