From d0f03c1ee40d6e0a0ebeb454da8ba976a490dbb5 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 9 Apr 2009 19:44:17 +0200 Subject: [PATCH] Pass the initargs to ALLOCATE-INSTANCE. --- src/CHANGELOG | 13 +++++++++++++ src/clos/standard.lsp | 10 +++++++--- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index ccd1e9558..1076e9d56 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -1,3 +1,16 @@ +ECL 9.4.2: +========== + +* MOP: + + - ALLOCATE-INSTANCE admits additional arguments which are the instance + initialization arguments. + + - MAKE-INSTANCE passes the completed initargs to ALLOCATE-INSTANCE. + + - MAKE-INSTANCE ensures that the class is finalized before allocating the + instance. + ECL 9.4.1: ========== diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp index 3adc5a1e1..4c7a89989 100644 --- a/src/clos/standard.lsp +++ b/src/clos/standard.lsp @@ -92,7 +92,8 @@ (setf last-location new-loc))) finally (return (max num-slots (1+ last-location))))) -(defmethod allocate-instance ((class class) &key) +(defmethod allocate-instance ((class class) &rest initargs) + (declare (ignore initargs)) ;; FIXME! Inefficient! We should keep a list of dependent classes. (unless (class-finalized-p class) (finalize-inheritance class)) @@ -101,6 +102,9 @@ x)) (defmethod make-instance ((class class) &rest initargs) + ;; Without finalization we can not find initargs. + (unless (class-finalized-p class) + (finalize-inheritance class)) ;; We add the default-initargs first, because one of these initargs might ;; be (:allow-other-keys t), which disables the checking of the arguments. ;; (Paul Dietz's ANSI test suite, test CLASS-24.4) @@ -112,7 +116,7 @@ #'initialize-instance (list (class-prototype class))) (compute-applicable-methods #'shared-initialize (list (class-prototype class) t)))) - (let ((instance (allocate-instance class))) + (let ((instance (apply #'allocate-instance class initargs))) (apply #'initialize-instance instance initargs) instance)) @@ -680,7 +684,7 @@ because it contains a reference to the undefined class~% ~A" (defun check-initargs (class initargs &optional methods (slots (class-slots class))) - ;; First get all initiargs which have been declared in the given + ;; First get all initargs which have been declared in the given ;; methods, then check the list of initargs declared in the slots ;; of the class. (multiple-value-bind (method-initargs allow-other-keys)