From 7e6a733d8decb72a778323d6dba4dcc5699a91fc Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 4 Nov 2002 14:41:20 +0000 Subject: [PATCH] 0.7.9.28: Fix bug 172 (as per Matthew Danish sbcl-devel 2002-11-01) entomotomy: macro-lambda-list-rest-overly-permissive --- src/code/parse-defmacro.lisp | 34 +++++++++++++++++++--------------- tests/compiler.impure.lisp | 5 +++++ version.lisp-expr | 2 +- 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp index 4ef5bd4..d6a13e3 100644 --- a/src/code/parse-defmacro.lisp +++ b/src/code/parse-defmacro.lisp @@ -121,7 +121,9 @@ (defmacro-error "&ENVIRONMENT" error-kind name)))) ((or (eq var '&rest) (eq var '&body)) - (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) + (cond (restp + (defmacro-error (symbol-name var) error-kind name)) + ((and (cdr rest-of-args) (symbolp (cadr rest-of-args))) (setq rest-of-args (cdr rest-of-args)) (setq restp t) (push-let-binding (car rest-of-args) path nil)) @@ -140,8 +142,10 @@ ((eq var '&aux) (setq now-processing :auxs)) ((listp var) - (cond ; (since it's too early to use CASE) - ((eq now-processing :required) + (case now-processing + ((:required) + (when restp + (defmacro-error "required argument after &REST/&BODY" error-kind name)) (let ((sub-list-name (gensym "SUBLIST-"))) (push-sub-list-binding sub-list-name `(car ,path) var name error-kind error-fun) @@ -150,7 +154,7 @@ (setq path `(cdr ,path) minimum (1+ minimum) maximum (1+ maximum))) - ((eq now-processing :optionals) + ((:optionals) (destructuring-bind (varname &optional initform supplied-p) var (push-optional-binding varname initform supplied-p @@ -158,7 +162,7 @@ name error-kind error-fun)) (setq path `(cdr ,path) maximum (1+ maximum))) - ((eq now-processing :keywords) + ((:keywords) (let* ((keyword-given (consp (car var))) (variable (if keyword-given (cadar var) @@ -169,33 +173,33 @@ (supplied-p (caddr var))) (push-optional-binding variable (cadr var) supplied-p `(keyword-supplied-p ',keyword - ,rest-name) + ,rest-name) `(lookup-keyword ',keyword - ,rest-name) + ,rest-name) name error-kind error-fun) (push keyword keys))) - ((eq now-processing :auxs) + ((:auxs) (push-let-binding (car var) (cadr var) nil)))) ((symbolp var) - (cond ; (too early in bootstrapping to use CASE) - ;; FIXME: ^ This "too early in bootstrapping" is no - ;; longer an issue in current SBCL bootstrapping. - ((eq now-processing :required) + (case now-processing + ((:required) + (when restp + (defmacro-error "required argument after &REST/&BODY" error-kind name)) (push-let-binding var `(car ,path) nil) (setq minimum (1+ minimum) maximum (1+ maximum) path `(cdr ,path))) - ((eq now-processing :optionals) + ((:optionals) (push-let-binding var `(car ,path) nil `(not (null ,path))) (setq path `(cdr ,path) maximum (1+ maximum))) - ((eq now-processing :keywords) + ((:keywords) (let ((key (keywordicate var))) (push-let-binding var `(lookup-keyword ,key ,rest-name) nil) (push key keys))) - ((eq now-processing :auxs) + ((:auxs) (push-let-binding var nil nil)))) (t (error "non-symbol in lambda-list: ~S" var))))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index c583b22..1d5ce41 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -574,6 +574,11 @@ BUG 48c, not yet fixed: (defun bug221 (b x) (funcall (if b #'bug221f1 #'bug221f2) x)) +;;; bug 172: macro lambda lists were too permissive until 0.7.9.28 +;;; (fix provided by Matthew Danish) on sbcl-devel +(assert (null (ignore-errors + (defmacro bug172 (&rest rest foo) `(list ,rest ,foo))))) + ;;;; 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 04df8cb..2cac6a9 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.9.27" +"0.7.9.28" -- 1.7.10.4