X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fctor.impure.lisp;h=f40e27b496257b8d9d1641b64fea2c8a220939a2;hb=ba39d165a0bb6fabba6d6feb9b6fb88ae4d544ff;hp=fed7e9b9f26094248fc5e2a235e167b56862d365;hpb=4a1cfe27db52072dfaeddda235e7d830f2c85661;p=sbcl.git

diff --git a/tests/ctor.impure.lisp b/tests/ctor.impure.lisp
index fed7e9b..f40e27b 100644
--- a/tests/ctor.impure.lisp
+++ b/tests/ctor.impure.lisp
@@ -273,5 +273,33 @@
                (assert (equal "b" (sneaky-b i)))
                (assert (equal "c" (sneaky-c i)))))))
 
+(defclass bug-728650-base ()
+  ((value
+    :initarg :value
+    :initform nil)))
+
+(defmethod initialize-instance :after ((instance bug-728650-base) &key)
+  (with-slots (value) instance
+    (unless value
+      (error "Impossible! Value slot not initialized in ~S" instance))))
+
+(defclass bug-728650-child-1 (bug-728650-base)
+  ())
+
+(defmethod initialize-instance :around ((instance bug-728650-child-1) &rest initargs &key)
+  (apply #'call-next-method instance :value 'provided-by-child-1 initargs))
+
+(defclass bug-728650-child-2 (bug-728650-base)
+  ())
+
+(defmethod initialize-instance :around ((instance bug-728650-child-2) &rest initargs &key)
+  (let ((foo (make-instance 'bug-728650-child-1)))
+    (apply #'call-next-method instance :value foo initargs)))
+
+(with-test (:name :bug-728650)
+  (let ((child1 (slot-value (make-instance 'bug-728650-child-2) 'value)))
+    (assert (typep child1 'bug-728650-child-1))
+    (assert (eq 'provided-by-child-1 (slot-value child1 'value)))))
+
 
 ;;;; success