Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv4804/tests

Modified Files:
	clos.impure.lisp 
Log Message:
1.0.14.7: quote non-keyword :default-initargs keys in SLOT-INIT-FORMS

 * Reported and diagnosed by Matt Marjanovic.


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -d -r1.96 -r1.97
--- clos.impure.lisp	21 Jan 2008 14:40:55 -0000	1.96
+++ clos.impure.lisp	31 Jan 2008 07:22:17 -0000	1.97
@@ -1607,5 +1607,17 @@
             (declare (bug-402-d x))
             x))))
 
+;;;; non-keyword :default-initargs + :before method on shared initialize
+;;;; interacted badly with CTOR optimizations
+(defclass ctor-default-initarg-problem ()
+  ((slot :initarg slotto))
+  (:default-initargs slotto 123))
+(defmethod shared-initialize :before ((instance ctor-default-initarg-problem) slot-names &rest initargs)
+  (format t "~&Rock on: ~A~%" initargs))
+(defun provoke-ctor-default-initarg-problem ()
+  (make-instance 'ctor-default-initarg-problem))
+(handler-bind ((warning #'error))
+  (assert (= 123 (slot-value (provoke-ctor-default-initarg-problem) 'slot))))
+
 
 ;;;; success