defmethod: make the function known at compile time.

[sbcl.git] / tests / clos.impure.lisp

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 0838bd6..bff25d8 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1226,8 +1226,7 @@
 ;;; 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)
@@ -2043,8 +2042,7 @@
 (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.
@@ -2058,12 +2056,67 @@
 (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))
+  (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))
+  (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))))
+
+(with-test (:name (:defmethod-undefined-function :bug-503095))
+  (flet ((test-load (file)
+           (let (implicit-gf-warning)
+             (handler-bind
+                 ((sb-ext:implicit-generic-function-warning
+                    (lambda (x)
+                      (setf implicit-gf-warning x)
+                      (muffle-warning x)))
+                  ((or warning error) #'error))
+               (load file))
+             (assert implicit-gf-warning))))
+    (multiple-value-bind (fasl warnings errorsp) (compile-file "bug-503095.lisp")
+      (unwind-protect
+           (progn (assert (and fasl (not warnings) (not errorsp)))
+                  (test-load fasl))
+        (and fasl (delete-file fasl))))
+    (test-load "bug-503095-2.lisp")))
+
 ;;;; success