X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fctor.lisp;h=f73b65817c1e59d2346e3044c7187c25b3317b8f;hb=ab5427d31da2bd95805cccc8e47b8f43d3dd606d;hp=e360052243c9aa60a0a15b8b17ebd7eb302477e1;hpb=4a1cfe27db52072dfaeddda235e7d830f2c85661;p=sbcl.git

diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp
index e360052..f73b658 100644
--- a/src/pcl/ctor.lisp
+++ b/src/pcl/ctor.lisp
@@ -545,7 +545,7 @@
                                 '(:instance :class)))
                       (class-slots class))
                (not maybe-invalid-initargs)
-               (not (nonstandard-primary-method-p
+               (not (hairy-around-or-nonstandard-primary-method-p
                      ii-methods *the-system-ii-method*))
                (not (around-or-nonstandard-primary-method-p
                      si-methods *the-system-si-method*)))
@@ -569,14 +569,16 @@
         when (null qualifiers) do
           (setq primary-checked-p t)))
 
-(defun nonstandard-primary-method-p
+(defun hairy-around-or-nonstandard-primary-method-p
     (methods &optional standard-method)
   (loop with primary-checked-p = nil
         for method in methods
         as qualifiers = (if (consp method)
                             (early-method-qualifiers method)
                             (safe-method-qualifiers method))
-        when (or (and (null qualifiers)
+        when (or (and (eq :around (car qualifiers))
+                      (not (simple-next-method-call-p method)))
+              (and (null qualifiers)
                       (not primary-checked-p)
                       (not (null standard-method))
                       (not (eq standard-method method))))
@@ -868,8 +870,8 @@
                                             ,value-form))))
                              (not-boundp-form ()
                                (if (member slotd sbuc-slots :test #'eq)
-                                   `(slot-boundp-using-class
-                                     ,class .instance. ,slotd)
+                                   `(not (slot-boundp-using-class
+                                          ,class .instance. ,slotd))
                                    `(eq (clos-slots-ref .slots. ,i)
                                         +slot-unbound+))))
                         (ecase kind