From 3d9e0f7398c7824e328345baa7e81c36aa49f106 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 20 Oct 2002 09:10:17 +0000 Subject: [PATCH] 0.7.8.50: Fixed bugs 211bc (:ALLOW-OTHER-KEYS in local calls) --- BUGS | 3 --- NEWS | 2 ++ src/compiler/locall.lisp | 17 +++++++++++++++-- tests/compiler.impure.lisp | 39 +++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 57 insertions(+), 6 deletions(-) diff --git a/BUGS b/BUGS index 003d6bd..bf29376 100644 --- 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 --- 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 --- 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 --- 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)))) + ;;;; 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 --- 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" -- 1.7.10.4