From: Nikodemus S. <de...@us...> - 2007-04-08 12:51:40
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv16195/src/code Modified Files: early-setf.lisp parse-defmacro.lisp Log Message: 1.0.4.46: allow &environment and disallow &aux in DEFSETF lambda-lists * Reported by Samium Gromoff. * Test-cases. Index: early-setf.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/early-setf.lisp,v retrieving revision 1.28 retrieving revision 1.29 diff -u -d -r1.28 -r1.29 --- early-setf.lisp 11 Aug 2006 08:08:39 -0000 1.28 +++ early-setf.lisp 8 Apr 2007 12:51:36 -0000 1.29 @@ -399,12 +399,12 @@ (multiple-value-bind (body local-decs doc) (parse-defmacro `(,lambda-list ,@store-variables) whole-var body access-fn 'defsetf + :environment env-var :anonymousp t) `(eval-when (:compile-toplevel :load-toplevel :execute) (assign-setf-macro ',access-fn (lambda (,access-form-var ,env-var) - (declare (ignore ,env-var)) (%defsetf ,access-form-var ,(length store-variables) (lambda (,whole-var) ,@local-decs Index: parse-defmacro.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/parse-defmacro.lisp,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- parse-defmacro.lisp 11 Aug 2006 08:08:39 -0000 1.23 +++ parse-defmacro.lisp 8 Apr 2007 12:51:36 -0000 1.24 @@ -140,7 +140,10 @@ (defmacro-error (format nil "required argument after ~A" restp) context name)) - (process-sublist var "REQUIRED-" `(car ,path)) + (when (process-sublist var "REQUIRED-" `(car ,path)) + ;; Note &ENVIRONMENT from DEFSETF sublist + (aver (eq context 'defsetf)) + (setf env-arg-used t)) (setq path `(cdr ,path) minimum (1+ minimum) maximum (1+ maximum))) @@ -195,7 +198,9 @@ (&environment (cond (env-illegal (error "&ENVIRONMENT is not valid with ~S." context)) - (sublist + ;; DEFSETF explicitly allows &ENVIRONMENT, and we get + ;; it here in a sublist. + ((and sublist (neq context 'defsetf)) (error "&ENVIRONMENT is only valid at top level of ~ lambda-list.")) (env-arg-used @@ -246,6 +251,8 @@ (error "Multiple ~A in ~A lambda-list." var context)) (setq allow-other-keys-p t)) (&aux + (when (eq context 'defsetf) + (error "~A not allowed in a ~A lambda-list." var context)) (when aux-seen (error "Multiple ~A in ~A lambda-list." '&aux context)) (setq now-processing :auxs |