[armedbear-cvs] r14153 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Wed Sep 19 07:34:44 2012
New Revision: 14153

Log:
Initialize shared slots upon class finalization.

- Slots with :allocation :class can now be read without creating an
  instance beforehand.

- Reported by Pascal Costanza

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Fri Sep 14 15:09:14 2012	(r14152)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Wed Sep 19 07:34:44 2012	(r14153)
@@ -548,9 +548,16 @@
         (:class
          (unless (slot-definition-location slot)
            (let ((allocation-class (slot-definition-allocation-class slot)))
-             (setf (slot-definition-location slot)
-                   (if (eq allocation-class class)
-                       (cons (slot-definition-name slot) +slot-unbound+)
+             (if (eq allocation-class class)
+                 ;; We initialize class slots here so they can be
+                 ;; accessed without creating a dummy instance.
+                 (let ((initfunction (slot-definition-initfunction slot)))
+                   (setf (slot-definition-location slot)
+                         (cons (slot-definition-name slot)
+                               (if initfunction
+                                   (funcall initfunction)
+                                   +slot-unbound+))))
+                 (setf (slot-definition-location slot)
                        (slot-location allocation-class (slot-definition-name slot))))))
          (push (slot-definition-location slot) shared-slots))))
     (when old-layout