0.8.16.28:

	Fix CERROR when given a condition datum.
	... arguments are simply passed to the continue format control.

diff --git a/NEWS b/NEWS
index 974f9fa..9e1bcd6 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -44,6 +44,9 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16:
     ** constraint propagation and lambda variable substitution are
        more cautious in dealing with partially deleted code.
     ** compiler sometimes lost reoptimization passes.
+    ** CERROR, given a condition as condition designator, passes its
+       remaining arguments to the continue format control without
+       complaint.
 
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now

diff --git a/src/code/cold-error.lisp b/src/code/cold-error.lisp
index f532ab6..5dbdf5f 100644 (file)
--- a/src/code/cold-error.lisp
+++ b/src/code/cold-error.lisp
@@ -114,7 +114,7 @@
       (let ((condition (coerce-to-condition datum
                                            arguments
                                            'simple-error
-                                           'error))
+                                           'cerror))
            (sb!debug:*stack-top-hint* (maybe-find-stack-top-hint)))
        (with-condition-restarts condition (list (find-restart 'continue))
          (let ((sb!debug:*stack-top-hint* nil))

diff --git a/src/code/error.lisp b/src/code/error.lisp
index b409a4f..86e41d1 100644 (file)
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -27,14 +27,14 @@
 ;;; single argument that's directly usable by all the other routines.
 (defun coerce-to-condition (datum arguments default-type fun-name)
   (cond ((typep datum 'condition)
-        (if arguments
-            (cerror "Ignore the additional arguments."
-                    'simple-type-error
-                    :datum arguments
-                    :expected-type 'null
-                    :format-control "You may not supply additional arguments ~
-                                      when giving ~S to ~S."
-                    :format-arguments (list datum fun-name)))
+        (when (and arguments (not (eq fun-name 'cerror)))
+           (cerror "Ignore the additional arguments."
+                   'simple-type-error
+                   :datum arguments
+                   :expected-type 'null
+                   :format-control "You may not supply additional arguments ~
+                                    when giving ~S to ~S."
+                   :format-arguments (list datum fun-name)))
         datum)
        ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
         (apply #'make-condition datum arguments))

diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp
index 370ce4b..cddc4be 100644 (file)
--- a/tests/condition.pure.lisp
+++ b/tests/condition.pure.lisp
@@ -140,3 +140,14 @@
   (test t)
   (test 42)
   (test (make-instance 'standard-object)))
+
+;;; 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))))

diff --git a/version.lisp-expr b/version.lisp-expr
index bb81a17..80d267f 100644 (file)
--- 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.8.16.27"
+"0.8.16.28"