/[gcl]/gcl/pcl/pcl_init.lisp
ViewVC logotype

Diff of /gcl/pcl/pcl_init.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Wed Feb 26 22:21:42 2003 UTC revision 1.2 by camm, Fri Oct 10 03:35:53 2003 UTC
# Line 46  Line 46 
46    (let* ((info (initialize-info class initargs))    (let* ((info (initialize-info class initargs))
47           (valid-p (initialize-info-valid-p info)))           (valid-p (initialize-info-valid-p info)))
48      (when (and (consp valid-p) (eq (car valid-p) :invalid))      (when (and (consp valid-p) (eq (car valid-p) :invalid))
49        (error "Invalid initialization argument ~S for class ~S"        (specific-error :invalid-form "Invalid initialization argument ~S for class ~S"
50               (cdr valid-p) (class-name class))))               (cdr valid-p) (class-name class))))
51    (let ((instance (apply #'allocate-instance class initargs)))    (let ((instance (apply #'allocate-instance class initargs)))
52      (apply #'initialize-instance instance initargs)      (apply #'initialize-instance instance initargs)
# Line 95  Line 95 
95           (info (initialize-info class initargs))           (info (initialize-info class initargs))
96           (valid-p (initialize-info-ri-valid-p info)))           (valid-p (initialize-info-ri-valid-p info)))
97      (when (and (consp valid-p) (eq (car valid-p) :invalid))      (when (and (consp valid-p) (eq (car valid-p) :invalid))
98        (error "Invalid initialization argument ~S for class ~S"        (specific-error :invalid-form "Invalid initialization argument ~S for class ~S"
99               (cdr valid-p) (class-name class))))               (cdr valid-p) (class-name class))))
100    (apply #'shared-initialize instance nil initargs)    (apply #'shared-initialize instance nil initargs)
101    instance)    instance)
# Line 134  Line 134 
134    
135  (defmethod shared-initialize  (defmethod shared-initialize
136      ((instance slot-object) slot-names &rest initargs)      ((instance slot-object) slot-names &rest initargs)
137    
138    (when (eq slot-names 't)    (when (eq slot-names 't)
139        ;; FIXME this should be in the -t- and -nil- functions eventually
140        ;; loop through initargs looking for errors
141        (doplist (initarg val) initargs)
142      (return-from shared-initialize      (return-from shared-initialize
143        (call-initialize-function                   (progn
144         (initialize-info-shared-initialize-t-function                     (call-initialize-function
145          (initialize-info (class-of instance) initargs))                      (initialize-info-shared-initialize-t-function
146         instance initargs)))                       (initialize-info (class-of instance) initargs))
147                        instance initargs)
148                       instance)))
149    (when (eq slot-names 'nil)    (when (eq slot-names 'nil)
150        ;; FIXME this should be in the -t- and -nil- functions eventually
151        ;; loop through initargs looking for errors
152        (doplist (initarg val) initargs)
153      (return-from shared-initialize      (return-from shared-initialize
154        (call-initialize-function                   (progn
155         (initialize-info-shared-initialize-nil-function                     (call-initialize-function
156          (initialize-info (class-of instance) initargs))                      (initialize-info-shared-initialize-nil-function
157         instance initargs)))                       (initialize-info (class-of instance) initargs))
158                        instance initargs)
159                       instance)))
160    ;;    ;;
161    ;; initialize the instance's slots in a two step process    ;; initialize the instance's slots in a two step process
162    ;;   (1) A slot for which one of the initargs in initargs can set    ;;   (1) A slot for which one of the initargs in initargs can set
# Line 240  Line 251 
251      (doplist (key val) initargs      (doplist (key val) initargs
252         (unless (memq key legal)         (unless (memq key legal)
253           (if error-p           (if error-p
254               (error "Invalid initialization argument ~S for class ~S"               (specific-error :invalid-form "Invalid initialization argument ~S for class ~S"
255                      key                      key
256                      (class-name class))                      (class-name class))
257               (return-from check-initargs-2-plist nil)))))               (return-from check-initargs-2-plist nil)))))
# Line 253  Line 264 
264      (dolist (key initkeys)      (dolist (key initkeys)
265        (unless (memq key legal)        (unless (memq key legal)
266          (if error-p          (if error-p
267              (error "Invalid initialization argument ~S for class ~S"              (specific-error :invalid-form "Invalid initialization argument ~S for class ~S"
268                     key                     key
269                     (class-name class))                     (class-name class))
270              (return-from check-initargs-2-list nil)))))              (return-from check-initargs-2-list nil)))))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26