;;; test case from Gerd Moellmann
(define-method-combination r-c/c-m-1 ()
((primary () :required t))
- `(restart-case (call-method ,(first primary))
- ()))
+ `(restart-case (call-method ,(first primary))))
(defgeneric r-c/c-m-1-gf ()
(:method-combination r-c/c-m-1)
(defmethod shared-initialize :around ((instance bug-1179858) (slot-names t) &key)
(call-next-method))
-(with-test (:name (make-instance :fallback-generator-initarg-handling
- :bug-1179858))
+(with-test (:name (:make-instance :fallback-generator-initarg-handling :bug-1179858))
;; Now compile a lambda containing MAKE-INSTANCE to exercise the
;; fallback constructor generator. Call the resulting compiled
;; function to trigger the bug.
(defmethod shared-initialize :around ((instance bug-1179858b) (slot-names t) &key)
(call-next-method))
-(with-test (:name (make-instance :fallback-generator-non-keyword-initarg
- :bug-1179858))
+(with-test (:name (:make-instance :fallback-generator-non-keyword-initarg :bug-1179858))
(flet ((foo= (n i) (= (bug-1179858b-foo i) n)))
(assert
(foo= 14 (funcall (compile nil '(lambda () (make-instance 'bug-1179858b))))))
(assert
(foo= 15 (funcall (compile nil '(lambda () (make-instance 'bug-1179858b 'foo 15))))))))
-(with-test (:name (cpl-violation-setup :bug-309076))
+(with-test (:name (:cpl-violation-setup :bug-309076))
(assert (raises-error?
(progn
(defclass bug-309076-broken-class (standard-class) ()
(:metaclass sb-mop:funcallable-standard-class))
(sb-mop:finalize-inheritance (find-class 'bug-309076-broken-class))))))
-(with-test (:name (cpl-violation-irrelevant-class :bug-309076))
+(with-test (:name (:cpl-violation-irrelevant-class :bug-309076))
(defclass bug-309076-class (standard-class) ())
(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