Changeset 13185


Ignore:
Timestamp:
01/26/11 08:39:54 (11 years ago)
Author:
ehuelsmann
Message:

Fix #119: Incorrect dynamic environment for evaluation of :CLASS
allocation slot initforms.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13184 r13185  
    166166            (writers ())
    167167            (other-options ())
    168       (non-std-options ()))
     168            (non-std-options ()))
    169169        (do ((olist (cdr spec) (cddr olist)))
    170170            ((null olist))
     
    175175                      "duplicate slot option :INITFORM for slot named ~S"
    176176                      name))
    177              (setq initfunction
    178                    `(function (lambda () ,(cadr olist))))
    179              (setq initform `',(cadr olist)))
     177             (setq initfunction t)
     178             (setq initform (cadr olist)))
    180179            (:initarg
    181180             (push-on-end (cadr olist) initargs))
     
    211210             (push-on-end `(setf ,(cadr olist)) writers))
    212211            (t
    213        (push-on-end `(quote ,(car olist)) non-std-options)
     212             (push-on-end `(quote ,(car olist)) non-std-options)
    214213             (push-on-end (cadr olist) non-std-options))))
    215214        `(list
    216215          :name ',name
    217216          ,@(when initfunction
    218               `(:initform ,initform
    219                           :initfunction ,initfunction))
     217              `(:initform ',initform
     218                :initfunction ,(if (eq allocation :class)
     219                                   ;; CLHS specifies the initform for a
     220                                   ;; class allocation level slot needs
     221                                   ;; to be evaluated in the dynamic
     222                                   ;; extent of the DEFCLASS form
     223                                   (let ((var (gensym)))
     224                                     `(let ((,var ,initform))
     225                                        (lambda () ,var)))
     226                                 `(lambda () ,initform))))
    220227          ,@(when initargs `(:initargs ',initargs))
    221228          ,@(when readers `(:readers ',readers))
     
    13131320             (setf object (cadr object)))
    13141321           (intern-eql-specializer object)))
    1315   ((and (consp specializer)
     1322        ((and (consp specializer)
    13161323              (eq (car specializer) 'java:jclass))
    13171324         (let ((jclass (eval specializer)))
    1318      (java::ensure-java-class jclass)))
     1325           (java::ensure-java-class jclass)))
    13191326        (t
    13201327         (error "Unknown specializer: ~S" specializer))))
Note: See TracChangeset for help on using the changeset viewer.