1.0.17.18: handlers with non-required arguments (regression 1.0.17.8)

 * DX-FLET doesn't currently handle non-required arguments, so don't
   use it when there are any.

 * Test-case.

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index f36232b..b2189a4 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -580,7 +580,9 @@ evaluated as a PROGN."
                                                           (consp (cdr handler))
                                                           (consp (cadr handler))
                                                           (prog1 (eq 'lambda (caadr handler))
-                                                            (setf lambda-form (cadr handler))))))
+                                                            (setf lambda-form (cadr handler)))))
+                                                 ;; KLUDGE: DX-FLET doesn't handle non-required arguments yet.
+                                                 (not (intersection (second lambda-form) lambda-list-keywords)))
                                             (let ((name (gensym "LAMBDA")))
                                               (push `(,name ,@(cdr lambda-form)) local-funs)
                                               (list type `(function ,name)))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index f14cbdf..a1c0ee8 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2368,3 +2368,11 @@
                      (%zig (the (values (single-float (0.0) 1.0) &optional) (unknown2)))
                      nil))))
              (%zig))))
+
+;;; non-required arguments in HANDLER-BIND
+(assert (eq :oops (car (funcall (compile nil
+                                         '(lambda (x)
+                                           (block nil
+                                             (handler-bind ((error (lambda (&rest args) (return (cons :oops args)))))
+                                               (/ 2 x)))))
+                                0))))

diff --git a/version.lisp-expr b/version.lisp-expr
index bb50474..b6f8141 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".)
-"1.0.17.17"
+"1.0.17.18"