Steel Bank Common Lisp

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

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

 * Reported and diagnosed by Matt Marjanovic.


Index: ctor.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/ctor.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- ctor.lisp	29 Dec 2006 01:01:51 -0000	1.28
+++ ctor.lisp	31 Jan 2008 07:22:17 -0000	1.29
@@ -531,16 +531,16 @@
       ;; initargs, that is, their values must be evaluated even
       ;; if not actually used for initializing a slot.
       (loop for (key initform initfn) in default-initargs and i from 0
-            unless (member key initkeys :test #'eq) do
-            (let* ((kind (if (constantp initform) 'constant 'var))
-                   (init (if (eq kind 'var) initfn initform)))
-              (ecase kind
-                (constant
-                 (push key defaulting-initargs)
-                 (push initform defaulting-initargs))
-                (var
-                 (push key defaulting-initargs)
-                 (push (default-init-var-name i) defaulting-initargs)))
+            unless (member key initkeys :test #'eq)
+            do (let* ((kind (if (constantp initform) 'constant 'var))
+                      (init (if (eq kind 'var) initfn initform)))
+                 (ecase kind
+                   (constant
+                    (push (list 'quote key) defaulting-initargs)
+                    (push initform defaulting-initargs))
+                   (var
+                    (push (list 'quote key) defaulting-initargs)
+                    (push (default-init-var-name i) defaulting-initargs)))
               (when (eq kind 'var)
                 (let ((init-var (default-init-var-name i)))
                   (setq init init-var)