Changeset 14345


Ignore:
Timestamp:
12/31/12 10:21:17 (8 years ago)
Author:
Mark Evenson
Message:

Backport r14344 | rschlatte | 2012-12-30 18:09:06 +0100 (Sun, 30 Dec 2012) | 5 lines

Avoid premature initialization of method-class, method-combination in gfs

  • reported by Pascal Costanza
Location:
branches/1.1.x/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/1.1.x/src/org/armedbear/lisp/StandardGenericFunction.java

    r14086 r14345  
    6262      StandardClass.STANDARD_METHOD;
    6363    slots[StandardGenericFunctionClass.SLOT_INDEX_METHOD_COMBINATION] =
    64       Symbol.STANDARD; // fixed up by shared-initialize :after in clos.lisp
     64      list(Symbol.STANDARD); // fixed up by clos.lisp:shared-initialize :after
    6565    slots[StandardGenericFunctionClass.SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER] =
    6666      NIL;
  • branches/1.1.x/src/org/armedbear/lisp/clos.lisp

    r14343 r14345  
    18261826(defun make-instance-standard-generic-function (generic-function-class
    18271827                                                &key name lambda-list
    1828                                                 method-class
    1829                                                 method-combination
     1828                                                (method-class +the-standard-method-class+)
     1829                                                (method-combination +the-standard-method-combination+)
    18301830                                                argument-precedence-order
    18311831                                                declarations
     
    18351835  (check-argument-precedence-order lambda-list argument-precedence-order)
    18361836  (let ((gf (std-allocate-instance +the-standard-generic-function-class+)))
     1837    (unless (classp method-class) (setf method-class (find-class method-class)))
     1838    (unless (typep method-combination 'method-combination)
     1839      (setf method-combination
     1840            (find-method-combination
     1841             gf (car method-combination) (cdr method-combination))))
    18371842    (%set-generic-function-name gf name)
    18381843    (%set-generic-function-lambda-list gf lambda-list)
     
    43714376                                     slot-names
    43724377                                     &key lambda-list argument-precedence-order
     4378                                       (method-combination '(standard))
    43734379                                     &allow-other-keys)
    43744380  (let* ((plist (analyze-lambda-list lambda-list))
     
    43784384    (set-generic-function-argument-precedence-order
    43794385     instance (or argument-precedence-order required-args)))
    4380   (when (eq (generic-function-method-combination instance) 'standard)
    4381     ;; fix up "naked" (make-instance 'standard-generic-function) -- gfs
    4382     ;; created via defgeneric have that slot initalized properly
    4383     (set-generic-function-method-combination instance
    4384                                              +the-standard-method-combination+))
     4386  (unless (typep (generic-function-method-combination instance)
     4387                 'method-combination)
     4388    ;; this fixes (make-instance 'standard-generic-function) -- the
     4389    ;; constructor of StandardGenericFunction sets this slot to '(standard)
     4390    (setf (generic-function-method-combination instance)
     4391          (find-method-combination
     4392           instance (car method-combination) (cdr method-combination))))
    43854393  (finalize-standard-generic-function instance))
    43864394
     
    45884596                                                &rest all-keys
    45894597                                                &key (generic-function-class +the-standard-generic-function-class+)
    4590                                                   (method-class +the-standard-method-class+)
    4591                                                   (method-combination +the-standard-method-combination+)
    45924598                                                &allow-other-keys)
    45934599  (setf all-keys (copy-list all-keys))  ; since we modify it
     
    45954601  (unless (classp generic-function-class)
    45964602    (setf generic-function-class (find-class generic-function-class)))
    4597   (unless (classp method-class) (setf method-class (find-class method-class)))
    4598   (unless (typep method-combination 'method-combination)
    4599     (setf method-combination
    4600           (find-method-combination (class-prototype generic-function-class)
    4601                                    (car method-combination)
    4602                                    (cdr method-combination))))
    46034603  (when (and (null *clos-booting*) (fboundp function-name))
    46044604    (if (autoloadp function-name)
     
    46104610             #'make-instance-standard-generic-function
    46114611             #'make-instance)
    4612          generic-function-class
    4613          :name function-name
    4614          :method-class method-class
    4615          :method-combination method-combination
    4616          all-keys))
     4612         generic-function-class :name function-name all-keys))
    46174613
    46184614(defun ensure-generic-function (function-name &rest all-keys
Note: See TracChangeset for help on using the changeset viewer.