From 4ecf492736b3584058c36a0830f43c201be27e12 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 28 Dec 2006 23:48:04 +0000 Subject: [PATCH] 1.0.1.3: Oops, initforms for &AUX parameters were evaluated multiple times for fast-method-functions. (Reported by Kevin Reid on sbcl-devel). --- src/pcl/vector.lisp | 9 ++++++--- tests/clos.impure.lisp | 6 ++++++ version.lisp-expr | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 166208b..2b4f2d2 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -985,12 +985,13 @@ ;; The lambda-list used by BIND-ARGS (bind-list lambda-list) (setq-p (getf (cdr lmf-params) :setq-p)) + (auxp (member '&aux bind-list)) (call-next-method-p (getf (cdr lmf-params) :call-next-method-p))) ;; Try to use the normal function call machinery instead of BIND-ARGS - ;; bindings the arguments, unless: + ;; binding the arguments, unless: (unless (or ;; If all arguments are required, BIND-ARGS will be a no-op ;; in any case. - (not restp) + (and (not restp) (not auxp)) ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a ;; list of all non-required arguments. call-next-method-p) @@ -1013,7 +1014,9 @@ '.rest-arg.)) (fmf-lambda-list (if rest-arg (append req-args (list '&rest rest-arg)) - lambda-list))) + (if call-next-method-p + req-args + lambda-list)))) `(list* :function (let* ((fmf (,(if (body-method-name body) 'named-lambda 'lambda) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 6887485..36d1ee0 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -1521,5 +1521,11 @@ (clim-style-lambda-list-test 1 2) +(setf *count* 0) + +(test (&aux (a (incf *count*)) (b (incf *count*))) + (a b *count* (setf *count* 0)) + ()) + ;;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 04f9e4b..1b25df9 100644 --- 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.1.2" +"1.0.1.3" -- 1.7.10.4