Changeset 15617


Ignore:
Timestamp:
Jan 28, 2013, 8:45:04 PM (7 years ago)
Author:
gb
Message:

Make the SHARED-INITIALIZE method on OBJC-OBJECT process initargs
for foreign slots.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/objc-bridge/objc-clos.lisp

    r15559 r15617  
    792792    ;; Initialize CLOS slots
    793793    (dolist (slotd (class-slots class))
    794       (when (not (typep slotd 'foreign-effective-slot-definition)) ; For now
    795         (let ((sname (slot-definition-name slotd))
    796               (slot-type (slot-definition-type slotd))
    797               (typepred (slot-value slotd 'type-predicate))
    798               (initfunction (slot-definition-initfunction slotd)))
    799           (multiple-value-bind (ignore newval foundp)
    800                                (get-properties initargs
    801                                                (slot-definition-initargs slotd))
    802             (declare (ignore ignore))
    803             (if foundp
    804                 (if (or (null typepred)
    805                         (funcall typepred newval))
    806                     (setf (slot-value instance sname) newval)
    807                   (report-bad-arg newval slot-type))
    808               (let* ((loc (slot-definition-location slotd))
     794      (let* ((foreign (typep slotd 'foreign-effective-slot-definition))
     795             (sname (slot-definition-name slotd))
     796             (slot-type (slot-definition-type slotd))
     797             (typepred (unless foreign (slot-value slotd 'type-predicate)))
     798             (initfunction (unless foreign (slot-definition-initfunction slotd))))
     799        (multiple-value-bind (ignore newval foundp)
     800            (get-properties initargs
     801                            (slot-definition-initargs slotd))
     802          (declare (ignore ignore))
     803          (if foundp
     804            (if (or (null typepred)
     805                    (funcall typepred newval))
     806              (setf (slot-value instance sname) newval)
     807              (report-bad-arg newval slot-type))
     808            (unless foreign
     809              (let* ((loc (slot-definition-location slotd))
    809810                     (curval (%standard-instance-instance-location-access
    810                              instance loc)))
     811                              instance loc)))
    811812                (when (and (or (eq slot-names t)
    812813                               (member sname slot-names :test #'eq))
Note: See TracChangeset for help on using the changeset viewer.