Changeset 13207


Ignore:
Timestamp:
02/08/11 17:59:09 (6 years ago)
Author:
ehuelsmann
Message:

Fix CHECK-INITARGS checking the wrong generic functions by
making it general purpose and ask for more parameters.

File:
1 edited

Legend:

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

    r13206 r13207  
    691691  (declare (ignore metaclass))
    692692  (let ((class (std-allocate-instance +the-standard-class+)))
    693     (check-initargs class t initargs)
     693    (check-initargs (list #'allocate-instance #'initialize-instance)
     694                    (list* class initargs)
     695                    class t initargs)
    694696    (%set-class-name name class)
    695697    (%set-class-layout nil class)
     
    788790                  (%make-instances-obsolete old-class)
    789791                  (setf (class-finalized-p old-class) nil)
    790                   (check-initargs old-class t all-keys)
     792                  (check-initargs (list #'allocate-instance #'initialize-instance)
     793                                  (list* old-class all-keys)
     794                                  old-class t all-keys)
    791795                  (apply #'std-after-initialization-for-classes old-class all-keys)
    792796                  old-class)))
     
    25562560;; 7.1.2
    25572561
    2558 (defun check-initargs (instance shared-initialize-param initargs)
     2562(defun check-initargs (gf-list args instance shared-initialize-param initargs)
    25592563  (when (oddp (length initargs))
    25602564    (error 'program-error
     
    25662570                                        (list* instance shared-initialize-param
    25672571                                               initargs))
    2568             (compute-applicable-methods #'initialize-instance
    2569                                         (list* instance initargs))))
     2572            (mapcan #'(lambda (gf)
     2573                        (compute-applicable-methods gf args))
     2574                    gf-list)))
    25702575          (slots (class-slots (class-of instance))))
    25712576      (do* ((tail initargs (cddr tail))
     
    26182623
    26192624  (let ((instance (std-allocate-instance class)))
    2620     (check-initargs instance t initargs)
     2625    (check-initargs (list #'allocate-instance #'initialize-instance)
     2626                    (list* instance initargs)
     2627                    instance t initargs)
    26212628    (apply #'initialize-instance instance initargs)
    26222629    instance))
     
    27242731                    (mapcar 'slot-definition-name
    27252732                            (class-slots (class-of new))))))
    2726     (check-initargs new added-slots initargs)
     2733    (check-initargs (list #'update-instance-for-different-class)
     2734                    (list old new initargs)
     2735                    new added-slots initargs)
    27272736    (apply #'shared-initialize new added-slots initargs)))
    27282737
     
    27532762            property-list
    27542763            &rest initargs)
    2755   (check-initargs instance added-slots initargs)
     2764  (check-initargs (list #'update-instance-for-redefined-class)
     2765                  (list* instance added-slots discarded-slots
     2766                         property-list initargs)
     2767                  instance added-slots initargs)
    27562768  (apply #'shared-initialize instance added-slots initargs))
    27572769
Note: See TracChangeset for help on using the changeset viewer.