Changeset 549

Timestamp:

Feb 21, 2004, 5:14:19 PM (21 years ago)

Author:

Gary Byers

Message:

Handle INITFUNCTION/INITARG case in SHARED-INITIALIZE.

File:

• trunk/ccl/examples/objc-clos.lisp (modified) (3 diffs)

trunk/ccl/examples/objc-clos.lisp

@@ -756 +756 @@
     ;; Initialize CLOS slots
     (dolist (slotd (class-slots class))
-      (when (not (typep slotd 'foreign-direct-slot-definition)) ; For now
+      (when (not (typep slotd 'foreign-effective-slot-definition)) ; For now
         (let ((sname (slot-definition-name slotd))
               (slot-type (slot-definition-type slotd))
@@ -769 +769 @@
                     (setf (slot-value instance sname) newval)
                   (report-bad-arg newval slot-type))
-              (let ((curval (slot-value instance sname)))
+              (let* ((loc (slot-definition-location slotd))
+                     (curval (%standard-instance-instance-location-access
+                             instance loc)))
                 (when (and (or (eq slot-names t) 
                                (member sname slot-names :test #'eq))
@@ -776 +778 @@
                   (let ((newval (funcall initfunction)))
                     (unless (funcall typepred newval)
-                      (report-bad-arg newval slot-type))))))))))
+                      (report-bad-arg newval slot-type))
+                    (setf (%standard-instance-instance-location-access
+                           instance loc)
+                          newval)))))))))
     instance))