Re: bug with initialized class slots

[Gregor.pa@Xerox.COM]

    Date: Tue, 13 Feb 90 17:27:02 PST
    From: smh@Franz.COM (Steve Haflich)

    In (defvar *pcl-system-date* "2/8/90 A PCL for the 90's (beta 2)")

    I believe there is a bug with class-allocated slots that have no
    specified initialization.  In Allegro 3.1 the first of these defclass
    runs OK while the second blows up at DEFCLASS time:

Many people have complained about this bug.  I am about to put out a new
set of sources which fixes this and several other bugs, but the
following fixes just this bug.

;from std-class.lisp

(defmethod shared-initialize :after
	   ((class std-class)
	    slot-names
	    &key direct-superclasses
		 direct-slots
		 direct-default-initargs)
  (declare (ignore slot-names))
  (when (null direct-superclasses)
    (setq direct-superclasses  (list *the-class-standard-object*)))
  (setq direct-slots 
	(mapcar #'(lambda (pl) (make-direct-slotd class pl)) direct-slots))
  (setf (slot-value class 'direct-superclasses) direct-superclasses
	(slot-value class 'direct-slots) direct-slots)
  (setf (plist-value class 'direct-default-initargs) direct-default-initargs)
  (setf (plist-value class 'class-slot-cells)
	(gathering1 (collecting)
	  (dolist (dslotd direct-slots)
	    (when (eq (slotd-allocation dslotd) class)
	      (let ((initfunction (slotd-initfunction dslotd)))
		(gather1 (cons (slotd-name dslotd)
			       (if initfunction (funcall initfunction) *slot-unbound*))))))))
  (add-direct-subclasses class direct-superclasses)
  (add-slot-accessors    class direct-slots))
-------