0.7.8.50:

        Fixed bugs 211bc (:ALLOW-OTHER-KEYS in local calls)

diff --git a/BUGS b/BUGS
index 003d6bd..bf29376 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1271,9 +1271,6 @@ WORKAROUND:
 211: "keywords processing"
   a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd
      number of keyword arguments.
-  b. Compiling of a local call with an unknown key and
-     :ALLOW-OTHER-KEYS T should not cause a WARNING.
-  c. Compiler should not warn on an unknown key :ALLOW-OTHER-KEYS.
 
 212: "Sequence functions and circular arguments"
   COERCE, MERGE and CONCATENATE go into an infinite loop when given

diff --git a/NEWS b/NEWS
index 37d2ee8..e0cdea2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1338,6 +1338,8 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8:
     symbol macro only once
   * fixed printing of call frame when argument list is unavailable
   * fixed bug: :ALLOW-OTHER-KEYS is an allowed keyword name
+  * compiler no longer signals WARNING on unknown keyword
+    :ALLOW-OTHER-KEYS
 
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 3d163b8..ef4fc53 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -578,6 +578,8 @@
         (flame (policy call (or (> speed inhibit-warnings)
                                 (> space inhibit-warnings))))
         (loser nil)
+         (allowp nil)
+         (allow-found nil)
         (temps (make-gensym-list max))
         (more-temps (make-gensym-list (length more))))
     (collect ((ignores)
@@ -617,17 +619,28 @@
            (let ((name (continuation-value cont))
                  (dummy (first temp))
                  (val (second temp)))
+              ;; FIXME: check whether KEY was supplied earlier
+              (when (and (eq name :allow-other-keys) (not allow-found))
+                (let ((val (second key)))
+                  (cond ((constant-continuation-p val)
+                         (setq allow-found t
+                               allowp (continuation-value val)))
+                        (t (when flame
+                             (compiler-note "non-constant :ALLOW-OTHER-KEYS value"))
+                           (setf (basic-combination-kind call) :error)
+                           (return-from convert-more-call)))))
              (dolist (var (key-vars)
                           (progn
                             (ignores dummy val)
-                            (setq loser name)))
+                             (unless (eq name :allow-other-keys)
+                               (setq loser name))))
                (let ((info (lambda-var-arg-info var)))
                  (when (eq (arg-info-key info) name)
                    (ignores dummy)
                    (supplied (cons var val))
                    (return)))))))
 
-       (when (and loser (not (optional-dispatch-allowp fun)))
+       (when (and loser (not (optional-dispatch-allowp fun)) (not allowp))
          (compiler-warn "function called with unknown argument keyword ~S"
                         loser)
          (setf (basic-combination-kind call) :error)

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 33f0a4d..ea565bf 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -516,6 +516,45 @@ BUG 48c, not yet fixed:
                '(:x nil t t)))
 (assert (raises-error? (bug211d :y 2 :allow-other-keys nil) program-error))
 
+(let ((failure-p
+       (nth-value
+        3
+        (compile 'bug211b
+                 '(lambda ()
+                   (flet ((test (&key (x :x x-p) ((:allow-other-keys y) :y y-p))
+                            (list x x-p y y-p)))
+                     (assert (equal (test) '(:x nil :y nil)))
+                     (assert (equal (test :x 1) '(1 t :y nil)))
+                     (assert (equal (test :y 2 :allow-other-keys 11 :allow-other-keys nil)
+                                    '(:x nil 11 t)))))))))
+  (assert (not failure-p))
+  (bug211b))
+
+(let ((failure-p
+       (nth-value
+        3
+        (compile 'bug211c
+                 '(lambda ()
+                   (flet ((test (&key (x :x x-p))
+                            (list x x-p)))
+                     (assert (equal (test) '(:x nil)))
+                     (assert (equal (test :x 1) '(1 t)))
+                     (assert (equal (test :y 2 :allow-other-keys 11 :allow-other-keys nil)
+                                    '(:x nil)))))))))
+  (assert (not failure-p))
+  (bug211c))
+
+(dolist (form '((test :y 2)
+                (test :y 2 :allow-other-keys nil)
+                (test :y 2 :allow-other-keys nil :allow-other-keys t)))
+  (multiple-value-bind (result warnings-p failure-p)
+      (compile nil `(lambda ()
+                     (flet ((test (&key (x :x x-p) ((:allow-other-keys y) :y y-p))
+                              (list x x-p y y-p)))
+                       ,form)))
+    (assert failure-p)
+    (assert (raises-error? (funcall result) program-error))))
+
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

diff --git a/version.lisp-expr b/version.lisp-expr
index 7f75c47..458143e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.8.49"
+"0.7.8.50"