From adcb5a9772b488fce8d0b0195bc6b906a0e69e12 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 31 Oct 2013 18:47:09 +0400
Subject: [PATCH] Fix defmethod arglists leaking into make-method-lambda.

defmethod communicates to make-method-lambda using special variables,
but make-method-lambda then performs code-walking which expands
macros, and if a macro calls another make-method-lambda directly, this
make-method-lambda will receive incorrect information which may cause
problems with wrong lambda lists.
Reported and diagnosed by Attila Lendvai.
---
 src/pcl/boot.lisp      |    7 ++++++-
 tests/clos.impure.lisp |   27 +++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index e470eb4..2e558ff 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -588,8 +588,13 @@ bootstrapping.
     ;; if there is are no non-standard prior MAKE-METHOD-LAMBDA methods -- or
     ;; unless they're fantastically unintrusive.
     (let* ((method-name *method-name*)
+           (method-lambda-list *method-lambda-list*)
+           ;; Macroexpansion caused by code-walking may call make-method-lambda and
+           ;; end up with wrong values
+           (*method-name* nil)
+           (*method-lambda-list* nil)
            (generic-function-name (when method-name (car method-name)))
-           (specialized-lambda-list (or *method-lambda-list*
+           (specialized-lambda-list (or method-lambda-list
                                         (ecase (car method-lambda)
                                           (lambda (second method-lambda))
                                           (named-lambda (third method-lambda)))))
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 2113f59..7864721 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -2075,4 +2075,31 @@
   (defmethod sb-mop:validate-superclass ((x bug-309076-class) (y standard-class)) t)
   (assert (typep (make-instance 'bug-309076-class) 'bug-309076-class)))
 
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require 'sb-cltl2)
+  (defmethod b ()))
+
+(defmacro macro ()
+  (let ((a 20))
+    (declare (special a))
+    (assert
+     (=
+      (funcall
+       (compile nil
+                (sb-mop:make-method-lambda
+                 #'b
+                 (find-method #'b () ())
+                 '(lambda () (declare (special a)) a)
+                 nil))
+       '(1) ())
+      20))))
+
+(with-test (:name :make-method-lambda-leakage)
+  ;; lambda list of X leaks into the invocation of make-method-lambda
+  ;; during code-walking performed by make-method-lambda invoked by
+  ;; DEFMETHOD
+  (sb-cltl2:macroexpand-all '(defmethod x (a) (macro))))
+
+
 ;;;; success
-- 
1.7.10.4